diff --git a/README b/README index 32c792566..425701c08 100644 --- a/README +++ b/README @@ -1,9 +1,11 @@ The is a distribution of Org, a plain text notes and project planning tool for Emacs. -The version of this release is: 7.9.1 +The homepage of Org is at: + http://orgmode.org -The homepage of Org is at http://orgmode.org +The installations instructions are at: + http://orgmode.org/org.html#Installation This distribution contains: diff --git a/README_ELPA b/README_ELPA index 5b4c9461b..be8932439 100644 --- a/README_ELPA +++ b/README_ELPA @@ -1,11 +1,15 @@ This is the Emacs Org project, an Emacs library for organizing your life. -The homepage of Org is at http://orgmode.org +The homepage of Org is at: + http://orgmode.org + +Installations instructions are at: + http://orgmode.org/org.html#Installation This distribution contains an ELPA packaged version of Org. "ELPA" stands for the "Emacs Lisp Package Archive". -The GNU ELPA is here: +The GNU ELPA is at: http://elpa.gnu.org It contains the org-*.tar package, containing only the org files diff --git a/README_maintainer b/README_maintainer index 04b04397f..65457c155 100644 --- a/README_maintainer +++ b/README_maintainer @@ -1,6 +1,6 @@ # -*- mode:org -*- -#+TITLE: Maintainer tasks +#+TITLE: Org maintainer tasks #+STARTUP: noindent This document describes the tasks the Org-mode maintainer has to do @@ -37,7 +37,7 @@ branch back into maint to synchronize the two. ** Minor release -The release number for minor releases look like this: =7.13.01= +The release number for minor releases look like this: =7.13.1= Minor releases are small amends to main releases. Usually they fix critical bugs discovered in a main release. Minor bugs are usually @@ -50,8 +50,8 @@ maint then merged in master. ** Tagging the release -When doing a major and a minor release, after all necessary merging -is done, tag the _maint_ branch for the release with: +When doing a major and a minor release, after all necessary merging is +done, tag the _maint_ branch for the release with: git tag -a "Adding release tag" release_7.9.1 @@ -59,6 +59,10 @@ and push tags with git push --tags +We also encourage you to sign release tags like this: + + git tag -a "Adding release tag" -s release_7.9.1 + ** Uploading the release files from the orgmode.org server Log on the orgmode.org server as the emacs user and cd to @@ -72,92 +76,6 @@ From there do to create the .tar.gz and .zip files, the documentation, and to upload everything at the right place. -* Working with patchwork - -John Wiegley is running a patchwork server that looks at the -emacs-orgmode mailing list and extracts patches. The maintainer and -his helpers should work through such patches, give feedback on them -and apply the ones which are good and done. A task for the maintainer -is to every now and then try to get old stuff out of that list, by -asking some helpers to investigate the patch, by rejecting or -accepting it. - -I have found that the best workflow for this is using the pw script by -Nate Case, with the modifications for Org-mode made by John Wiegley -and Carsten Dominik. The correct version of this script that should -be used with Org mode is distributed in the =mk/= directory of the Org -mode distribution. Here is the basic workflow for this. - -** Access to the patchwork server - -If you want to work on patchwork patches, you need write access at the -patchwork server. You need to contact John Wiegley to get this -access. - -There is a web interface to look at the patches and to change the -status of patches. This interface is self-explanatory. There is also -a command line script which can be very convenient to use. - -** Testing patches - -To start testing a patch, first assign it to yourself - -: pw update -s "Under Review" -d DELEGATE-NAME NNN - -where =NNN= is a patch number and =DELEGATE-NAME= is your user name on -the patchwork server. - -The get the patch into a branch: - -: pw branch NNN - -This will create a local topic branch in your git repository with the -name =t/patchNNN=. You will also be switched to the branch so that -you can immediately start testing it. Quite often small amends need -to be made, or documentation has to be added. Also, many contributors -do not yet provide the proper ChangeLog-like entries in the commit -message for the patch. As a maintainer, you have two options here. -Either ask the contributor to make the changes and resubmit the patch, -or fix it yourself. In principle, asking to contributor to change the -patch until it is complete is the best route, because it will educate -the contributor and minimize the work for the maintainer. However, -sometimes it can be less hassle to fix things directly and commit the -changes to the same branch =t/patchNNN=. - -If you ask the contributor to make the changes, the patch should be -marked on the patchwork server as "changes requested". - -: pw update -s "Changes Requested" -m "What to change" NNN - -This will send an email to the contributor and the mailing list with a -request for changes. The =-m= message should not be more than one -sentence and describe the requested changes. If you need to explain -in more detail, write a separate email to the contributor. - -When a new version of the patch arrives, you mark the old one as -superseded - -: pw update -s "Superseded" NNN - -and start working at the new one. - -** Merging a final patch - -Once the patch has been iterated and is final (including the -ChangeLog-like entries in the commit message), it should be merged. -The assumption here is that the final version of the patch is given by -the HEAD state in the branch =t/patchNNN=. To merge, do this: - -: pw merge -m "maintainer comment" NNN - -This will merge the patch into master, switch back to master and send -an email to both contributor and mailing list stating that this change -has been accepted, along with the comment given in the =-m= message. - -At some point you might then want to remove the topic branch - -: git branch -d t/patchNNN - * Synchonization with Emacs This is still a significant headache. Some hand work is needed here. @@ -253,16 +171,19 @@ So the way I have been doing things with Emacs is this: * Copyright assignments - The maintainer needs to keep track of copyright assignments. Even - better, find a volunteer to do this. + The maintainer needs to keep track of copyright assignments. + Even better, find a volunteer to do this. + + The assignment form is included in the repository as a file that + you can send to contributors: =request-assign-future.txt= The list of all contributors from who we have the papers is kept on - Worg at http://orgmode.org/worg/org-contribute.php, so that + Worg at http://orgmode.org/worg/org-contribute.html, so that committers can check if a patch can go into the core. The assignment process does not allways go smoothly, and it has happened several times that it gets stuck or forgotten at the FSF. - The contact at the FSF for this is: copyright-clerk@fsf.org + The contact at the FSF for this is: mailto:copyright-clerk@fsf.org Emails from the paper submitter have been ignored in the past, but an email from me (Carsten) as the maintainer of Org mode has usually diff --git a/contrib/README b/contrib/README index 7f71ae9ef..3b9d9b730 100644 --- a/contrib/README +++ b/contrib/README @@ -1,34 +1,36 @@ This directory contains add-ons to Org-mode. -These contributions are not part of GNU Emacs or of the official Org-mode -package. But the git repository for Org-mode is glad to provide useful way -to distribute and develop them as long as they are distributed under a free -software license. +These contributions are not part of GNU Emacs or of the official +Org-mode package. But the git repository for Org-mode is glad to +provide useful way to distribute and develop them as long as they +are distributed under a free software license. Please put your contribution in one of these directories: -LISP (emacs-lisp code) -====================== -htmlize.el --- Convert buffer text and decorations to HTML -org2rem.el --- Convert org appointments into reminders +LISP (Emacs Lisp) +================= + +Org utils +~~~~~~~~~ org-annotate-file.el --- Annotate a file with org syntax org-bibtex-extras.el --- Extras for working with org-bibtex entries org-bookmark.el --- Links to bookmarks +org-bullets.el --- Show bullets in org-mode as UTF-8 characters org-checklist.el --- org functions for checklist handling org-choose.el --- Use TODO keywords to mark decision states org-collector.el --- Collect properties into tables -org-contacts --- Contacts management +org-colview-xemacs.el --- Column View in Org-mode, XEmacs-specific version +org-contacts.el --- Contacts management org-contribdir.el --- Dummy file to mark the org contrib Lisp directory org-depend.el --- TODO dependencies for Org-mode org-drill.el --- Self-testing with org-learn org-element.el --- Parser and applications for Org syntax org-elisp-symbol.el --- Org links to emacs-lisp symbols -org-eval.el --- The tag, adapted from Muse org-eval-light.el --- Evaluate in-buffer code on demand -org-exp-bibtex.el --- Export citations to LaTeX and HTML -org-expiry.el --- Expiry mechanism for Org entries -org-export.el --- Generic Export Engine For Org +org-eval.el --- The tag, adapted from Muse +org-expiry.el --- Expiry mechanism for Org entries org-export-generic.el --- Export framework for configurable backends +org-favtable.el --- Lookup table of favorite references and links org-git-link.el --- Provide org links to specific file version org-interactive-query.el --- Interactive modification of tags query org-invoice.el --- Help manage client invoices in OrgMode @@ -36,8 +38,10 @@ org-jira.el --- Add a jira:ticket protocol to Org org-learn.el --- SuperMemo's incremental learning algorithm org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary org-mac-link-grabber.el --- Grab links and URLs from various Mac applications +org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode org-mairix.el --- Hook mairix search into Org for different MUAs org-man.el --- Support for links to manpages in Org-mode +org-mew.el --- Support for links to Mew messages org-mime.el --- org html export for text/html MIME emails org-mtags.el --- Support for some Muse-like tags in Org-mode org-notify.el --- Notifications for Org-mode @@ -48,49 +52,48 @@ org-screen.el --- Visit screen sessions through Org-mode links org-secretary.el --- Team management with org-mode org-static-mathjax.el --- Muse-like tags in Org-mode org-sudoku.el --- Create and solve SUDOKU puzzles in Org tables -orgtbl-sqlinsert.el --- Convert Org-mode tables to SQL insertions org-toc.el --- Table of contents for Org-mode buffer org-track.el --- Keep up with Org development org-velocity.el --- something like Notational Velocity for Org +org-vm.el --- Support for links to VM messages +org-w3m.el --- Support link/copy/paste from w3m to Org-mode org-wikinodes.el --- CamelCase wiki-like links for Org +org-wl.el --- Support for links to Wanderlust messages +orgtbl-sqlinsert.el --- Convert Org-mode tables to SQL insertions +Org exporters +~~~~~~~~~~~~~ +ox-confluence.el --- Confluence Wiki exporter +ox-deck.el --- deck.js presentations exporter +ox-groff.el --- Groff exporter +ox-koma-letter.el --- KOMA Scrlttr2 exporter +ox-rss.el --- RSS 2.0 exporter +ox-s5.el --- S5 presentations exporter +ox-taskjuggler.el --- TaskJuggler exporter -EXPORT ENGINE AND BACKENDS (emacs-lisp code) -============================================ +Org Babel languages +~~~~~~~~~~~~~~~~~~~ +ob-eukleides.el --- Org-babel functions for eukleides evaluation +ob-fomus.el --- Org-babel functions for fomus evaluation +ob-julia.el --- Org-babel functions for julia evaluation +ob-mathomatic.el --- Org-babel functions for mathomatic evaluation +ob-oz.el --- Org-babel functions for Oz evaluation +ob-tcl.el --- Org-babel functions for tcl evaluation -org-export.el --- the new export engine -org-e-latex.el --- LaTeX export backend -org-e-ascii.el --- ASCII export backend -org-e-beamer.el --- Beamer export backend -org-e-groff.el --- Groff export backend -org-e-html.el --- HTML export backend -org-e-man.el --- man pages export backend -org-e-odt.el --- ODT export backend -org-e-texinfo.el --- TeXinfo export backend -org-md.el --- MarkDown export backend - - -BABEL -===== -library-of-babel.org --- Documentation for the library of babel -langs/ob-fomus.el --- Org-babel functions for fomus evaluation -langs/ob-oz.el --- Org-babel functions for Oz evaluation - - -ODT (OpenDocumentText) -====================== -README.org --- Legacy documentation for Org ODT exporter +External libraries +~~~~~~~~~~~~~~~~~~ +htmlize.el --- Convert buffer text and decorations to HTML SCRIPTS (shell, bash, etc.) =========================== - -dir2org.zsh --- Org compatible fs structure output -ditaa.jar --- ASCII to PNG converter by Stathis Sideris, GPL -org2hpda --- Generate hipster pda style printouts from Org-mode -org-docco.org --- docco side-by-side annotated code export to HTML -StartOzServer.oz --- implements the Oz-side of the Org-babel Oz interface -staticmathjax --- XULRunner application to process MathJax statically +StartOzServer.oz --- implements the Oz-side of the Org-babel Oz interface +dir2org.zsh --- Org compatible fs structure output +ditaa.jar --- ASCII to PNG converter by Stathis Sideris, GPL +org-docco.org --- docco side-by-side annotated code export to HTML +org2hpda --- Generate hipster pda style printouts from Org-mode +staticmathjax --- XULRunner application to process MathJax statically +x11idle.c --- get the idle time of your X session This directory also contains supporting files for the following packages: ob-oz.el, org-docco.org, and org-static-mathjax.el. diff --git a/contrib/lisp/htmlize.el b/contrib/lisp/htmlize.el index b8d7aee8b..c03d6059f 100644 --- a/contrib/lisp/htmlize.el +++ b/contrib/lisp/htmlize.el @@ -1,9 +1,12 @@ -;; htmlize.el -- Convert buffer text and decorations to HTML. +;;; htmlize.el --- Convert buffer text and decorations to HTML. ;; Copyright (C) 1997-2013 Hrvoje Niksic ;; Author: Hrvoje Niksic ;; Keywords: hypermedia, extensions +;; Version: 1.43 + +;; This file is not part of GNU Emacs. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -26,7 +29,7 @@ ;; decorations to HTML. Mail to to discuss ;; features and additions. All suggestions are more than welcome. -;; To use this, just switch to the buffer you want HTML-ized and type +;; To use it, just switch to the buffer you want HTML-ized and type ;; `M-x htmlize-buffer'. You will be switched to a new buffer that ;; contains the resulting HTML code. You can edit and inspect this ;; buffer, or you can just save it with C-x C-w. `M-x htmlize-file' @@ -44,37 +47,43 @@ ;; produced HTML is valid under the 4.01 strict DTD, as confirmed by ;; the W3C validator. `inline-css' is like `css', except the CSS is ;; put directly in the STYLE attribute of the SPAN element, making it -;; possible to paste the generated HTML to other documents. In `font' -;; mode, htmlize uses ... to colorize HTML, -;; which is not standard-compliant, but works better in older -;; browsers. `css' mode is the default. +;; possible to paste the generated HTML into existing HTML documents. +;; In `font' mode, htmlize uses ... to +;; colorize HTML, which is not standard-compliant, but works better in +;; older browsers. `css' mode is the default. ;; You can also use htmlize from your Emacs Lisp code. When called ;; non-interactively, `htmlize-buffer' and `htmlize-region' will ;; return the resulting HTML buffer, but will not change current -;; buffer or move the point. +;; buffer or move the point. htmlize will do its best to work on +;; non-windowing Emacs sessions but the result will be limited to +;; colors supported by the terminal. -;; I tried to make the package elisp-compatible with multiple Emacsen, -;; specifically aiming for XEmacs 19.14+ and GNU Emacs 19.34+. Please -;; let me know if it doesn't work on some of those, and I'll try to -;; fix it. I relied heavily on the presence of CL extensions, -;; especially for cross-emacs compatibility; please don't try to -;; remove that particular dependency. When byte-compiling under GNU -;; Emacs, you're likely to get some warnings; just ignore them. +;; htmlize aims for compatibility with Emacsen version 21 and later. +;; Please let me know if it doesn't work on the version of XEmacs or +;; GNU Emacs that you are using. The package relies on the presence +;; of CL extensions, especially for cross-emacs compatibility; please +;; don't try to remove that dependency. I see no practical problems +;; with using the full power of the CL extensions, except that one +;; might learn to like them too much. -;; The latest version should be available at: +;; The latest version is available as a git repository at: ;; -;; +;; +;; +;; The snapshot of the latest release can be obtained at: +;; +;; ;; ;; You can find a sample of htmlize's output (possibly generated with ;; an older version) at: ;; ;; -;; Thanks go to the multitudes of people who have sent reports and -;; contributed comments, suggestions, and fixes. They include Ron -;; Gut, Bob Weiner, Toni Drabik, Peter Breton, Thomas Vogels, Juri -;; Linkov, Maciek Pasternacki, and many others. +;; Thanks go to the many people who have sent reports and contributed +;; comments, suggestions, and fixes. They include Ron Gut, Bob +;; Weiner, Toni Drabik, Peter Breton, Ville Skytta, Thomas Vogels, +;; Juri Linkov, Maciek Pasternacki, and many others. ;; User quotes: "You sir, are a sick, sick, _sick_ person. :)" ;; -- Bill Perry, author of Emacs/W3 @@ -84,48 +93,27 @@ (require 'cl) (eval-when-compile + (defvar unresolved) (if (string-match "XEmacs" emacs-version) (byte-compiler-options (warnings (- unresolved)))) (defvar font-lock-auto-fontify) (defvar font-lock-support-mode) - (defvar global-font-lock-mode) - (when (and (eq emacs-major-version 19) - (not (string-match "XEmacs" emacs-version))) - ;; Older versions of GNU Emacs fail to autoload cl-extra even when - ;; `cl' is loaded. - (load "cl-extra"))) + (defvar global-font-lock-mode)) -(defconst htmlize-version "1.36") - -;; Incantations to make custom stuff work without customize, e.g. on -;; XEmacs 19.14 or GNU Emacs 19.34. -(eval-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ; we've got what we needed - ;; No custom or obsolete custom, define surrogates. Define all - ;; three macros, so we don't hose another library that expects - ;; e.g. `defface' to work after (fboundp 'defcustom) succeeds. - (defmacro defgroup (&rest ignored) nil) - (defmacro defcustom (var value doc &rest ignored) - `(defvar ,var ,value ,doc)) - (defmacro defface (face value doc &rest stuff) - `(make-face ,face)))) +(defconst htmlize-version "1.43") (defgroup htmlize nil "Convert buffer text and faces to HTML." :group 'hypermedia) (defcustom htmlize-head-tags "" - "*Additional tags to insert within HEAD of the generated document." + "Additional tags to insert within HEAD of the generated document." :type 'string :group 'htmlize) (defcustom htmlize-output-type 'css - "*Output type of generated HTML, one of `css', `inline-css', or `font'. + "Output type of generated HTML, one of `css', `inline-css', or `font'. When set to `css' (the default), htmlize will generate a style sheet with description of faces, and use it in the HTML document, specifying the faces in the actual text with . @@ -145,11 +133,47 @@ sheet to carry around)." :type '(choice (const css) (const inline-css) (const font)) :group 'htmlize) +(defcustom htmlize-use-images t + "Whether htmlize generates `img' for images attached to buffer contents." + :type 'boolean + :group 'htmlize) + +(defcustom htmlize-force-inline-images nil + "Non-nil means generate all images inline using data URLs. +Normally htmlize converts image descriptors with :file properties to +relative URIs, and those with :data properties to data URIs. With this +flag set, the images specified as a file name are loaded into memory and +embedded in the HTML as data URIs." + :type 'boolean + :group 'htmlize) + +(defcustom htmlize-max-alt-text 100 + "Maximum size of text to use as ALT text in images. + +Normally when htmlize encounters text covered by the `display' property +that specifies an image, it generates an `alt' attribute containing the +original text. If the text is larger than `htmlize-max-alt-text' characters, +this will not be done.") + +(defcustom htmlize-transform-image 'htmlize-default-transform-image + "Function called to modify the image descriptor. + +The function is called with the image descriptor found in the buffer and +the text the image is supposed to replace. It should return a (possibly +different) image descriptor property list or a replacement string to use +instead of of the original buffer text. + +Returning nil is the same as returning the original text." + :type 'boolean + :group 'htmlize) + (defcustom htmlize-generate-hyperlinks t - "*Non-nil means generate the hyperlinks for URLs and mail addresses. + "Non-nil means auto-generate the links from URLs and mail addresses in buffer. + This is on by default; set it to nil if you don't want htmlize to -insert hyperlinks in the resulting HTML. (In which case you can still -do your own hyperlinkification from htmlize-after-hook.)" +autogenerate such links. Note that this option only turns off automatic +search for contents that looks like URLs and converting them to links. +It has no effect on whether htmlize respects the `htmlize-link' property." :type 'boolean :group 'htmlize) @@ -164,12 +188,12 @@ do your own hyperlinkification from htmlize-after-hook.)" text-decoration: underline; } " - "*The CSS style used for hyperlinks when in CSS mode." + "The CSS style used for hyperlinks when in CSS mode." :type 'string :group 'htmlize) (defcustom htmlize-replace-form-feeds t - "*Non-nil means replace form feeds in source code with HTML separators. + "Non-nil means replace form feeds in source code with HTML separators. Form feeds are the ^L characters at line beginnings that are sometimes used to separate sections of source code. If this variable is set to `t', form feed characters are replaced with the
separator. If this @@ -185,7 +209,7 @@ htmlize-after-hook." :group 'htmlize) (defcustom htmlize-html-charset nil - "*The charset declared by the resulting HTML documents. + "The charset declared by the resulting HTML documents. When non-nil, causes htmlize to insert the following in the HEAD section of the generated HTML: @@ -201,16 +225,16 @@ submitted HTML documents to declare a charset. So if you care about validation, you can use this to prevent the validator from bitching. Needless to say, if you set this, you should actually make sure that -the buffer is in the encoding you're claiming it is in. (Under Mule -that is done by ensuring the correct \"file coding system\" for the -buffer.) If you don't understand what that means, this option is -probably not for you." +the buffer is in the encoding you're claiming it is in. (This is +normally achieved by using the correct file coding system for the +buffer.) If you don't understand what that means, you should probably +leave this option in its default setting." :type '(choice (const :tag "Unset" nil) string) :group 'htmlize) -(defcustom htmlize-convert-nonascii-to-entities (featurep 'mule) - "*Whether non-ASCII characters should be converted to HTML entities. +(defcustom htmlize-convert-nonascii-to-entities t + "Whether non-ASCII characters should be converted to HTML entities. When this is non-nil, characters with codes in the 128-255 range will be considered Latin 1 and rewritten as \"&#CODE;\". Characters with codes @@ -231,21 +255,13 @@ which has nothing to do with the charset the page is in. For example, specified by the META tag or the charset sent by the HTTP server. In other words, \"©\" is exactly equivalent to \"©\". -By default, entity conversion is turned on for Mule-enabled Emacsen and -turned off otherwise. This is because Mule knows the charset of -non-ASCII characters in the buffer. A non-Mule Emacs cannot tell -whether a character with code 0xA9 represents Latin 1 copyright symbol, -Latin 2 \"S with caron\", or something else altogether. Setting this to -t without Mule means asserting that 128-255 characters always mean Latin -1. - For most people htmlize will work fine with this option left at the default setting; don't change it unless you know what you're doing." :type 'sexp :group 'htmlize) (defcustom htmlize-ignore-face-size 'absolute - "*Whether face size should be ignored when generating HTML. + "Whether face size should be ignored when generating HTML. If this is nil, face sizes are used. If set to t, sizes are ignored If set to `absolute', only absolute size specifications are ignored. Please note that font sizes only work with CSS-based output types." @@ -255,7 +271,7 @@ Please note that font sizes only work with CSS-based output types." :group 'htmlize) (defcustom htmlize-css-name-prefix "" - "*The prefix used for CSS names. + "The prefix used for CSS names. The CSS names that htmlize generates from face names are often too generic for CSS files; for example, `font-lock-type-face' is transformed to `type'. Use this variable to add a prefix to the generated names. @@ -264,7 +280,7 @@ The string \"htmlize-\" is an example of a reasonable prefix." :group 'htmlize) (defcustom htmlize-use-rgb-txt t - "*Whether `rgb.txt' should be used to convert color names to RGB. + "Whether `rgb.txt' should be used to convert color names to RGB. This conversion means determining, for instance, that the color \"IndianRed\" corresponds to the (205, 92, 92) RGB triple. `rgb.txt' @@ -273,7 +289,7 @@ triples. When this variable is non-nil, `htmlize' uses `rgb.txt' to look up color names. If this variable is nil, htmlize queries Emacs for RGB components of -colors using `color-instance-rgb-components' and `x-color-values'. +colors using `color-instance-rgb-components' and `color-values'. This can yield incorrect results on non-true-color displays. If the `rgb.txt' file is not found (which will be the case if you're @@ -311,89 +327,72 @@ output.") ;; in some cases checking against the version *is* necessary. (defconst htmlize-running-xemacs (string-match "XEmacs" emacs-version)) -(eval-and-compile - ;; save-current-buffer, with-current-buffer, and with-temp-buffer - ;; are not available in 19.34 and in older XEmacsen. Strictly - ;; speaking, we should stick to our own namespace and define and use - ;; htmlize-save-current-buffer, etc. But non-standard special forms - ;; are a pain because they're not properly fontified or indented and - ;; because they look weird and ugly. So I'll just go ahead and - ;; define the real ones if they're not available. If someone - ;; convinces me that this breaks something, I'll switch to the - ;; "htmlize-" namespace. - (unless (fboundp 'save-current-buffer) - (defmacro save-current-buffer (&rest forms) - `(let ((__scb_current (current-buffer))) - (unwind-protect - (progn ,@forms) - (set-buffer __scb_current))))) - (unless (fboundp 'with-current-buffer) - (defmacro with-current-buffer (buffer &rest forms) - `(save-current-buffer (set-buffer ,buffer) ,@forms))) - (unless (fboundp 'with-temp-buffer) - (defmacro with-temp-buffer (&rest forms) - (let ((temp-buffer (gensym "tb-"))) - `(let ((,temp-buffer - (get-buffer-create (generate-new-buffer-name " *temp*")))) - (unwind-protect - (with-current-buffer ,temp-buffer - ,@forms) - (and (buffer-live-p ,temp-buffer) - (kill-buffer ,temp-buffer)))))))) - ;; We need a function that efficiently finds the next change of a -;; property (usually `face'), preferably regardless of whether the -;; change occurred because of a text property or an extent/overlay. -;; As it turns out, it is not easy to do that compatibly. -;; -;; Under XEmacs, `next-single-property-change' does that. Under GNU -;; Emacs beginning with version 21, `next-single-char-property-change' -;; is available and does the same. GNU Emacs 20 had -;; `next-char-property-change', which we can use. GNU Emacs 19 didn't -;; provide any means for simultaneously examining overlays and text -;; properties, so when using Emacs 19.34, we punt and fall back to -;; `next-single-property-change', thus ignoring overlays altogether. +;; property regardless of whether the change occurred because of a +;; text property or an extent/overlay. +(cond + (htmlize-running-xemacs + (defun htmlize-next-change (pos prop &optional limit) + (if prop + (next-single-char-property-change pos prop nil (or limit (point-max))) + (next-property-change pos nil (or limit (point-max))))) + (defun htmlize-next-face-change (pos &optional limit) + (htmlize-next-change pos 'face limit))) + ((fboundp 'next-single-char-property-change) + ;; GNU Emacs 21+ + (defun htmlize-next-change (pos prop &optional limit) + (if prop + (next-single-char-property-change pos prop nil limit) + (next-char-property-change pos limit))) + (defun htmlize-overlay-faces-at (pos) + (delq nil (mapcar (lambda (o) (overlay-get o 'face)) (overlays-at pos)))) + (defun htmlize-next-face-change (pos &optional limit) + ;; (htmlize-next-change pos 'face limit) would skip over entire + ;; overlays that specify the `face' property, even when they + ;; contain smaller text properties that also specify `face'. + ;; Emacs display engine merges those faces, and so must we. + (or limit + (setq limit (point-max))) + (let ((next-prop (next-single-property-change pos 'face nil limit)) + (overlay-faces (htmlize-overlay-faces-at pos))) + (while (progn + (setq pos (next-overlay-change pos)) + (and (< pos next-prop) + (equal overlay-faces (htmlize-overlay-faces-at pos))))) + (setq pos (min pos next-prop)) + ;; Additionally, we include the entire region that specifies the + ;; `display' property. + (when (get-char-property pos 'display) + (setq pos (next-single-char-property-change pos 'display nil limit))) + pos))) + (t + (error "htmlize requires next-single-property-change or \ +next-single-char-property-change"))) + +(defmacro htmlize-lexlet (&rest letforms) + (declare (indent 1) (debug let)) + (if (and (boundp 'lexical-binding) + lexical-binding) + `(let ,@letforms) + ;; cl extensions have a macro implementing lexical let + `(lexical-let ,@letforms))) + +;; Simple overlay emulation for XEmacs (cond (htmlize-running-xemacs - ;; XEmacs: good. - (defun htmlize-next-change (pos prop &optional limit) - (next-single-property-change pos prop nil (or limit (point-max))))) - ((fboundp 'next-single-char-property-change) - ;; GNU Emacs 21: good. - (defun htmlize-next-change (pos prop &optional limit) - (next-single-char-property-change pos prop nil limit))) - ((fboundp 'next-char-property-change) - ;; GNU Emacs 20: bad, but fixable. - (defun htmlize-next-change (pos prop &optional limit) - (let ((done nil) - (current-value (get-char-property pos prop)) - newpos next-value) - ;; Loop over positions returned by next-char-property-change - ;; until the value of PROP changes or we've hit EOB. - (while (not done) - (setq newpos (next-char-property-change pos limit) - next-value (get-char-property newpos prop)) - (cond ((eq newpos pos) - ;; Possibly at EOB? Whatever, just don't infloop. - (setq done t)) - ((eq next-value current-value) - ;; PROP hasn't changed -- keep looping. - ) - (t - (setq done t))) - (setq pos newpos)) - pos))) + (defalias 'htmlize-make-overlay 'make-extent) + (defalias 'htmlize-overlay-put 'set-extent-property) + (defalias 'htmlize-overlay-get 'extent-property) + (defun htmlize-overlays-in (beg end) (extent-list nil beg end)) + (defalias 'htmlize-delete-overlay 'detach-extent)) (t - ;; GNU Emacs 19.34: hopeless, cannot properly support overlays. - (defun htmlize-next-change (pos prop &optional limit) - (unless limit - (setq limit (point-max))) - (let ((res (next-single-property-change pos prop))) - (if (or (null res) - (> res limit)) - limit - res))))) + (defalias 'htmlize-make-overlay 'make-overlay) + (defalias 'htmlize-overlay-put 'overlay-put) + (defalias 'htmlize-overlay-get 'overlay-get) + (defalias 'htmlize-overlays-in 'overlays-in) + (defalias 'htmlize-delete-overlay 'delete-overlay))) + ;;; Transformation of buffer text: HTML escapes, untabification, etc. @@ -419,17 +418,16 @@ output.") (aref table ?>) ">" ;; Not escaping '"' buys us a measurable speedup. It's only ;; necessary to quote it for strings used in attribute values, - ;; which htmlize doesn't do. + ;; which htmlize doesn't typically do. ;(aref table ?\") """ ) table)) ;; A cache of HTML representation of non-ASCII characters. Depending -;; on availability of `encode-char' and the setting of -;; `htmlize-convert-nonascii-to-entities', this maps non-ASCII -;; characters to either "&#;" or "" (mapconcat's mapper -;; must always return strings). It's only filled as characters are -;; encountered, so that in a buffer with e.g. French text, it will +;; on the setting of `htmlize-convert-nonascii-to-entities', this maps +;; non-ASCII characters to either "&#;" or "" (mapconcat's +;; mapper must always return strings). It's only filled as characters +;; are encountered, so that in a buffer with e.g. French text, it will ;; only ever contain French accented characters as keys. It's cleared ;; on each entry to htmlize-buffer-1 to allow modifications of ;; `htmlize-convert-nonascii-to-entities' to take effect. @@ -459,10 +457,9 @@ output.") ;; Latin 1: no need to call encode-char. (setf (gethash char htmlize-extended-character-cache) (format "&#%d;" char))) - ((and (fboundp 'encode-char) - ;; Must check if encode-char works for CHAR; - ;; it fails for Arabic and possibly elsewhere. - (encode-char char 'ucs)) + ((encode-char char 'ucs) + ;; Must check if encode-char works for CHAR; + ;; it fails for Arabic and possibly elsewhere. (setf (gethash char htmlize-extended-character-cache) (format "&#%d;" (encode-char char 'ucs)))) (t @@ -472,63 +469,249 @@ output.") (char-to-string char))))) string ""))) +(defun htmlize-attr-escape (string) + ;; Like htmlize-protect-string, but also escapes double-quoted + ;; strings to make it usable in attribute values. + (setq string (htmlize-protect-string string)) + (if (not (string-match "\"" string)) + string + (mapconcat (lambda (char) + (if (eql char ?\") + """ + (char-to-string char))) + string ""))) + +(defsubst htmlize-concat (list) + (if (and (consp list) (null (cdr list))) + ;; Don't create a new string in the common case where the list only + ;; consists of one element. + (car list) + (apply #'concat list))) + +(defun htmlize-format-link (linkprops text) + (let ((uri (if (stringp linkprops) + linkprops + (plist-get linkprops :uri))) + (escaped-text (htmlize-protect-string text))) + (if uri + (format "%s" (htmlize-attr-escape uri) escaped-text) + escaped-text))) + +(defun htmlize-escape-or-link (string) + ;; Escape STRING and/or add hyperlinks. STRING comes from a + ;; `display' property. + (let ((pos 0) (end (length string)) outlist) + (while (< pos end) + (let* ((link (get-char-property pos 'htmlize-link string)) + (next-link-change (next-single-property-change + pos 'htmlize-link string end)) + (chunk (substring string pos next-link-change))) + (push + (cond (link + (htmlize-format-link link chunk)) + ((get-char-property 0 'htmlize-literal chunk) + chunk) + (t + (htmlize-protect-string chunk))) + outlist) + (setq pos next-link-change))) + (htmlize-concat (nreverse outlist)))) + +(defun htmlize-display-prop-to-html (display text) + (let (desc) + (cond ((stringp display) + ;; Emacs ignores recursive display properties. + (htmlize-escape-or-link display)) + ((not (eq (car-safe display) 'image)) + (htmlize-protect-string text)) + ((null (setq desc (funcall htmlize-transform-image + (cdr display) text))) + (htmlize-escape-or-link text)) + ((stringp desc) + (htmlize-escape-or-link desc)) + (t + (htmlize-generate-image desc text))))) + +(defun htmlize-string-to-html (string) + ;; Convert the string to HTML, including images attached as + ;; `display' property and links as `htmlize-link' property. In a + ;; string without images or links, this is equivalent to + ;; `htmlize-protect-string'. + (let ((pos 0) (end (length string)) outlist) + (while (< pos end) + (let* ((display (get-char-property pos 'display string)) + (next-display-change (next-single-property-change + pos 'display string end)) + (chunk (substring string pos next-display-change))) + (push + (if display + (htmlize-display-prop-to-html display chunk) + (htmlize-escape-or-link chunk)) + outlist) + (setq pos next-display-change))) + (htmlize-concat (nreverse outlist)))) + +(defun htmlize-default-transform-image (imgprops _text) + "Default transformation of image descriptor to something usable in HTML. + +If `htmlize-use-images' is nil, the function always returns nil, meaning +use original text. Otherwise, it tries to find the image for images that +specify a file name. If `htmlize-force-inline-images' is non-nil, it also +converts the :file attribute to :data and returns the modified property +list." + (when htmlize-use-images + (when (plist-get imgprops :file) + (let ((location (plist-get (cdr (find-image (list imgprops))) :file))) + (when location + (setq imgprops (plist-put (copy-list imgprops) :file location))))) + (if htmlize-force-inline-images + (let ((location (plist-get imgprops :file)) + data) + (when location + (with-temp-buffer + (condition-case nil + (progn + (insert-file-contents-literally location) + (setq data (buffer-string))) + (error nil)))) + ;; if successful, return the new plist, otherwise return + ;; nil, which will use the original text + (and data + (plist-put (plist-put imgprops :file nil) + :data data))) + imgprops))) + +(defun htmlize-alt-text (_imgprops origtext) + (and (/= (length origtext) 0) + (<= (length origtext) htmlize-max-alt-text) + (not (string-match "[\0-\x1f]" origtext)) + origtext)) + +(defun htmlize-generate-image (imgprops origtext) + (let* ((alt-text (htmlize-alt-text imgprops origtext)) + (alt-attr (if alt-text + (format " alt=\"%s\"" (htmlize-attr-escape alt-text)) + ""))) + (cond ((plist-get imgprops :file) + ;; Try to find the image in image-load-path + (let* ((found-props (cdr (find-image (list imgprops)))) + (file (or (plist-get found-props :file) + (plist-get imgprops :file)))) + (format "" + (htmlize-attr-escape (file-relative-name file)) + alt-attr))) + ((plist-get imgprops :data) + (format "" + (or (plist-get imgprops :type) "") + (base64-encode-string (plist-get imgprops :data)) + alt-attr))))) + (defconst htmlize-ellipsis "...") (put-text-property 0 (length htmlize-ellipsis) 'htmlize-ellipsis t htmlize-ellipsis) +(defun htmlize-match-inv-spec (inv) + (member* inv buffer-invisibility-spec + :key (lambda (i) + (if (symbolp i) i (car i))))) + +(defun htmlize-decode-invisibility-spec (invisible) + ;; Return t, nil, or `ellipsis', depending on how invisible text should be inserted. + + (if (not (listp buffer-invisibility-spec)) + ;; If buffer-invisibility-spec is not a list, then all + ;; characters with non-nil `invisible' property are visible. + (not invisible) + + ;; Otherwise, the value of a non-nil `invisible' property can be: + ;; 1. a symbol -- make the text invisible if it matches + ;; buffer-invisibility-spec. + ;; 2. a list of symbols -- make the text invisible if + ;; any symbol in the list matches + ;; buffer-invisibility-spec. + ;; If the match of buffer-invisibility-spec has a non-nil + ;; CDR, replace the invisible text with an ellipsis. + (let ((match (if (symbolp invisible) + (htmlize-match-inv-spec invisible) + (some #'htmlize-match-inv-spec invisible)))) + (cond ((null match) t) + ((cdr-safe (car match)) 'ellipsis) + (t nil))))) + +(defun htmlize-add-before-after-strings (beg end text) + ;; Find overlays specifying before-string and after-string in [beg, + ;; pos). If any are found, splice them into TEXT and return the new + ;; text. + (let (additions) + (dolist (overlay (overlays-in beg end)) + (let ((before (overlay-get overlay 'before-string)) + (after (overlay-get overlay 'after-string))) + (when after + (push (cons (- (overlay-end overlay) beg) + after) + additions)) + (when before + (push (cons (- (overlay-start overlay) beg) + before) + additions)))) + (if additions + (let ((textlist nil) + (strpos 0)) + (dolist (add (stable-sort additions #'< :key #'car)) + (let ((addpos (car add)) + (addtext (cdr add))) + (push (substring text strpos addpos) textlist) + (push addtext textlist) + (setq strpos addpos))) + (push (substring text strpos) textlist) + (apply #'concat (nreverse textlist))) + text))) + +(defun htmlize-copy-prop (prop beg end string) + ;; Copy the specified property from the specified region of the + ;; buffer to the target string. We cannot rely on Emacs to copy the + ;; property because we want to handle properties coming from both + ;; text properties and overlays. + (let ((pos beg)) + (while (< pos end) + (let ((value (get-char-property pos prop)) + (next-change (htmlize-next-change pos prop end))) + (when value + (put-text-property (- pos beg) (- next-change beg) + prop value string)) + (setq pos next-change))))) + +(defun htmlize-get-text-with-display (beg end) + ;; Like buffer-substring-no-properties, except it copies the + ;; `display' property from the buffer, if found. + (let ((text (buffer-substring-no-properties beg end))) + (htmlize-copy-prop 'display beg end text) + (htmlize-copy-prop 'htmlize-link beg end text) + (unless htmlize-running-xemacs + (setq text (htmlize-add-before-after-strings beg end text))) + text)) + (defun htmlize-buffer-substring-no-invisible (beg end) ;; Like buffer-substring-no-properties, but don't copy invisible ;; parts of the region. Where buffer-substring-no-properties ;; mandates an ellipsis to be shown, htmlize-ellipsis is inserted. (let ((pos beg) - visible-list invisible show next-change) + visible-list invisible show last-show next-change) ;; Iterate over the changes in the `invisible' property and filter ;; out the portions where it's non-nil, i.e. where the text is ;; invisible. (while (< pos end) (setq invisible (get-char-property pos 'invisible) - next-change (htmlize-next-change pos 'invisible end)) - (if (not (listp buffer-invisibility-spec)) - ;; If buffer-invisibility-spec is not a list, then all - ;; characters with non-nil `invisible' property are visible. - (setq show (not invisible)) - ;; Otherwise, the value of a non-nil `invisible' property can be: - ;; 1. a symbol -- make the text invisible if it matches - ;; buffer-invisibility-spec. - ;; 2. a list of symbols -- make the text invisible if - ;; any symbol in the list matches - ;; buffer-invisibility-spec. - ;; If the match of buffer-invisibility-spec has a non-nil - ;; CDR, replace the invisible text with an ellipsis. - (let (match) - (if (symbolp invisible) - (setq match (member* invisible buffer-invisibility-spec - :key (lambda (i) - (if (symbolp i) i (car i))))) - (setq match (block nil - (dolist (elem invisible) - (let ((m (member* - elem buffer-invisibility-spec - :key (lambda (i) - (if (symbolp i) i (car i)))))) - (when m (return m)))) - nil))) - (setq show (cond ((null match) t) - ((and (cdr-safe (car match)) - ;; Conflate successive ellipses. - (not (eq show htmlize-ellipsis))) - htmlize-ellipsis) - (t nil))))) + next-change (htmlize-next-change pos 'invisible end) + show (htmlize-decode-invisibility-spec invisible)) (cond ((eq show t) - (push (buffer-substring-no-properties pos next-change) visible-list)) - ((stringp show) - (push show visible-list))) - (setq pos next-change)) - (if (= (length visible-list) 1) - ;; If VISIBLE-LIST consists of only one element, return it - ;; without concatenation. This avoids additional consing in - ;; regions without any invisible text. - (car visible-list) - (apply #'concat (nreverse visible-list))))) + (push (htmlize-get-text-with-display pos next-change) + visible-list)) + ((and (eq show 'ellipsis) + (not (eq last-show 'ellipsis)) + ;; Conflate successive ellipses. + (push htmlize-ellipsis visible-list)))) + (setq pos next-change last-show show)) + (htmlize-concat (nreverse visible-list)))) (defun htmlize-trim-ellipsis (text) ;; Remove htmlize-ellipses ("...") from the beginning of TEXT if it @@ -565,8 +748,13 @@ output.") (incf column (- match-pos last-match)) ;; Calculate tab size based on tab-width and COLUMN. (setq tab-size (- tab-width (% column tab-width))) - ;; Expand the tab. - (push (aref htmlize-tab-spaces tab-size) chunks) + ;; Expand the tab, carefully recreating the `display' + ;; property if one was on the TAB. + (let ((display (get-text-property match-pos 'display text)) + (expanded-tab (aref htmlize-tab-spaces tab-size))) + (when display + (put-text-property 0 tab-size 'display display expanded-tab)) + (push expanded-tab chunks)) (incf column tab-size) (setq chunk-start (1+ match-pos))) (t @@ -581,42 +769,64 @@ output.") ;; Push the remaining chunk. (push (substring text chunk-start) chunks)) ;; Generate the output from the available chunks. - (apply #'concat (nreverse chunks))))) + (htmlize-concat (nreverse chunks))))) + +(defun htmlize-extract-text (beg end trailing-ellipsis) + ;; Extract buffer text, sans the invisible parts. Then + ;; untabify it and escape the HTML metacharacters. + (let ((text (htmlize-buffer-substring-no-invisible beg end))) + (when trailing-ellipsis + (setq text (htmlize-trim-ellipsis text))) + ;; If TEXT ends up empty, don't change trailing-ellipsis. + (when (> (length text) 0) + (setq trailing-ellipsis + (get-text-property (1- (length text)) + 'htmlize-ellipsis text))) + (setq text (htmlize-untabify text (current-column))) + (setq text (htmlize-string-to-html text)) + (values text trailing-ellipsis))) (defun htmlize-despam-address (string) - "Replace every occurrence of '@' in STRING with @. -`htmlize-make-hyperlinks' uses this to spam-protect mailto links -without modifying their meaning." + "Replace every occurrence of '@' in STRING with %40. +This is used to protect mailto links without modifying their meaning." ;; Suggested by Ville Skytta. (while (string-match "@" string) - (setq string (replace-match "@" nil t string))) + (setq string (replace-match "%40" nil t string))) string) -(defun htmlize-make-hyperlinks () - "Make hyperlinks in HTML." - ;; Function originally submitted by Ville Skytta. Rewritten by - ;; Hrvoje Niksic, then modified by Ville Skytta and Hrvoje Niksic. - (goto-char (point-min)) - (while (re-search-forward - "<\\(\\(mailto:\\)?\\([-=+_.a-zA-Z0-9]+@[-_.a-zA-Z0-9]+\\)\\)>" - nil t) - (let ((address (match-string 3)) - (link-text (match-string 1))) - (delete-region (match-beginning 0) (match-end 0)) - (insert "<" - (htmlize-despam-address link-text) - ">"))) - (goto-char (point-min)) - (while (re-search-forward "<\\(\\(URL:\\)?\\([a-zA-Z]+://[^;]+\\)\\)>" - nil t) - (let ((url (match-string 3)) - (link-text (match-string 1))) - (delete-region (match-beginning 0) (match-end 0)) - (insert "<" link-text ">")))) +(defun htmlize-make-tmp-overlay (beg end props) + (let ((overlay (htmlize-make-overlay beg end))) + (htmlize-overlay-put overlay 'htmlize-tmp-overlay t) + (while props + (htmlize-overlay-put overlay (pop props) (pop props))) + overlay)) -;; Tests for htmlize-make-hyperlinks: +(defun htmlize-delete-tmp-overlays () + (dolist (overlay (htmlize-overlays-in (point-min) (point-max))) + (when (htmlize-overlay-get overlay 'htmlize-tmp-overlay) + (htmlize-delete-overlay overlay)))) + +(defun htmlize-make-link-overlay (beg end uri) + (htmlize-make-tmp-overlay beg end `(htmlize-link (:uri ,uri)))) + +(defun htmlize-create-auto-links () + "Add `htmlize-link' property to all mailto links in the buffer." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward + "<\\(\\(mailto:\\)?\\([-=+_.a-zA-Z0-9]+@[-_.a-zA-Z0-9]+\\)\\)>" + nil t) + (let* ((address (match-string 3)) + (beg (match-beginning 0)) (end (match-end 0)) + (uri (concat "mailto:" (htmlize-despam-address address)))) + (htmlize-make-link-overlay beg end uri))) + (goto-char (point-min)) + (while (re-search-forward "<\\(\\(URL:\\)?\\([a-zA-Z]+://[^;>]+\\)\\)>" + nil t) + (htmlize-make-link-overlay + (match-beginning 0) (match-end 0) (match-string 3))))) + +;; Tests for htmlize-create-auto-links: ;; ;; @@ -625,6 +835,13 @@ without modifying their meaning." ;; ;; +(defun htmlize-shadow-form-feeds () + (let ((s "\n
")) + (put-text-property 0 (length s) 'htmlize-literal t s) + (let ((disp `(display ,s))) + (while (re-search-forward "\n\^L" nil t) + (htmlize-make-tmp-overlay (match-beginning 0) (match-end 0) disp))))) + (defun htmlize-defang-local-variables () ;; Juri Linkov reports that an HTML-ized "Local variables" can lead ;; visiting the HTML to fail with "Local variables list is not @@ -637,15 +854,12 @@ without modifying their meaning." ;;; Color handling. -(if (fboundp 'locate-file) - (defalias 'htmlize-locate-file 'locate-file) - (defun htmlize-locate-file (file path) - (dolist (dir path nil) - (when (file-exists-p (expand-file-name file dir)) - (return (expand-file-name file dir)))))) - (defvar htmlize-x-library-search-path - '("/usr/X11R6/lib/X11/" + `(,data-directory + "/etc/X11/rgb.txt" + "/usr/share/X11/rgb.txt" + ;; the remainder of this list really belongs in a museum + "/usr/X11R6/lib/X11/" "/usr/X11R5/lib/X11/" "/usr/lib/X11R6/X11/" "/usr/lib/X11R5/X11/" @@ -675,7 +889,7 @@ If RGB-FILE is nil, the function will try hard to find a suitable file in the system directories. If no rgb.txt file is found, return nil." - (let ((rgb-file (or rgb-file (htmlize-locate-file + (let ((rgb-file (or rgb-file (locate-file "rgb.txt" htmlize-x-library-search-path))) (hash nil)) @@ -796,18 +1010,14 @@ If no rgb.txt file is found, return nil." (t ;; We're getting the RGB components from Emacs. (let ((rgb - ;; Here I cannot conditionalize on (fboundp ...) - ;; because ps-print under some versions of GNU Emacs - ;; defines its own dummy version of - ;; `color-instance-rgb-components'. - (if htmlize-running-xemacs + (if (fboundp 'color-instance-rgb-components) (mapcar (lambda (arg) (/ arg 256)) (color-instance-rgb-components (make-color-instance color))) (mapcar (lambda (arg) (/ arg 256)) - (x-color-values color))))) + (color-values color))))) (when rgb (setq rgb-string (apply #'format "#%02x%02x%02x" rgb)))))) ;; If RGB-STRING is still nil, it means the color cannot be found, @@ -866,12 +1076,37 @@ If no rgb.txt file is found, return nil." ;; Only works in Emacs 21 and later. (let ((size-list (loop - for f = face then (ignore-errors (face-attribute f :inherit)) ;????? + for f = face then (face-attribute f :inherit) until (or (not f) (eq f 'unspecified)) - for h = (ignore-errors (face-attribute f :height)) ;??????? + for h = (face-attribute f :height) collect (if (eq h 'unspecified) nil h)))) (reduce 'htmlize-merge-size (cons nil size-list)))) +(defun htmlize-face-css-name (face) + ;; Generate the css-name property for the given face. Emacs places + ;; no restrictions on the names of symbols that represent faces -- + ;; any characters may be in the name, even control chars. We try + ;; hard to beat the face name into shape, both esthetically and + ;; according to CSS1 specs. + (let ((name (downcase (symbol-name face)))) + (when (string-match "\\`font-lock-" name) + ;; font-lock-FOO-face -> FOO. + (setq name (replace-match "" t t name))) + (when (string-match "-face\\'" name) + ;; Drop the redundant "-face" suffix. + (setq name (replace-match "" t t name))) + (while (string-match "[^-a-zA-Z0-9]" name) + ;; Drop the non-alphanumerics. + (setq name (replace-match "X" t t name))) + (when (string-match "\\`[-0-9]" name) + ;; CSS identifiers may not start with a digit. + (setq name (concat "X" name))) + ;; After these transformations, the face could come out empty. + (when (equal name "") + (setq name "face")) + ;; Apply the prefix. + (concat htmlize-css-name-prefix name))) + (defun htmlize-face-to-fstruct (face) "Convert Emacs face FACE to fstruct." (let ((fstruct (make-htmlize-fstruct @@ -879,87 +1114,53 @@ If no rgb.txt file is found, return nil." (htmlize-face-foreground face)) :background (htmlize-color-to-rgb (htmlize-face-background face))))) - (cond (htmlize-running-xemacs - ;; XEmacs doesn't provide a way to detect whether a face is - ;; bold or italic, so we need to examine the font instance. - ;; #### This probably doesn't work under MS Windows and/or - ;; GTK devices. I'll need help with those. - (let* ((font-instance (face-font-instance face)) - (props (font-instance-properties font-instance))) - (when (equalp (cdr (assq 'WEIGHT_NAME props)) "bold") - (setf (htmlize-fstruct-boldp fstruct) t)) - (when (or (equalp (cdr (assq 'SLANT props)) "i") - (equalp (cdr (assq 'SLANT props)) "o")) - (setf (htmlize-fstruct-italicp fstruct) t)) - (setf (htmlize-fstruct-strikep fstruct) - (face-strikethru-p face)) - (setf (htmlize-fstruct-underlinep fstruct) - (face-underline-p face)))) - ((fboundp 'face-attribute) - ;; GNU Emacs 21 and further. - (dolist (attr '(:weight :slant :underline :overline :strike-through)) - (let ((value (if (>= emacs-major-version 22) - ;; Use the INHERIT arg in GNU Emacs 22. - (face-attribute face attr nil t) - ;; Otherwise, fake it. - (let ((face face)) - (while (and (eq (face-attribute face attr) - 'unspecified) - (not (eq (face-attribute face :inherit) - 'unspecified))) - (setq face (face-attribute face :inherit))) - (face-attribute face attr))))) - (when (and value (not (eq value 'unspecified))) - (htmlize-face-emacs21-attr fstruct attr value)))) - (let ((size (htmlize-face-size face))) - (unless (eql size 1.0) ; ignore non-spec - (setf (htmlize-fstruct-size fstruct) size)))) - (t - ;; Older GNU Emacs. Some of these functions are only - ;; available under Emacs 20+, hence the guards. - (when (fboundp 'face-bold-p) - (setf (htmlize-fstruct-boldp fstruct) (face-bold-p face))) - (when (fboundp 'face-italic-p) - (setf (htmlize-fstruct-italicp fstruct) (face-italic-p face))) - (setf (htmlize-fstruct-underlinep fstruct) - (face-underline-p face)))) - ;; Generate the css-name property. Emacs places no restrictions - ;; on the names of symbols that represent faces -- any characters - ;; may be in the name, even ^@. We try hard to beat the face name - ;; into shape, both esthetically and according to CSS1 specs. - (setf (htmlize-fstruct-css-name fstruct) - (let ((name (downcase (symbol-name face)))) - (when (string-match "\\`font-lock-" name) - ;; Change font-lock-FOO-face to FOO. - (setq name (replace-match "" t t name))) - (when (string-match "-face\\'" name) - ;; Drop the redundant "-face" suffix. - (setq name (replace-match "" t t name))) - (while (string-match "[^-a-zA-Z0-9]" name) - ;; Drop the non-alphanumerics. - (setq name (replace-match "X" t t name))) - (when (string-match "\\`[-0-9]" name) - ;; CSS identifiers may not start with a digit. - (setq name (concat "X" name))) - ;; After these transformations, the face could come - ;; out empty. - (when (equal name "") - (setq name "face")) - ;; Apply the prefix. - (setq name (concat htmlize-css-name-prefix name)) - name)) + (if htmlize-running-xemacs + ;; XEmacs doesn't provide a way to detect whether a face is + ;; bold or italic, so we need to examine the font instance. + (let* ((font-instance (face-font-instance face)) + (props (font-instance-properties font-instance))) + (when (equalp (cdr (assq 'WEIGHT_NAME props)) "bold") + (setf (htmlize-fstruct-boldp fstruct) t)) + (when (or (equalp (cdr (assq 'SLANT props)) "i") + (equalp (cdr (assq 'SLANT props)) "o")) + (setf (htmlize-fstruct-italicp fstruct) t)) + (setf (htmlize-fstruct-strikep fstruct) + (face-strikethru-p face)) + (setf (htmlize-fstruct-underlinep fstruct) + (face-underline-p face))) + ;; GNU Emacs + (dolist (attr '(:weight :slant :underline :overline :strike-through)) + (let ((value (if (>= emacs-major-version 22) + ;; Use the INHERIT arg in GNU Emacs 22. + (face-attribute face attr nil t) + ;; Otherwise, fake it. + (let ((face face)) + (while (and (eq (face-attribute face attr) + 'unspecified) + (not (eq (face-attribute face :inherit) + 'unspecified))) + (setq face (face-attribute face :inherit))) + (face-attribute face attr))))) + (when (and value (not (eq value 'unspecified))) + (htmlize-face-emacs21-attr fstruct attr value)))) + (let ((size (htmlize-face-size face))) + (unless (eql size 1.0) ; ignore non-spec + (setf (htmlize-fstruct-size fstruct) size)))) + (setf (htmlize-fstruct-css-name fstruct) (htmlize-face-css-name face)) fstruct)) (defmacro htmlize-copy-attr-if-set (attr-list dest source) - ;; Expand the code of the type - ;; (and (htmlize-fstruct-ATTR source) - ;; (setf (htmlize-fstruct-ATTR dest) (htmlize-fstruct-ATTR source))) + ;; Generate code with the following pattern: + ;; (progn + ;; (when (htmlize-fstruct-ATTR source) + ;; (setf (htmlize-fstruct-ATTR dest) (htmlize-fstruct-ATTR source))) + ;; ...) ;; for the given list of boolean attributes. (cons 'progn (loop for attr in attr-list for attr-sym = (intern (format "htmlize-fstruct-%s" attr)) - collect `(and (,attr-sym ,source) - (setf (,attr-sym ,dest) (,attr-sym ,source)))))) + collect `(when (,attr-sym ,source) + (setf (,attr-sym ,dest) (,attr-sym ,source)))))) (defun htmlize-merge-size (merged next) ;; Calculate the size of the merge of MERGED and NEXT. @@ -1019,32 +1220,39 @@ If no rgb.txt file is found, return nil." (setf (htmlize-fstruct-css-name fstruct) "ATTRLIST") fstruct)) -(defun htmlize-face-list-p (face-prop) - "Return non-nil if FACE-PROP is a list of faces, nil otherwise." - ;; If not for attrlists, this would return (listp face-prop). This - ;; way we have to be more careful because attrlist is also a list! - (cond - ((eq face-prop nil) - ;; FACE-PROP being nil means empty list (no face), so return t. - t) - ((symbolp face-prop) - ;; A symbol other than nil means that it's only one face, so return - ;; nil. - nil) - ((not (consp face-prop)) - ;; Huh? Not a symbol or cons -- treat it as a single element. - nil) - (t - ;; We know that FACE-PROP is a cons: check whether it looks like an - ;; ATTRLIST. - (let* ((car (car face-prop)) - (attrlist-p (and (symbolp car) - (or (eq car 'foreground-color) - (eq car 'background-color) - (eq (aref (symbol-name car) 0) ?:))))) - ;; If FACE-PROP is not an ATTRLIST, it means it's a list of - ;; faces. - (not attrlist-p))))) +(defun htmlize-decode-face-prop (prop) + "Turn face property PROP into a list of face-like objects." + ;; PROP can be a symbol naming a face, a string naming such a + ;; symbol, a cons (foreground-color . COLOR) or (background-color + ;; COLOR), a property list (:attr1 val1 :attr2 val2 ...), or a list + ;; of any of those. + ;; + ;; (htmlize-decode-face-prop 'face) -> (face) + ;; (htmlize-decode-face-prop '(face1 face2)) -> (face1 face2) + ;; (htmlize-decode-face-prop '(:attr "val")) -> ((:attr "val")) + ;; (htmlize-decode-face-prop '((:attr "val") face (foreground-color "red"))) + ;; -> ((:attr "val") face (foreground-color "red")) + ;; + ;; Unrecognized atoms or non-face symbols/strings are silently + ;; stripped away. + (cond ((null prop) + nil) + ((symbolp prop) + (and (facep prop) + (list prop))) + ((stringp prop) + (and (facep (intern-soft prop)) + (list prop))) + ((atom prop) + nil) + ((and (symbolp (car prop)) + (eq ?: (aref (symbol-name (car prop)) 0))) + (list prop)) + ((or (eq (car prop) 'foreground-color) + (eq (car prop) 'background-color)) + (list prop)) + (t + (apply #'nconc (mapcar #'htmlize-decode-face-prop prop))))) (defun htmlize-make-face-map (faces) ;; Return a hash table mapping Emacs faces to htmlize's fstructs. @@ -1107,22 +1315,14 @@ property and by buffer overlays that specify `face'." (while (< pos (point-max)) (setq face-prop (get-text-property pos 'face) next (or (next-single-property-change pos 'face) (point-max))) - ;; FACE-PROP can be a face/attrlist or a list thereof. - (setq faces (if (htmlize-face-list-p face-prop) - (nunion (mapcar #'htmlize-unstringify-face face-prop) - faces :test 'equal) - (adjoin (htmlize-unstringify-face face-prop) - faces :test 'equal))) + (setq faces (nunion (htmlize-decode-face-prop face-prop) + faces :test 'equal)) (setq pos next))) ;; Faces used by overlays. (dolist (overlay (overlays-in (point-min) (point-max))) (let ((face-prop (overlay-get overlay 'face))) - ;; FACE-PROP can be a face/attrlist or a list thereof. - (setq faces (if (htmlize-face-list-p face-prop) - (nunion (mapcar #'htmlize-unstringify-face face-prop) - faces :test 'equal) - (adjoin (htmlize-unstringify-face face-prop) - faces :test 'equal)))))) + (setq faces (nunion (htmlize-decode-face-prop face-prop) + faces :test 'equal))))) faces)) ;; htmlize-faces-at-point returns the faces in use at point. The @@ -1156,10 +1356,7 @@ property and by buffer overlays that specify `face'." (let (all-faces) ;; Faces from text properties. (let ((face-prop (get-text-property (point) 'face))) - (setq all-faces (if (htmlize-face-list-p face-prop) - (nreverse (mapcar #'htmlize-unstringify-face - face-prop)) - (list (htmlize-unstringify-face face-prop))))) + (setq all-faces (htmlize-decode-face-prop face-prop))) ;; Faces from overlays. (let ((overlays ;; Collect overlays at point that specify `face'. @@ -1189,35 +1386,26 @@ property and by buffer overlays that specify `face'." :key (lambda (o) (or (overlay-get o 'priority) 0)))) (dolist (overlay overlays) - (setq face-prop (overlay-get overlay 'face)) - (setq list (if (htmlize-face-list-p face-prop) - (nconc (nreverse (mapcar - #'htmlize-unstringify-face - face-prop)) - list) - (cons (htmlize-unstringify-face face-prop) list)))) + (setq face-prop (overlay-get overlay 'face) + list (nconc (htmlize-decode-face-prop face-prop) list))) ;; Under "Merging Faces" the manual explicitly states ;; that faces specified by overlays take precedence over ;; faces specified by text properties. (setq all-faces (nconc all-faces list))) all-faces)))) -;; htmlize supports generating HTML in two several fundamentally -;; different ways, one with the use of CSS and nested tags, and -;; the other with the use of the old tags. Rather than adding -;; a bunch of ifs to many places, we take a semi-OO approach. -;; `htmlize-buffer-1' calls a number of "methods", which indirect to -;; the functions that depend on `htmlize-output-type'. The currently -;; used methods are `doctype', `insert-head', `body-tag', and -;; `insert-text'. Not all output types define all methods. +;; htmlize supports generating HTML in several flavors, some of which +;; use CSS, and others the element. We take an OO approach and +;; define "methods" that indirect to the functions that depend on +;; `htmlize-output-type'. The currently used methods are `doctype', +;; `insert-head', `body-tag', and `text-markup'. Not all output types +;; define all methods. ;; ;; Methods are called either with (htmlize-method METHOD ARGS...) ;; special form, or by accessing the function with ;; (htmlize-method-function 'METHOD) and calling (funcall FUNCTION). ;; The latter form is useful in tight loops because `htmlize-method' ;; conses. -;; -;; Currently defined output types are `css' and `font'. (defmacro htmlize-method (method &rest args) ;; Expand to (htmlize-TYPE-METHOD ...ARGS...). TYPE is the value of @@ -1254,34 +1442,14 @@ it's called with the same value of KEY. All other times, the cached (defun htmlize-default-doctype () nil ; no doc-string - ;; According to DTDs published by the W3C, it is illegal to embed - ;; in
.  This makes sense in general, but is bad for
-  ;; htmlize's intended usage of  to specify the document color.
-
-  ;; To make generated HTML legal, htmlize's `font' mode used to
-  ;; specify the SGML declaration of "HTML Pro" DTD here.  HTML Pro
-  ;; aka Silmaril DTD was a project whose goal was to produce a GPL'ed
-  ;; DTD that would encompass all the incompatible HTML extensions
-  ;; procured by Netscape, MSIE, and other players in the field.
-  ;; Apparently the project got abandoned, the last available version
-  ;; being "Draft 0 Revision 11" from January 1997, as documented at
-  ;; .
-
-  ;; Since by now HTML Pro is remembered by none but the most die-hard
-  ;; early-web-days nostalgics and used by not even them, there is no
-  ;; use in specifying it.  So we return the standard HTML 4.0
-  ;; declaration, which makes generated HTML technically illegal.  If
-  ;; you have a problem with that, use the `css' engine designed to
-  ;; create fully conforming HTML.
-
+  ;; Note that the `font' output is technically invalid under this DTD
+  ;; because the DTD doesn't allow embedding  in 
.
   ""
-
-  ;; Now-abandoned HTML Pro declaration.
-  ;""
   )
 
 (defun htmlize-default-body-tag (face-map)
   nil					; no doc-string
+  face-map ; shut up the byte-compiler
   "")
 
 ;;; CSS based output support.
@@ -1347,18 +1515,21 @@ it's called with the same value of KEY.  All other times, the cached
   (insert htmlize-hyperlink-style
 	  "    -->\n    \n"))
 
-(defun htmlize-css-insert-text (text fstruct-list buffer)
-  ;; Insert TEXT colored with FACES into BUFFER.  In CSS mode, this is
-  ;; easy: just nest the text in one  tag for each
-  ;; face in FSTRUCT-LIST.
+(defun htmlize-css-text-markup (fstruct-list buffer)
+  ;; Open the markup needed to insert text colored with FACES into
+  ;; BUFFER.  Return the function that closes the markup.
+
+  ;; In CSS mode, this is easy: just nest the text in one  tag for each face in FSTRUCT-LIST.
   (dolist (fstruct fstruct-list)
     (princ "" buffer))
-  (princ text buffer)
-  (dolist (fstruct fstruct-list)
-    (ignore fstruct)			; shut up the byte-compiler
-    (princ "" buffer)))
+  (htmlize-lexlet ((fstruct-list fstruct-list) (buffer buffer))
+    (lambda ()
+      (dolist (fstruct fstruct-list)
+        (ignore fstruct)                ; shut up the byte-compiler
+        (princ "" buffer)))))
 
 ;; `inline-css' output support.
 
@@ -1367,7 +1538,7 @@ it's called with the same value of KEY.  All other times, the cached
 	  (mapconcat #'identity (htmlize-css-specs (gethash 'default face-map))
 		     " ")))
 
-(defun htmlize-inline-css-insert-text (text fstruct-list buffer)
+(defun htmlize-inline-css-text-markup (fstruct-list buffer)
   (let* ((merged (htmlize-merge-faces fstruct-list))
 	 (style (htmlize-memoize
 		 merged
@@ -1378,9 +1549,10 @@ it's called with the same value of KEY.  All other times, the cached
       (princ "" buffer))
-    (princ text buffer)
-    (when style
-      (princ "" buffer))))
+    (htmlize-lexlet ((style style) (buffer buffer))
+      (lambda ()
+        (when style
+          (princ "" buffer))))))
 
 ;;; `font' tag based output support.
 
@@ -1390,7 +1562,7 @@ it's called with the same value of KEY.  All other times, the cached
 	    (htmlize-fstruct-foreground fstruct)
 	    (htmlize-fstruct-background fstruct))))
 
-(defun htmlize-font-insert-text (text fstruct-list buffer)
+(defun htmlize-font-text-markup (fstruct-list buffer)
   ;; In `font' mode, we use the traditional HTML means of altering
   ;; presentation:  tag for colors,  for bold,  for
   ;; underline, and  for strike-through.
@@ -1411,8 +1583,9 @@ it's called with the same value of KEY.  All other times, the cached
 			 (and (htmlize-fstruct-boldp merged)      "")
 			 (and (htmlize-fstruct-foreground merged) ""))))))
     (princ (car markup) buffer)
-    (princ text buffer)
-    (princ (cdr markup) buffer)))
+    (htmlize-lexlet ((markup markup) (buffer buffer))
+      (lambda ()
+        (princ (cdr markup) buffer)))))
 
 (defun htmlize-buffer-1 ()
   ;; Internal function; don't call it from outside this file.  Htmlize
@@ -1428,122 +1601,118 @@ it's called with the same value of KEY.  All other times, the cached
     (htmlize-ensure-fontified)
     (clrhash htmlize-extended-character-cache)
     (clrhash htmlize-memoization-table)
-    (let* ((buffer-faces (htmlize-faces-in-buffer))
-	   (face-map (htmlize-make-face-map (adjoin 'default buffer-faces)))
-	   ;; Generate the new buffer.  It's important that it inherits
-	   ;; default-directory from the current buffer.
-	   (htmlbuf (generate-new-buffer (if (buffer-file-name)
-					     (htmlize-make-file-name
-					      (file-name-nondirectory
-					       (buffer-file-name)))
-					   "*html*")))
-	   ;; Having a dummy value in the plist allows writing simply
-	   ;; (plist-put places foo bar).
-	   (places '(nil nil))
-	   (title (if (buffer-file-name)
-		      (file-name-nondirectory (buffer-file-name))
-		    (buffer-name))))
-      ;; Initialize HTMLBUF and insert the HTML prolog.
-      (with-current-buffer htmlbuf
-	(buffer-disable-undo)
-	(insert (htmlize-method doctype) ?\n
-		(format "\n"
-			htmlize-version htmlize-output-type)
-		"\n  ")
-	(plist-put places 'head-start (point-marker))
-	(insert "\n"
-		"    " (htmlize-protect-string title) "\n"
-		(if htmlize-html-charset
-		    (format (concat "    \n")
-			    htmlize-html-charset)
-		  "")
-		htmlize-head-tags)
-	(htmlize-method insert-head buffer-faces face-map)
-	(insert "  ")
-	(plist-put places 'head-end (point-marker))
-	(insert "\n  ")
-	(plist-put places 'body-start (point-marker))
-	(insert (htmlize-method body-tag face-map)
-		"\n    ")
-	(plist-put places 'content-start (point-marker))
-	(insert "
\n"))
-      (let ((insert-text-method
-	     ;; Get the inserter method, so we can funcall it inside
-	     ;; the loop.  Not calling `htmlize-method' in the loop
-	     ;; body yields a measurable speed increase.
-	     (htmlize-method-function 'insert-text))
-	    ;; Declare variables used in loop body outside the loop
-	    ;; because it's faster to establish `let' bindings only
-	    ;; once.
-	    next-change text face-list fstruct-list trailing-ellipsis)
-	;; This loop traverses and reads the source buffer, appending
-	;; the resulting HTML to HTMLBUF with `princ'.  This method is
-	;; fast because: 1) it doesn't require examining the text
-	;; properties char by char (htmlize-next-change is used to
-	;; move between runs with the same face), and 2) it doesn't
-	;; require buffer switches, which are slow in Emacs.
-	(goto-char (point-min))
-	(while (not (eobp))
-	  (setq next-change (htmlize-next-change (point) 'face))
-	  ;; Get faces in use between (point) and NEXT-CHANGE, and
-	  ;; convert them to fstructs.
-	  (setq face-list (htmlize-faces-at-point)
-		fstruct-list (delq nil (mapcar (lambda (f)
-						 (gethash f face-map))
-					       face-list)))
-	  ;; Extract buffer text, sans the invisible parts.  Then
-	  ;; untabify it and escape the HTML metacharacters.
-	  (setq text (htmlize-buffer-substring-no-invisible
-		      (point) next-change))
-	  (when trailing-ellipsis
-	    (setq text (htmlize-trim-ellipsis text)))
-	  ;; If TEXT ends up empty, don't change trailing-ellipsis.
-	  (when (> (length text) 0)
-	    (setq trailing-ellipsis
-		  (get-text-property (1- (length text))
-				     'htmlize-ellipsis text)))
-	  (setq text (htmlize-untabify text (current-column)))
-	  (setq text (htmlize-protect-string text))
-	  ;; Don't bother writing anything if there's no text (this
-	  ;; happens in invisible regions).
-	  (when (> (length text) 0)
-	    ;; Insert the text, along with the necessary markup to
-	    ;; represent faces in FSTRUCT-LIST.
-	    (funcall insert-text-method text fstruct-list htmlbuf))
-	  (goto-char next-change)))
+    ;; It's important that the new buffer inherits default-directory
+    ;; from the current buffer.
+    (let ((htmlbuf (generate-new-buffer (if (buffer-file-name)
+                                            (htmlize-make-file-name
+                                             (file-name-nondirectory
+                                              (buffer-file-name)))
+                                          "*html*")))
+          (completed nil))
+      (unwind-protect
+          (let* ((buffer-faces (htmlize-faces-in-buffer))
+                 (face-map (htmlize-make-face-map (adjoin 'default buffer-faces)))
+                 (places (gensym))
+                 (title (if (buffer-file-name)
+                            (file-name-nondirectory (buffer-file-name))
+                          (buffer-name))))
+            (when htmlize-generate-hyperlinks
+              (htmlize-create-auto-links))
+            (when htmlize-replace-form-feeds
+              (htmlize-shadow-form-feeds))
 
-      ;; Insert the epilog and post-process the buffer.
-      (with-current-buffer htmlbuf
-	(insert "
") - (plist-put places 'content-end (point-marker)) - (insert "\n ") - (plist-put places 'body-end (point-marker)) - (insert "\n\n") - (when htmlize-generate-hyperlinks - (htmlize-make-hyperlinks)) - (htmlize-defang-local-variables) - (when htmlize-replace-form-feeds - ;; Change each "\n^L" to "
". - (goto-char (point-min)) - (let ((source - ;; ^L has already been escaped, so search for that. - (htmlize-protect-string "\n\^L")) - (replacement - (if (stringp htmlize-replace-form-feeds) - htmlize-replace-form-feeds - "

")))
-	    (while (search-forward source nil t)
-	      (replace-match replacement t t))))
-	(goto-char (point-min))
-	(when htmlize-html-major-mode
-	  ;; What sucks about this is that the minor modes, most notably
-	  ;; font-lock-mode, won't be initialized.  Oh well.
-	  (funcall htmlize-html-major-mode))
-	(set (make-local-variable 'htmlize-buffer-places) places)
-	(run-hooks 'htmlize-after-hook)
-	(buffer-enable-undo))
-      htmlbuf)))
+            ;; Initialize HTMLBUF and insert the HTML prolog.
+            (with-current-buffer htmlbuf
+              (buffer-disable-undo)
+              (insert (htmlize-method doctype) ?\n
+                      (format "\n"
+                              htmlize-version htmlize-output-type)
+                      "\n  ")
+              (put places 'head-start (point-marker))
+              (insert "\n"
+                      "    " (htmlize-protect-string title) "\n"
+                      (if htmlize-html-charset
+                          (format (concat "    \n")
+                                  htmlize-html-charset)
+                        "")
+                      htmlize-head-tags)
+              (htmlize-method insert-head buffer-faces face-map)
+              (insert "  ")
+              (put places 'head-end (point-marker))
+              (insert "\n  ")
+              (put places 'body-start (point-marker))
+              (insert (htmlize-method body-tag face-map)
+                      "\n    ")
+              (put places 'content-start (point-marker))
+              (insert "
\n"))
+            (let ((text-markup
+                   ;; Get the inserter method, so we can funcall it inside
+                   ;; the loop.  Not calling `htmlize-method' in the loop
+                   ;; body yields a measurable speed increase.
+                   (htmlize-method-function 'text-markup))
+                  ;; Declare variables used in loop body outside the loop
+                  ;; because it's faster to establish `let' bindings only
+                  ;; once.
+                  next-change text face-list trailing-ellipsis
+                  fstruct-list last-fstruct-list
+                  (close-markup (lambda ())))
+              ;; This loop traverses and reads the source buffer, appending
+              ;; the resulting HTML to HTMLBUF.  This method is fast
+              ;; because: 1) it doesn't require examining the text
+              ;; properties char by char (htmlize-next-face-change is used
+              ;; to move between runs with the same face), and 2) it doesn't
+              ;; require frequent buffer switches, which are slow because
+              ;; they rebind all buffer-local vars.
+              (goto-char (point-min))
+              (while (not (eobp))
+                (setq next-change (htmlize-next-face-change (point)))
+                ;; Get faces in use between (point) and NEXT-CHANGE, and
+                ;; convert them to fstructs.
+                (setq face-list (htmlize-faces-at-point)
+                      fstruct-list (delq nil (mapcar (lambda (f)
+                                                       (gethash f face-map))
+                                                     face-list)))
+                (multiple-value-setq (text trailing-ellipsis)
+                  (htmlize-extract-text (point) next-change trailing-ellipsis))
+                ;; Don't bother writing anything if there's no text (this
+                ;; happens in invisible regions).
+                (when (> (length text) 0)
+                  ;; Open the new markup if necessary and insert the text.
+                  (when (not (equalp fstruct-list last-fstruct-list))
+                    (funcall close-markup)
+                    (setq last-fstruct-list fstruct-list
+                          close-markup (funcall text-markup fstruct-list htmlbuf)))
+                  (princ text htmlbuf))
+                (goto-char next-change))
+
+              ;; We've gone through the buffer; close the markup from
+              ;; the last run, if any.
+              (funcall close-markup))
+
+            ;; Insert the epilog and post-process the buffer.
+            (with-current-buffer htmlbuf
+              (insert "
") + (put places 'content-end (point-marker)) + (insert "\n ") + (put places 'body-end (point-marker)) + (insert "\n\n") + (htmlize-defang-local-variables) + (goto-char (point-min)) + (when htmlize-html-major-mode + ;; What sucks about this is that the minor modes, most notably + ;; font-lock-mode, won't be initialized. Oh well. + (funcall htmlize-html-major-mode)) + (set (make-local-variable 'htmlize-buffer-places) + (symbol-plist places)) + (run-hooks 'htmlize-after-hook) + (buffer-enable-undo)) + (setq completed t) + htmlbuf) + + (when (not completed) + (kill-buffer htmlbuf)) + (htmlize-delete-tmp-overlays))))) ;; Utility functions. @@ -1766,4 +1935,9 @@ corresponding source file." (provide 'htmlize) +;; Local Variables: +;; byte-compile-warnings: (not cl-functions lexical unresolved obsolete) +;; lexical-binding: t +;; End: + ;;; htmlize.el ends here diff --git a/contrib/lisp/ob-eukleides.el b/contrib/lisp/ob-eukleides.el new file mode 100644 index 000000000..e25ed1c7e --- /dev/null +++ b/contrib/lisp/ob-eukleides.el @@ -0,0 +1,98 @@ +;;; ob-eukleides.el --- Org-babel functions for eukleides evaluation + +;; Copyright (C) 2010-2013 Free Software Foundation, Inc. + +;; Author: Luis Anaya +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Org-Babel support for evaluating eukleides script. +;; +;; Inspired by Ian Yang's org-export-blocks-format-eukleides +;; http://www.emacswiki.org/emacs/org-export-blocks-format-eukleides.el + +;;; Requirements: + +;; eukleides | http://eukleides.org +;; eukleides | `org-eukleides-path' should point to the eukleides executablexs + +;;; Code: +(require 'ob) +(require 'ob-eval) + +(defvar org-babel-default-header-args:eukleides + '((:results . "file") (:exports . "results")) + "Default arguments for evaluating a eukleides source block.") + +(defcustom org-eukleides-path nil + "Path to the eukleides executable file." + :group 'org-babel + :type 'string) + +(defcustom org-eukleides-eps-to-raster nil + "Command used to convert EPS to raster. Nil for no conversion." + :group 'org-babel + :type '(choice + (repeat :tag "Shell Command Sequence" (string :tag "Shell Command")) + (const :tag "sam2p" "a=%s;b=%s;sam2p ${a} ${b}" ) + (const :tag "NetPNM" "a=%s;b=%s;pstopnm -stdout ${a} | pnmtopng > ${b}" ) + (const :tag "None" nil))) + +(defun org-babel-execute:eukleides (body params) + "Execute a block of eukleides code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (or (cdr (assoc :file params)) + (error "Eukleides requires a \":file\" header argument"))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "eukleides-")) + (java (or (cdr (assoc :java params)) "")) + (cmd (if (not org-eukleides-path) + (error "`org-eukleides-path' is not set") + (concat (expand-file-name org-eukleides-path) + " -b --output=" + (org-babel-process-file-name + (concat + (file-name-sans-extension out-file) ".eps")) + " " + (org-babel-process-file-name in-file))))) + (unless (file-exists-p org-eukleides-path) + (error "Could not find eukleides at %s" org-eukleides-path)) + + (if (string= (file-name-extension out-file) "png") + (if org-eukleides-eps-to-raster + (shell-command (format org-eukleides-eps-to-raster + (concat (file-name-sans-extension out-file) ".eps") + (concat (file-name-sans-extension out-file) ".png"))) + (error "Conversion to PNG not supported. use a file with an EPS name"))) + + (with-temp-file in-file (insert body)) + (message "%s" cmd) (org-babel-eval cmd "") + nil)) ;; signal that output has already been written to file + +(defun org-babel-prep-session:eukleides (session params) + "Return an error because eukleides does not support sessions." + (error "Eukleides does not support sessions")) + +(provide 'ob-eukleides) + + + +;;; ob-eukleides.el ends here diff --git a/contrib/babel/langs/ob-fomus.el b/contrib/lisp/ob-fomus.el similarity index 96% rename from contrib/babel/langs/ob-fomus.el rename to contrib/lisp/ob-fomus.el index b37f4950d..58183fb78 100644 --- a/contrib/babel/langs/ob-fomus.el +++ b/contrib/lisp/ob-fomus.el @@ -1,13 +1,12 @@ -;;; ob-fomus.el --- org-babel functions for fomus evaluation +;;; ob-fomus.el --- Org-babel functions for fomus evaluation ;; Copyright (C) 2011-2013 Torsten Anders ;; Author: Torsten Anders ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org -;; Version: -;;; License: +;; This file is not part of GNU Emacs. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/contrib/lisp/ob-julia.el b/contrib/lisp/ob-julia.el new file mode 100644 index 000000000..3aed81876 --- /dev/null +++ b/contrib/lisp/ob-julia.el @@ -0,0 +1,302 @@ +;;; ob-julia.el --- org-babel functions for julia code evaluation + +;; Copyright (C) 2013 G. Jay Kerns +;; Author: G. Jay Kerns, based on ob-R.el by Eric Schulte and Dan Davison + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; The file provides Org-Babel support for evaluating julia code. +;; +;; See https://github.com/gjkerns/ob-julia/blob/master/ob-julia-doc.org +;; for detailed instructions on how to get started. The git repository +;; contains more documentation: git://github.com/gjkerns/ob-julia.git + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function orgtbl-to-csv "org-table" (table params)) +(declare-function julia "ext:ess-julia" (&optional start-args)) +(declare-function inferior-ess-send-input "ext:ess-inf" ()) +(declare-function ess-make-buffer-current "ext:ess-inf" ()) +(declare-function ess-eval-buffer "ext:ess-inf" (vis)) +(declare-function org-number-sequence "org-compat" (from &optional to inc)) +(declare-function org-remove-if-not "org" (predicate seq)) + +(defconst org-babel-header-args:julia + '((width . :any) + (horizontal . :any) + (results . ((file list vector table scalar verbatim) + (raw org html latex code pp wrap) + (replace silent append prepend) + (output value graphics)))) + "julia-specific header arguments.") + +(add-to-list 'org-babel-tangle-lang-exts '("julia" . "jl")) + +(defvar org-babel-default-header-args:julia '()) + +(defcustom org-babel-julia-command inferior-julia-program-name + "Name of command to use for executing julia code." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defvar ess-local-process-name) ; dynamically scoped +(defun org-babel-edit-prep:julia (info) + (let ((session (cdr (assoc :session (nth 2 info))))) + (when (and session (string-match "^\\*\\(.+?\\)\\*$" session)) + (save-match-data (org-babel-julia-initiate-session session nil))))) + +(defun org-babel-expand-body:julia (body params &optional graphics-file) + "Expand BODY according to PARAMS, return the expanded body." + (let ((graphics-file + (or graphics-file (org-babel-julia-graphical-output-file params)))) + (mapconcat + #'identity + ((lambda (inside) + (if graphics-file + inside + inside)) + (append (org-babel-variable-assignments:julia params) + (list body))) "\n"))) + +(defun org-babel-execute:julia (body params) + "Execute a block of julia code. +This function is called by `org-babel-execute-src-block'." + (save-excursion + (let* ((result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (session (org-babel-julia-initiate-session + (cdr (assoc :session params)) params)) + (colnames-p (cdr (assoc :colnames params))) + (rownames-p (cdr (assoc :rownames params))) + (graphics-file (org-babel-julia-graphical-output-file params)) + (full-body (org-babel-expand-body:julia body params graphics-file)) + (result + (org-babel-julia-evaluate + session full-body result-type result-params + (or (equal "yes" colnames-p) + (org-babel-pick-name + (cdr (assoc :colname-names params)) colnames-p)) + (or (equal "yes" rownames-p) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) rownames-p))))) + (if graphics-file nil result)))) + +(defun org-babel-prep-session:julia (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-julia-initiate-session session params)) + (var-lines (org-babel-variable-assignments:julia params))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:julia (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:julia session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-variable-assignments:julia (params) + "Return list of julia statements assigning the block's variables." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (mapcar + (lambda (pair) + (org-babel-julia-assign-elisp + (car pair) (cdr pair) + (equal "yes" (cdr (assoc :colnames params))) + (equal "yes" (cdr (assoc :rownames params))))) + (mapcar + (lambda (i) + (cons (car (nth i vars)) + (org-babel-reassemble-table + (cdr (nth i vars)) + (cdr (nth i (cdr (assoc :colname-names params)))) + (cdr (nth i (cdr (assoc :rowname-names params))))))) + (org-number-sequence 0 (1- (length vars))))))) + +(defun org-babel-julia-quote-csv-field (s) + "Quote field S for export to julia." + (if (stringp s) + (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") + (format "%S" s))) + +(defun org-babel-julia-assign-elisp (name value colnames-p rownames-p) + "Construct julia code assigning the elisp VALUE to a variable named NAME." + (if (listp value) + (let ((max (apply #'max (mapcar #'length (org-remove-if-not + #'sequencep value)))) + (min (apply #'min (mapcar #'length (org-remove-if-not + #'sequencep value)))) + (transition-file (org-babel-temp-file "julia-import-"))) + ;; ensure VALUE has an orgtbl structure (depth of at least 2) + (unless (listp (car value)) (setq value (list value))) + (with-temp-file transition-file + (insert + (orgtbl-to-csv value '(:fmt org-babel-julia-quote-csv-field)) + "\n")) + (let ((file (org-babel-process-file-name transition-file 'noquote)) + (header (if (or (eq (nth 1 value) 'hline) colnames-p) + "TRUE" "FALSE")) + (row-names (if rownames-p "1" "NULL"))) + (if (= max min) + (format "%s = readcsv(\"%s\")" name file) + (format "%s = readcsv(\"%s\")" + name file)))) + (format "%s = %s" name (org-babel-julia-quote-csv-field value)))) + +(defvar ess-ask-for-ess-directory) ; dynamically scoped + +(defun org-babel-julia-initiate-session (session params) + "If there is not a current julia process then create one." + (unless (string= session "none") + (let ((session (or session "*julia*")) + (ess-ask-for-ess-directory + (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory) + (not (cdr (assoc :dir params)))))) + (if (org-babel-comint-buffer-livep session) + session + (save-window-excursion + (require 'ess) (julia) + (rename-buffer + (if (bufferp session) + (buffer-name session) + (if (stringp session) + session + (buffer-name)))) + (current-buffer)))))) + +(defun org-babel-julia-associate-session (session) + "Associate julia code buffer with a julia session. +Make SESSION be the inferior ESS process associated with the +current code buffer." + (setq ess-local-process-name + (process-name (get-buffer-process session))) + (ess-make-buffer-current)) + +(defun org-babel-julia-graphical-output-file (params) + "Name of file to which julia should send graphical output." + (and (member "graphics" (cdr (assq :result-params params))) + (cdr (assq :file params)))) + +(defvar org-babel-julia-eoe-indicator "print(\"org_babel_julia_eoe\")") +(defvar org-babel-julia-eoe-output "org_babel_julia_eoe") + +(defvar org-babel-julia-write-object-command "writecsv(\"%s\",%s)") + +;; The following was a very complicated write object command +;; The replacement needs to add error catching +;(defvar org-babel-julia-write-object-command "{function(object,transfer.file){object;invisible(if(inherits(try({tfile<-tempfile();write.table(object,file=tfile,sep=\"\\t\",na=\"nil\",row.names=%s,col.names=%s,quote=FALSE);file.rename(tfile,transfer.file)},silent=TRUE),\"try-error\")){if(!file.exists(transfer.file))file.create(transfer.file)})}}(object=%s,transfer.file=\"%s\")") + +(defun org-babel-julia-evaluate + (session body result-type result-params column-names-p row-names-p) + "Evaluate julia code in BODY." + (if session + (org-babel-julia-evaluate-session + session body result-type result-params column-names-p row-names-p) + (org-babel-julia-evaluate-external-process + body result-type result-params column-names-p row-names-p))) + +(defun org-babel-julia-evaluate-external-process + (body result-type result-params column-names-p row-names-p) + "Evaluate BODY in external julia process. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (value + (let ((tmp-file (org-babel-temp-file "julia-"))) + (org-babel-eval org-babel-julia-command + (format org-babel-julia-write-object-command + (org-babel-process-file-name tmp-file 'noquote) + (format "begin\n%s\nend" body))) + (org-babel-julia-process-value-result + (org-babel-result-cond result-params + (with-temp-buffer + (insert-file-contents tmp-file) + (buffer-string)) + (org-babel-import-elisp-from-file tmp-file '(4))) + column-names-p))) + (output (org-babel-eval org-babel-julia-command body)))) + +(defun org-babel-julia-evaluate-session + (session body result-type result-params column-names-p row-names-p) + "Evaluate BODY in SESSION. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (value + (with-temp-buffer + (insert (org-babel-chomp body)) + (let ((ess-local-process-name + (process-name (get-buffer-process session))) + (ess-eval-visibly-p nil)) + (ess-eval-buffer nil))) + (let ((tmp-file (org-babel-temp-file "julia-"))) + (org-babel-comint-eval-invisibly-and-wait-for-file + session tmp-file + (format org-babel-julia-write-object-command + (org-babel-process-file-name tmp-file 'noquote) "ans")) + (org-babel-julia-process-value-result + (org-babel-result-cond result-params + (with-temp-buffer + (insert-file-contents tmp-file) + (buffer-string)) + (org-babel-import-elisp-from-file tmp-file '(4))) + column-names-p))) + (output + (mapconcat + #'org-babel-chomp + (butlast + (delq nil + (mapcar + (lambda (line) (when (> (length line) 0) line)) + (mapcar + (lambda (line) ;; cleanup extra prompts left in output + (if (string-match + "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line) + (substring line (match-end 1)) + line)) + (org-babel-comint-with-output (session org-babel-julia-eoe-output) + (insert (mapconcat #'org-babel-chomp + (list body org-babel-julia-eoe-indicator) + "\n")) + (inferior-ess-send-input)))))) "\n")))) + +(defun org-babel-julia-process-value-result (result column-names-p) + "julia-specific processing of return value. +Insert hline if column names in output have been requested." + (if column-names-p + (cons (car result) (cons 'hline (cdr result))) + result)) + +(provide 'ob-julia) + +;;; ob-julia.el ends here diff --git a/contrib/lisp/ob-mathomatic.el b/contrib/lisp/ob-mathomatic.el new file mode 100644 index 000000000..585604e08 --- /dev/null +++ b/contrib/lisp/ob-mathomatic.el @@ -0,0 +1,145 @@ +;;; ob-mathomatic.el --- Org-babel functions for mathomatic evaluation + +;; Copyright (C) 2009-2013 Free Software Foundation, Inc. + +;; Author: Eric S Fraga +;; Eric Schulte +;; Luis Anaya (Mathomatic) + +;; Keywords: literate programming, reproducible research, mathomatic +;; Homepage: http://orgmode.org + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Org-Babel support for evaluating mathomatic entries. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in mathomatic +;; +;; 2) we are adding the "cmdline" header argument + +;;; Code: +(require 'ob) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("mathomatic" . "math")) + +(defvar org-babel-default-header-args:mathomatic '()) + +(defcustom org-babel-mathomatic-command + (if (boundp 'mathomatic-command) mathomatic-command "mathomatic") + "Command used to call mathomatic on the shell." + :group 'org-babel) + +(defun org-babel-mathomatic-expand (body params) + "Expand a block of Mathomatic code according to its header arguments." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (mapconcat 'identity + (list + ;; graphic output + (let ((graphic-file (org-babel-mathomatic-graphical-output-file params))) + (if graphic-file + (cond + ((string-match ".\.eps$" graphic-file) + (format ;; Need to add command to send to file. + "set plot set terminal postscript eps\\;set output %S " + graphic-file)) + ((string-match ".\.ps$" graphic-file) + (format ;; Need to add command to send to file. + "set plot set terminal postscript\\;set output %S " + graphic-file)) + + ((string-match ".\.pic$" graphic-file) + (format ;; Need to add command to send to file. + "set plot set terminal gpic\\;set output %S " + graphic-file)) + (t + (format ;; Need to add command to send to file. + "set plot set terminal png\\;set output %S " + graphic-file))) + "")) + ;; variables + (mapconcat 'org-babel-mathomatic-var-to-mathomatic vars "\n") + ;; body + body + "") + "\n"))) + +(defun org-babel-execute:mathomatic (body params) + "Execute a block of Mathomatic entries with org-babel. This function is +called by `org-babel-execute-src-block'." + (message "executing Mathomatic source code block") + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (result + (let* ((cmdline (or (cdr (assoc :cmdline params)) "")) + (in-file (org-babel-temp-file "mathomatic-" ".math")) + (cmd (format "%s -t -c -q %s %s" + org-babel-mathomatic-command in-file cmdline))) + (with-temp-file in-file (insert (org-babel-mathomatic-expand body params))) + (message cmd) + ((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' " + (mapconcat + #'identity + (delq nil + (mapcar (lambda (line) + (unless (or (string-match "batch" line) + (string-match "^rat: replaced .*$" line) + (= 0 (length line))) + line)) + (split-string raw "[\r\n]"))) "\n")) + (org-babel-eval cmd ""))))) + (if (org-babel-mathomatic-graphical-output-file params) + nil + (if (or (member "scalar" result-params) + (member "verbatim" result-params) + (member "output" result-params)) + result + (let ((tmp-file (org-babel-temp-file "mathomatic-res-"))) + (with-temp-file tmp-file (insert result)) + (org-babel-import-elisp-from-file tmp-file)))))) + +(defun org-babel-prep-session:mathomatic (session params) + (error "Mathomatic does not support sessions")) + +(defun org-babel-mathomatic-var-to-mathomatic (pair) + "Convert an elisp val into a string of mathomatic code specifying a var +of the same value." + (let ((var (car pair)) + (val (cdr pair))) + (when (symbolp val) + (setq val (symbol-name val)) + (when (= (length val) 1) + (setq val (string-to-char val)))) + (format "%s=%s" var + (org-babel-mathomatic-elisp-to-mathomatic val)))) + +(defun org-babel-mathomatic-graphical-output-file (params) + "Name of file to which mathomatic should send graphical output." + (and (member "graphics" (cdr (assq :result-params params))) + (cdr (assq :file params)))) + +(defun org-babel-mathomatic-elisp-to-mathomatic (val) + "Return a string of mathomatic code which evaluates to VAL." + (if (listp val) + (mapconcat #'org-babel-mathomatic-elisp-to-mathomatic val " ") + (format "%s" val))) + +(provide 'ob-mathomatic) + +;;; ob-mathomatic.el ends here diff --git a/contrib/babel/langs/ob-oz.el b/contrib/lisp/ob-oz.el similarity index 95% rename from contrib/babel/langs/ob-oz.el rename to contrib/lisp/ob-oz.el index bbeead3fe..ce8e8a60d 100644 --- a/contrib/babel/langs/ob-oz.el +++ b/contrib/lisp/ob-oz.el @@ -1,13 +1,13 @@ -;;; ob-oz.el --- org-babel functions for Oz evaluation +;;; ob-oz.el --- Org-babel functions for Oz evaluation -;; Copyright (C) 2009-2013 Torsten Anders and Eric Schulte +;; Copyright (C) 2009-2013 Torsten Anders and Eric Schulte -;; Author: Torsten Anders and Eric Schulte +;; Author: Torsten Anders and Eric Schulte ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org ;; Version: 0.02 -;;; License: +;; This file is not part of GNU Emacs. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -26,7 +26,7 @@ ;;; Commentary: -;; Org-Babel support for evaluating Oz source code. +;; Org-Babel support for evaluating Oz source code. ;; ;; Oz code is always send to the Oz Programming Environment (OPI), the ;; Emacs mode and compiler interface for Oz programs. Therefore, only @@ -71,7 +71,7 @@ ;; arrive then in any order) I could use IDs ;; (e.g. integers). However, how do I do concurrency in Emacs Lisp, ;; and how can I define org-babel-execute:oz concurrently. -;; +;; ;; - Expressions are rarely used in Oz at the top-level, and using ;; them in documentation and Literate Programs will cause ;; confusion. Idea: hide expression from reader and instead show @@ -94,10 +94,10 @@ ;; ;; Interface to communicate with Oz. -;; (1) For statements without any results: oz-send-string +;; (1) For statements without any results: oz-send-string ;; (2) For expressions with a single result: oz-send-string-expression ;; (defined in org-babel-oz-ResultsValue.el) -;; +;; ;; oz-send-string-expression implements an additional very direct ;; communication between Org-babel and the Oz compiler. Communication @@ -128,7 +128,7 @@ "Path to the contrib/scripts directory in which StartOzServer.oz is located.") -(defvar org-babel-oz-port 6001 +(defvar org-babel-oz-port 6001 "Port for communicating with Oz compiler.") (defvar org-babel-oz-OPI-socket nil "Socket for communicating with OPI.") @@ -144,18 +144,18 @@ StartOzServer.oz is located.") (defun org-babel-oz-create-socket () (message "Create OPI socket for evaluating expressions") - ;; Start Oz directly + ;; Start Oz directly (run-oz) ;; Create socket on Oz side (after Oz was started). (oz-send-string (concat "\\insert '" org-babel-oz-server-dir "StartOzServer.oz'")) ;; Wait until socket is created before connecting to it. ;; Quick hack: wait 3 sec - ;; + ;; ;; extending time to 30 secs does not help when starting Emacs for ;; the first time (and computer does nothing else) (sit-for 3) ;; connect to OPI socket - (setq org-babel-oz-OPI-socket + (setq org-babel-oz-OPI-socket ;; Creates a socket. I/O interface of Emacs sockets as for processes. (open-network-stream "*Org-babel-OPI-socket*" nil "localhost" org-babel-oz-port)) ;; install filter @@ -166,7 +166,7 @@ StartOzServer.oz is located.") ;; oz-send-string-expression turns is into synchronous... (defun oz-send-string-expression (string &optional wait-time) "Similar to oz-send-string, oz-send-string-expression sends a string to the OPI compiler. However, string must be expression and this function returns the result of the expression (as string). oz-send-string-expression is synchronous, wait-time allows to specify a maximum wait time. After wait-time is over with no result, the function returns nil." - (if (not org-babel-oz-OPI-socket) + (if (not org-babel-oz-OPI-socket) (org-babel-oz-create-socket)) (let ((polling-delay 0.1) result) @@ -176,11 +176,11 @@ StartOzServer.oz is located.") (let ((waited 0)) (unwind-protect (progn - (while + (while ;; stop loop if org-babel-oz-collected-result \= nil or waiting time is over (not (or (not (equal org-babel-oz-collected-result nil)) (> waited wait-time))) - (progn + (progn (sit-for polling-delay) ;; (message "org-babel-oz: next polling iteration") (setq waited (+ waited polling-delay)))) @@ -253,7 +253,7 @@ called by `org-babel-execute-src-block' via multiple-value-bind." ;; (when vars ;; (with-temp-buffer ;; (insert var-lines) (write-file vars-file) -;; (oz-mode) +;; (oz-mode) ;; ;; (inferior-oz-load-file) ; ?? ;; )) ;; (current-buffer)))) @@ -262,7 +262,7 @@ called by `org-babel-execute-src-block' via multiple-value-bind." ;; TODO: testing... (simplified version of def in org-babel-prep-session:ocaml) ;; -;; BUG: does not work yet. Error: ad-Orig-error: buffer none doesn't exist or has no process +;; BUG: does not work yet. Error: ad-Orig-error: buffer none doesn't exist or has no process ;; UNUSED DEF (defun org-babel-oz-initiate-session (&optional session params) "If there is not a current inferior-process-buffer in SESSION @@ -278,12 +278,12 @@ then create. Return the initialized session." specifying a var of the same value." (if (listp var) ;; (concat "[" (mapconcat #'org-babel-oz-var-to-oz var ", ") "]") - (eval var) - (format "%s" var) ; don't preserve string quotes. + (eval var) + (format "%s" var) ; don't preserve string quotes. ;; (format "%s" var) )) -;; TODO: +;; TODO: (defun org-babel-oz-table-or-string (results) "If the results look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." diff --git a/contrib/lisp/ob-tcl.el b/contrib/lisp/ob-tcl.el new file mode 100644 index 000000000..e8d735bb5 --- /dev/null +++ b/contrib/lisp/ob-tcl.el @@ -0,0 +1,128 @@ +;;; ob-tcl.el --- Org-babel functions for tcl evaluation + +;; Copyright (C) 2009-2013 Free Software Foundation, Inc. + +;; Authors: Dan Davison +;; Eric Schulte +;; Luis Anaya (tcl) +;; +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Org-Babel support for evaluating tcl source code. + +;;; Code: +(require 'ob) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("tcl" . "tcl")) + +(defvar org-babel-default-header-args:tcl nil) + +(defcustom org-babel-tcl-command "tclsh" +"Name of command to use for executing Tcl code." + :group 'org-babel + :type 'string) + + +(defun org-babel-execute:tcl (body params) + "Execute a block of Tcl code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((session (cdr (assoc :session params))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:tcl params))) + (session (org-babel-tcl-initiate-session session))) + (org-babel-reassemble-table + (org-babel-tcl-evaluate session full-body result-type) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + +(defun org-babel-prep-session:tcl (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (error "Sessions are not supported for Tcl.")) + +(defun org-babel-variable-assignments:tcl (params) + "Return list of tcl statements assigning the block's variables." + (mapcar + (lambda (pair) + (format "set %s %s" + (car pair) + (org-babel-tcl-var-to-tcl (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +;; helper functions + +(defun org-babel-tcl-var-to-tcl (var) + "Convert an elisp value to a tcl variable. +The elisp value, VAR, is converted to a string of tcl source code +specifying a var of the same value." + (if (listp var) + (concat "{" (mapconcat #'org-babel-tcl-var-to-tcl var " ") "}") + (format "%s" var))) + +(defvar org-babel-tcl-buffers '(:default . nil)) + +(defun org-babel-tcl-initiate-session (&optional session params) + "Return nil because sessions are not supported by tcl." +nil) + +(defvar org-babel-tcl-wrapper-method + " +proc main {} { + %s +} + +set r [eval main] +set o [open \"%s\" \"w\"]; +puts $o $r +flush $o +close $o + +") + +(defvar org-babel-tcl-pp-wrapper-method + nil) + +(defun org-babel-tcl-evaluate (session body &optional result-type) + "Pass BODY to the Tcl process in SESSION. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY, as elisp." + (when session (error "Sessions are not supported for Tcl.")) + (case result-type + (output (org-babel-eval org-babel-tcl-command body)) + (value (let ((tmp-file (org-babel-temp-file "tcl-"))) + (org-babel-eval + org-babel-tcl-command + (format org-babel-tcl-wrapper-method body + (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-eval-read-file tmp-file))))) + +(provide 'ob-tcl) + + + +;;; ob-tcl.el ends here diff --git a/contrib/lisp/org-bibtex-extras.el b/contrib/lisp/org-bibtex-extras.el index edaf2c812..93c97a912 100644 --- a/contrib/lisp/org-bibtex-extras.el +++ b/contrib/lisp/org-bibtex-extras.el @@ -9,12 +9,12 @@ ;; This file is not yet part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. @@ -78,7 +78,7 @@ For example, to point to your `obe-bibtex-file' use the following. (find-file obe-bibtex-file) (goto-char (point-min)) (while (re-search-forward " :CUSTOM_ID: \\(.+\\)$" nil t) - (push (org-babel-clean-text-properties (match-string 1)) + (push (org-no-properties (match-string 1)) obe-citations)) obe-citations))) @@ -111,7 +111,7 @@ For example, to point to your `obe-bibtex-file' use the following. (when (obe-goto-citation citation) (let ((pt (point))) `((:authors . ,(split-string (org-entry-get pt "AUTHOR") " and " t)) - (:title . ,(org-babel-clean-text-properties (org-get-heading 1 1))) + (:title . ,(org-no-properties (org-get-heading 1 1))) (:journal . ,(org-entry-get pt "JOURNAL"))))))) (defun obe-meta-to-json (meta &optional fields) diff --git a/contrib/lisp/org-bookmark.el b/contrib/lisp/org-bookmark.el index 5c669b007..44588b6ad 100644 --- a/contrib/lisp/org-bookmark.el +++ b/contrib/lisp/org-bookmark.el @@ -12,7 +12,7 @@ ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. diff --git a/contrib/lisp/org-bullets.el b/contrib/lisp/org-bullets.el new file mode 100644 index 000000000..2951bf8ac --- /dev/null +++ b/contrib/lisp/org-bullets.el @@ -0,0 +1,122 @@ +;;; org-bullets.el --- Show bullets in org-mode as UTF-8 characters +;; Version: 0.2.2 +;; Author: sabof +;; URL: https://github.com/sabof/org-bullets + +;; This file is NOT part of GNU Emacs. +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 3, or (at +;; your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; The project is hosted at https://github.com/sabof/org-bullets +;; The latest version, and all the relevant information can be found there. + +;;; Code: + +(eval-when-compile (require 'cl)) + +(defgroup org-bullets nil + "Display bullets as UTF-8 characters." + :group 'org-appearance) + +;; A nice collection of unicode bullets: +;; http://nadeausoftware.com/articles/2007/11/latency_friendly_customized_bullets_using_unicode_characters +(defcustom org-bullets-bullet-list + '(;;; Large + "◉" + "○" + "✸" + "✿" + ;; ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ☢ ❀ ◆ ◖ ▶ + ;;; Small + ;; ► • ★ ▸ + ) + "This variable contains the list of bullets. +It can contain any number of one-character strings. +For levels beyond the size of the list, the stars will be +displayed using the first items again." + :group 'org-bullets + :type '(repeat (string :tag "Bullet character"))) + +(defcustom org-bullets-face-name nil + "Allows to override `org-mode' bullets face. +If set to a name of a face, that face will be used. +Otherwise the face of the heading level will be used." + :group 'org-bullets + :type 'symbol) + +(defvar org-bullets-bullet-map + '(keymap + (mouse-1 . org-cycle) + (mouse-2 . (lambda (e) + (interactive "e") + (mouse-set-point e) + (org-cycle)))) + "Mouse events for bullets. +If this is undesirable, one can remove them with + +\(setcdr org-bullets-bullet-map nil\)") + +(defun org-bullets-level-char (level) + "Return a character corresponding to LEVEL." + (string-to-char + (nth (mod (1- level) + (length org-bullets-bullet-list)) + org-bullets-bullet-list))) + +;;;###autoload +(define-minor-mode org-bullets-mode + "UTF-8 bullets for `org-mode'." + nil nil nil + (let* ((keyword + `((,org-outline-regexp-bol + (0 (let (( level (- (match-end 0) (match-beginning 0) 1))) + (compose-region (- (match-end 0) 2) + (- (match-end 0) 1) + (org-bullets-level-char level)) + (when (facep org-bullets-face-name) + (put-text-property (- (match-end 0) 2) + (- (match-end 0) 1) + 'face + org-bullets-face-name)) + (put-text-property (match-beginning 0) + (- (match-end 0) 2) + 'face (list :foreground + (face-attribute + 'default :background))) + (put-text-property (match-beginning 0) + (match-end 0) + 'keymap + org-bullets-bullet-map) + nil)))))) + (if org-bullets-mode + (progn (font-lock-add-keywords nil keyword) + (font-lock-fontify-buffer)) + (save-excursion + (goto-char (point-min)) + (font-lock-remove-keywords nil keyword) + (while (re-search-forward org-outline-regexp-bol nil t) + (decompose-region (match-beginning 0) (match-end 0))) + (font-lock-fontify-buffer))))) + +(provide 'org-bullets) + +;; Local Variables: +;; coding: utf-8-emacs +;; End: + +;;; org-bullets.el ends here diff --git a/contrib/lisp/org-checklist.el b/contrib/lisp/org-checklist.el index d1491d766..faa599833 100644 --- a/contrib/lisp/org-checklist.el +++ b/contrib/lisp/org-checklist.el @@ -6,6 +6,8 @@ ;; Version: 1.0 ;; Keywords: org, checklists ;; +;; This file is not part of GNU Emacs. +;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) @@ -17,8 +19,7 @@ ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/contrib/lisp/org-choose.el b/contrib/lisp/org-choose.el index aa219b88f..8e5935d11 100644 --- a/contrib/lisp/org-choose.el +++ b/contrib/lisp/org-choose.el @@ -1,7 +1,5 @@ -;;;_ org-choose.el --- decision management for org-mode +;;; org-choose.el --- decision management for org-mode -;;;_. Headers -;;;_ , License ;; Copyright (C) 2009-2013 Tom Breton (Tehom) ;; This file is not part of GNU Emacs. @@ -24,13 +22,13 @@ ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;;_ , Commentary: +;;; Commentary: -; This is code to support decision management. It lets you treat a -; group of sibling items in org-mode as alternatives in a decision. +;; This is code to support decision management. It lets you treat a +;; group of sibling items in org-mode as alternatives in a decision. -; There are no user commands in this file. You use it by: -; * Loading it (manually or by M-x customize-apropos org-modules) +;; There are no user commands in this file. You use it by: +;; * Loading it (manually or by M-x customize-apropos org-modules) ;; * Setting up at least one set of TODO keywords with the ;; interpretation "choose" by either: @@ -61,31 +59,30 @@ ;; * All the other TODO commands are available and behave essentially ;; the normal way. - -;;;_ , Requires +;;; Requires (require 'org) -;(eval-when-compile -; (require 'cl)) + ;(eval-when-compile + ; (require 'cl)) (require 'cl) -;;;_. Body -;;;_ , The variables +;;; Body +;;; The variables (defstruct (org-choose-mark-data. (:type list)) - "The format of an entry in org-choose-mark-data. + "The format of an entry in org-choose-mark-data. Indexes are 0-based or `nil'. " - keyword - bot-lower-range - top-upper-range - range-length - static-default - all-keywords) + keyword + bot-lower-range + top-upper-range + range-length + static-default + all-keywords) (defvar org-choose-mark-data - () - "Alist of information for choose marks. + () + "Alist of information for choose marks. Each entry is an `org-choose-mark-data.'" ) (make-variable-buffer-local 'org-choose-mark-data) @@ -93,426 +90,394 @@ Each entry is an `org-choose-mark-data.'" ) ;;;_ . org-choose-filter-one (defun org-choose-filter-one (i) - "Return a list of + "Return a list of * a canonized version of the string * optionally one symbol" - (if + (if (not - (string-match "(.*)" i)) + (string-match "(.*)" i)) (list i i) - (let* - ( - (end-text (match-beginning 0)) - (vanilla-text (substring i 0 end-text)) - ;;Get the parenthesized part. - (match (match-string 0 i)) - ;;Remove the parentheses. - (args (substring match 1 -1)) - ;;Split it - (arglist - (let - ((arglist-x (org-split-string args ","))) - ;;When string starts with "," `split-string' doesn't - ;;make a first arg, so in that case make one - ;;manually. - (if - (string-match "^," args) - (cons nil arglist-x) - arglist-x))) - (decision-arg (second arglist)) - (type - (cond - ((string= decision-arg "0") - 'default-mark) - ((string= decision-arg "+") - 'top-upper-range) - ((string= decision-arg "-") - 'bot-lower-range) - (t nil))) - (vanilla-arg (first arglist)) - (vanilla-mark - (if vanilla-arg - (concat vanilla-text "("vanilla-arg")") - vanilla-text))) - (if type - (list vanilla-text vanilla-mark type) - (list vanilla-text vanilla-mark))))) + (let* + ( + (end-text (match-beginning 0)) + (vanilla-text (substring i 0 end-text)) + ;;Get the parenthesized part. + (match (match-string 0 i)) + ;;Remove the parentheses. + (args (substring match 1 -1)) + ;;Split it + (arglist + (let + ((arglist-x (org-split-string args ","))) + ;;When string starts with "," `split-string' doesn't + ;;make a first arg, so in that case make one + ;;manually. + (if + (string-match "^," args) + (cons nil arglist-x) + arglist-x))) + (decision-arg (second arglist)) + (type + (cond + ((string= decision-arg "0") + 'default-mark) + ((string= decision-arg "+") + 'top-upper-range) + ((string= decision-arg "-") + 'bot-lower-range) + (t nil))) + (vanilla-arg (first arglist)) + (vanilla-mark + (if vanilla-arg + (concat vanilla-text "("vanilla-arg")") + vanilla-text))) + (if type + (list vanilla-text vanilla-mark type) + (list vanilla-text vanilla-mark))))) ;;;_ . org-choose-setup-vars (defun org-choose-setup-vars (bot-lower-range top-upper-range - static-default num-items all-mark-texts) - "Add to org-choose-mark-data according to arguments" + static-default num-items all-mark-texts) + "Add to org-choose-mark-data according to arguments" + (let* + ((tail + ;;If there's no bot-lower-range or no default, we don't + ;;have ranges. + (cdr + (if (and static-default bot-lower-range) + (let* + ;;If there's no top-upper-range, use the last + ;;item. + ((top-upper-range + (or top-upper-range (1- num-items))) + (lower-range-length + (1+ (- static-default bot-lower-range))) + (upper-range-length + (- top-upper-range static-default)) + (range-length + (min upper-range-length lower-range-length))) + (make-org-choose-mark-data. + :keyword nil + :bot-lower-range bot-lower-range + :top-upper-range top-upper-range + :range-length range-length + :static-default static-default + :all-keywords all-mark-texts)) + (make-org-choose-mark-data. + :keyword nil + :bot-lower-range nil + :top-upper-range nil + :range-length nil + :static-default (or static-default 0) + :all-keywords all-mark-texts))))) + (dolist (text all-mark-texts) + (pushnew (cons text tail) + org-choose-mark-data + :test + #'(lambda (a b) + (equal (car a) (car b))))))) - (let* - ( - (tail - ;;If there's no bot-lower-range or no default, we don't - ;;have ranges. - (cdr - (if (and static-default bot-lower-range) - (let* - ( - ;;If there's no top-upper-range, use the last - ;;item. - (top-upper-range - (or top-upper-range (1- num-items))) - (lower-range-length - (1+ (- static-default bot-lower-range))) - (upper-range-length - (- top-upper-range static-default)) - (range-length - (min upper-range-length lower-range-length))) - - - (make-org-choose-mark-data. - :keyword nil - :bot-lower-range bot-lower-range - :top-upper-range top-upper-range - :range-length range-length - :static-default static-default - :all-keywords all-mark-texts)) - - (make-org-choose-mark-data. - :keyword nil - :bot-lower-range nil - :top-upper-range nil - :range-length nil - :static-default (or static-default 0) - :all-keywords all-mark-texts))))) - - (dolist (text all-mark-texts) - (pushnew (cons text tail) - org-choose-mark-data - :test - #'(lambda (a b) - (equal (car a) (car b))))))) - - - - -;;;_ . org-choose-filter-tail +;;; org-choose-filter-tail (defun org-choose-filter-tail (raw) - "Return a translation of RAW to vanilla and set appropriate + "Return a translation of RAW to vanilla and set appropriate buffer-local variables. RAW is a list of strings representing the input text of a choose interpretation." - (let + (let ((vanilla-list nil) - (all-mark-texts nil) - (index 0) - bot-lower-range top-upper-range range-length static-default) - (dolist (i raw) - (destructuring-bind - (vanilla-text vanilla-mark &optional type) - (org-choose-filter-one i) - (cond - ((eq type 'bot-lower-range) - (setq bot-lower-range index)) - ((eq type 'top-upper-range) - (setq top-upper-range index)) - ((eq type 'default-mark) - (setq static-default index))) - (incf index) - (push vanilla-text all-mark-texts) - (push vanilla-mark vanilla-list))) + (all-mark-texts nil) + (index 0) + bot-lower-range top-upper-range range-length static-default) + (dolist (i raw) + (destructuring-bind + (vanilla-text vanilla-mark &optional type) + (org-choose-filter-one i) + (cond + ((eq type 'bot-lower-range) + (setq bot-lower-range index)) + ((eq type 'top-upper-range) + (setq top-upper-range index)) + ((eq type 'default-mark) + (setq static-default index))) + (incf index) + (push vanilla-text all-mark-texts) + (push vanilla-mark vanilla-list))) - (org-choose-setup-vars bot-lower-range top-upper-range - static-default index (reverse all-mark-texts)) - (nreverse vanilla-list))) + (org-choose-setup-vars bot-lower-range top-upper-range + static-default index (reverse all-mark-texts)) + (nreverse vanilla-list))) -;;;_ . org-choose-setup-filter +;;; org-choose-setup-filter (defun org-choose-setup-filter (raw) - "A setup filter for choose interpretations." - (when (eq (car raw) 'choose) - (cons - 'choose - (org-choose-filter-tail (cdr raw))))) + "A setup filter for choose interpretations." + (when (eq (car raw) 'choose) + (cons + 'choose + (org-choose-filter-tail (cdr raw))))) -;;;_ . org-choose-conform-after-promotion +;;; org-choose-conform-after-promotion (defun org-choose-conform-after-promotion (entry-pos keywords highest-ok-ix) "Conform the current item after another item was promoted" - - (unless + (unless ;;Skip the entry that triggered this by skipping any entry with ;;the same starting position. plist uses the start of the ;;header line as the position, but map no longer does, so we ;;have to go back to the heading. (= - (save-excursion - (org-back-to-heading) - (point)) - entry-pos) - (let - ((ix - (org-choose-get-entry-index keywords))) - ;;If the index of the entry exceeds the highest allowable - ;;index, change it to that. - (when (and ix - (> ix highest-ok-ix)) - (org-todo - (nth highest-ok-ix keywords)))))) + (save-excursion + (org-back-to-heading) + (point)) + entry-pos) + (let + ((ix + (org-choose-get-entry-index keywords))) + ;;If the index of the entry exceeds the highest allowable + ;;index, change it to that. + (when (and ix + (> ix highest-ok-ix)) + (org-todo + (nth highest-ok-ix keywords)))))) ;;;_ . org-choose-conform-after-demotion (defun org-choose-conform-after-demotion (entry-pos keywords - raise-to-ix - old-highest-ok-ix) + raise-to-ix + old-highest-ok-ix) "Conform the current item after another item was demoted." - - (unless + (unless ;;Skip the entry that triggered this. (= - (save-excursion - (org-back-to-heading) - (point)) - entry-pos) - (let - ((ix - (org-choose-get-entry-index keywords))) - ;;If the index of the entry was at or above the old allowable - ;;position, change it to the new mirror position if there is - ;;one. - (when (and - ix - raise-to-ix - (>= ix old-highest-ok-ix)) - (org-todo - (nth raise-to-ix keywords)))))) + (save-excursion + (org-back-to-heading) + (point)) + entry-pos) + (let + ((ix + (org-choose-get-entry-index keywords))) + ;;If the index of the entry was at or above the old allowable + ;;position, change it to the new mirror position if there is + ;;one. + (when (and + ix + raise-to-ix + (>= ix old-highest-ok-ix)) + (org-todo + (nth raise-to-ix keywords)))))) -;;;_ , org-choose-keep-sensible (the org-trigger-hook function) +;;; org-choose-keep-sensible (the org-trigger-hook function) (defun org-choose-keep-sensible (change-plist) "Bring the other items back into a sensible state after an item's setting was changed." - (let* + (let* ( (from (plist-get change-plist :from)) (to (plist-get change-plist :to)) (entry-pos - (set-marker - (make-marker) - (plist-get change-plist :position))) + (set-marker + (make-marker) + (plist-get change-plist :position))) (kwd-data - (assoc to org-todo-kwd-alist))) - (when - (eq (nth 1 kwd-data) 'choose) - (let* - ( - (data - (assoc to org-choose-mark-data)) - (keywords - (org-choose-mark-data.-all-keywords data)) - (old-index - (org-choose-get-index-in-keywords - from - keywords)) - (new-index - (org-choose-get-index-in-keywords - to - keywords)) - (highest-ok-ix - (org-choose-highest-other-ok - new-index - data)) - (funcdata - (cond - ;;The entry doesn't participate in conformance, - ;;so give `nil' which does nothing. - ((not highest-ok-ix) nil) - ;;The entry was created or promoted - ((or - (not old-index) - (> new-index old-index)) - (list - #'org-choose-conform-after-promotion - entry-pos keywords - highest-ok-ix)) - (t ;;Otherwise the entry was demoted. - (let - ( - (raise-to-ix - (min - highest-ok-ix - (org-choose-mark-data.-static-default - data))) - (old-highest-ok-ix - (org-choose-highest-other-ok - old-index - data))) - - (list - #'org-choose-conform-after-demotion - entry-pos - keywords - raise-to-ix - old-highest-ok-ix)))))) - - (if funcdata - ;;The funny-looking names are to make variable capture - ;;unlikely. (Poor-man's lexical bindings). - (destructuring-bind (func-d473 . args-46k) funcdata - (let - ((map-over-entries - (org-choose-get-fn-map-group)) - ;;We may call `org-todo', so let various hooks - ;;`nil' so we don't cause loops. - org-after-todo-state-change-hook - org-trigger-hook - org-blocker-hook - org-todo-get-default-hook - ;;Also let this alist `nil' so we don't log - ;;secondary transitions. - org-todo-log-states) - ;;Map over group - (funcall map-over-entries - #'(lambda () + (assoc to org-todo-kwd-alist))) + (when + (eq (nth 1 kwd-data) 'choose) + (let* + ( + (data + (assoc to org-choose-mark-data)) + (keywords + (org-choose-mark-data.-all-keywords data)) + (old-index + (org-choose-get-index-in-keywords + from + keywords)) + (new-index + (org-choose-get-index-in-keywords + to + keywords)) + (highest-ok-ix + (org-choose-highest-other-ok + new-index + data)) + (funcdata + (cond + ;;The entry doesn't participate in conformance, + ;;so give `nil' which does nothing. + ((not highest-ok-ix) nil) + ;;The entry was created or promoted + ((or + (not old-index) + (> new-index old-index)) + (list + #'org-choose-conform-after-promotion + entry-pos keywords + highest-ok-ix)) + (t ;;Otherwise the entry was demoted. + (let + ( + (raise-to-ix + (min + highest-ok-ix + (org-choose-mark-data.-static-default + data))) + (old-highest-ok-ix + (org-choose-highest-other-ok + old-index + data))) + (list + #'org-choose-conform-after-demotion + entry-pos + keywords + raise-to-ix + old-highest-ok-ix)))))) + (if funcdata + ;;The funny-looking names are to make variable capture + ;;unlikely. (Poor-man's lexical bindings). + (destructuring-bind (func-d473 . args-46k) funcdata + (let + ((map-over-entries + (org-choose-get-fn-map-group)) + ;;We may call `org-todo', so let various hooks + ;;`nil' so we don't cause loops. + org-after-todo-state-change-hook + org-trigger-hook + org-blocker-hook + org-todo-get-default-hook + ;;Also let this alist `nil' so we don't log + ;;secondary transitions. + org-todo-log-states) + ;;Map over group + (funcall map-over-entries + #'(lambda () (apply func-d473 args-46k)))))))) + ;;Remove the marker + (set-marker entry-pos nil))) - ;;Remove the marker - (set-marker entry-pos nil))) - - - -;;;_ , Getting the default mark -;;;_ . org-choose-get-index-in-keywords +;;; Getting the default mark +;;; org-choose-get-index-in-keywords (defun org-choose-get-index-in-keywords (ix all-keywords) "Return the index of the current entry." - - (if ix + (if ix (position ix all-keywords - :test #'equal))) + :test #'equal))) -;;;_ . org-choose-get-entry-index +;;; org-choose-get-entry-index (defun org-choose-get-entry-index (all-keywords) - "Return index of current entry." - - (let* + "Return index of current entry." + (let* ((state (org-entry-get (point) "TODO"))) - (org-choose-get-index-in-keywords state all-keywords))) + (org-choose-get-index-in-keywords state all-keywords))) -;;;_ . org-choose-get-fn-map-group +;;; org-choose-get-fn-map-group (defun org-choose-get-fn-map-group () - "Return a function to map over the group" + "Return a function to map over the group" + #'(lambda (fn) + (require 'org-agenda) ;; `org-map-entries' seems to need it. + (save-excursion + (unless (org-up-heading-safe) + (error "Choosing is only supported between siblings in a tree, not on top level")) + (let + ((level (org-reduced-level (org-outline-level)))) + (save-restriction + (org-map-entries + fn + (format "LEVEL=%d" level) + 'tree)))))) - #'(lambda (fn) - (require 'org-agenda) ;; `org-map-entries' seems to need it. - (save-excursion - (unless (org-up-heading-safe) - (error "Choosing is only supported between siblings in a tree, not on top level")) - (let - ((level (org-reduced-level (org-outline-level)))) - (save-restriction - (org-map-entries - fn - (format "LEVEL=%d" level) - 'tree)))))) - -;;;_ . org-choose-get-highest-mark-index +;;; org-choose-get-highest-mark-index (defun org-choose-get-highest-mark-index (keywords) - "Get the index of the highest current mark in the group. + "Get the index of the highest current mark in the group. If there is none, return 0" + (let* + ;;Func maps over applicable entries. + ((map-over-entries + (org-choose-get-fn-map-group)) + (indexes-list + (remove nil + (funcall map-over-entries + #'(lambda () + (org-choose-get-entry-index keywords)))))) + (if + indexes-list + (apply #'max indexes-list) + 0))) - (let* - ( - ;;Func maps over applicable entries. - (map-over-entries - (org-choose-get-fn-map-group)) - - (indexes-list - (remove nil - (funcall map-over-entries - #'(lambda () - (org-choose-get-entry-index keywords)))))) - (if - indexes-list - (apply #'max indexes-list) - 0))) - - -;;;_ . org-choose-highest-ok +;;; org-choose-highest-ok (defun org-choose-highest-other-ok (ix data) "Return the highest index that any choose mark can sensibly have, given that another mark has index IX. DATA must be a `org-choose-mark-data.'." + (let + ((bot-lower-range + (org-choose-mark-data.-bot-lower-range data)) + (top-upper-range + (org-choose-mark-data.-top-upper-range data)) + (range-length + (org-choose-mark-data.-range-length data))) + (when (and ix bot-lower-range) + (let* + ((delta + (- top-upper-range ix))) + (unless + (< range-length delta) + (+ bot-lower-range delta)))))) - (let - ( - (bot-lower-range - (org-choose-mark-data.-bot-lower-range data)) - (top-upper-range - (org-choose-mark-data.-top-upper-range data)) - (range-length - (org-choose-mark-data.-range-length data))) - (when (and ix bot-lower-range) - (let* - ((delta - (- top-upper-range ix))) - (unless - (< range-length delta) - (+ bot-lower-range delta)))))) - -;;;_ . org-choose-get-default-mark-index +;;; org-choose-get-default-mark-index (defun org-choose-get-default-mark-index (data) "Return the index of the default mark in a choose interpretation. DATA must be a `org-choose-mark-data.'." + (or + (let + ((highest-mark-index + (org-choose-get-highest-mark-index + (org-choose-mark-data.-all-keywords data)))) + (org-choose-highest-other-ok + highest-mark-index data)) + (org-choose-mark-data.-static-default data))) - - (or - (let - ((highest-mark-index - (org-choose-get-highest-mark-index - (org-choose-mark-data.-all-keywords data)))) - (org-choose-highest-other-ok - highest-mark-index data)) - (org-choose-mark-data.-static-default data))) - - - -;;;_ . org-choose-get-mark-N +;;; org-choose-get-mark-N (defun org-choose-get-mark-N (n data) - "Get the text of the nth mark in a choose interpretation." + "Get the text of the nth mark in a choose interpretation." - (let* + (let* ((l (org-choose-mark-data.-all-keywords data))) - (nth n l))) + (nth n l))) -;;;_ . org-choose-get-default-mark +;;; org-choose-get-default-mark (defun org-choose-get-default-mark (new-mark old-mark) - "Get the default mark IFF in a choose interpretation. + "Get the default mark IFF in a choose interpretation. NEW-MARK and OLD-MARK are the text of the new and old marks." + (let* + ((old-kwd-data + (assoc old-mark org-todo-kwd-alist)) + (new-kwd-data + (assoc new-mark org-todo-kwd-alist)) + (becomes-choose + (and + (or + (not old-kwd-data) + (not + (eq (nth 1 old-kwd-data) 'choose))) + (eq (nth 1 new-kwd-data) 'choose)))) + (when + becomes-choose + (let + ((new-mark-data + (assoc new-mark org-choose-mark-data))) + (if + new-mark + (org-choose-get-mark-N + (org-choose-get-default-mark-index + new-mark-data) + new-mark-data) + (error "Somehow got an unrecognizable mark")))))) - (let* - ( - (old-kwd-data - (assoc old-mark org-todo-kwd-alist)) - (new-kwd-data - (assoc new-mark org-todo-kwd-alist)) - (becomes-choose - (and - (or - (not old-kwd-data) - (not - (eq (nth 1 old-kwd-data) 'choose))) - (eq (nth 1 new-kwd-data) 'choose)))) - (when - becomes-choose - (let - ((new-mark-data - (assoc new-mark org-choose-mark-data))) - (if - new-mark - (org-choose-get-mark-N - (org-choose-get-default-mark-index - new-mark-data) - new-mark-data) - (error "Somehow got an unrecognizable mark")))))) - -;;;_ , Setting it all up +;;; Setting it all up (eval-after-load "org" '(progn @@ -524,19 +489,8 @@ NEW-MARK and OLD-MARK are the text of the new and old marks." #'org-choose-keep-sensible) (add-to-list 'org-todo-interpretation-widgets '(:tag "Choose (to record decisions)" choose) - 'append) - )) - - -;;;_. Footers -;;;_ , Provides + 'append))) (provide 'org-choose) -;;;_ * Local emacs vars. -;;;_ + Local variables: -;;;_ + End: - -;;;_ , End - ;;; org-choose.el ends here diff --git a/contrib/lisp/org-collector.el b/contrib/lisp/org-collector.el index 46a52a2d1..60b906982 100644 --- a/contrib/lisp/org-collector.el +++ b/contrib/lisp/org-collector.el @@ -10,12 +10,12 @@ ;; This file is not yet part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. diff --git a/lisp/org-colview-xemacs.el b/contrib/lisp/org-colview-xemacs.el similarity index 99% rename from lisp/org-colview-xemacs.el rename to contrib/lisp/org-colview-xemacs.el index 80e81b38a..63c02384b 100644 --- a/lisp/org-colview-xemacs.el +++ b/contrib/lisp/org-colview-xemacs.el @@ -9,18 +9,19 @@ ;; ;; This file is part of Org mode, it is not part of GNU Emacs. ;; -;; You can redistribute it and/or modify it under the terms of the -;; GNU General Public License as published by the Free Software -;; Foundation; either version 3, or (at your option) any later -;; version. +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. -;; This file is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this file; see the file COPYING. +;; along with this program. If not, see . +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: @@ -1553,7 +1554,7 @@ and tailing newline characters." ;; OK, the property is not defined. Use appointment duration? (when (and org-agenda-columns-add-appointments-to-effort-sum (setq d (get-text-property (point) 'duration))) - (setq d (org-minutes-to-hh:mm-string d)) + (setq d (org-minutes-to-clocksum-string d)) (put-text-property 0 (length d) 'face 'org-warning d) (push (cons org-effort-property d) p))) (push (cons (org-current-line) p) cache)) diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el index 73cdf9ba1..a3c4aed6f 100644 --- a/contrib/lisp/org-contacts.el +++ b/contrib/lisp/org-contacts.el @@ -7,12 +7,12 @@ ;; ;; This file is NOT part of GNU Emacs. ;; -;; GNU Emacs is free software: you can redistribute it and/or modify +;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. @@ -39,18 +39,20 @@ (eval-when-compile (require 'cl)) -(eval-and-compile - (require 'org)) +(require 'org) (require 'gnus-util) +(require 'gnus-art) +(require 'mail-utils) (require 'org-agenda) +(require 'org-capture) (defgroup org-contacts nil - "Options concerning contacts management." + "Options about contacts management." :group 'org) (defcustom org-contacts-files nil "List of Org files to use as contacts source. -If set to nil, all your Org files will be used." +When set to nil, all your Org files will be used." :type '(repeat file) :group 'org-contacts) @@ -59,6 +61,11 @@ If set to nil, all your Org files will be used." :type 'string :group 'org-contacts) +(defcustom org-contacts-tel-property "PHONE" + "Name of the property for contact phone number." + :type 'string + :group 'org-contacts) + (defcustom org-contacts-address-property "ADDRESS" "Name of the property for contact address." :type 'string @@ -69,8 +76,20 @@ If set to nil, all your Org files will be used." :type 'string :group 'org-contacts) +(defcustom org-contacts-note-property "NOTE" + "Name of the property for contact note." + :type 'string + :group 'org-contacts) + +(defcustom org-contacts-alias-property "ALIAS" + "Name of the property for contact name alias." + :type 'string + :group 'org-contacts) + + (defcustom org-contacts-birthday-format "Birthday: %l (%Y)" - "Format of the anniversary agenda entry. The following replacements are available: + "Format of the anniversary agenda entry. +The following replacements are available: %h - Heading name %l - Link to the heading @@ -114,7 +133,13 @@ If set to nil, all your Org files will be used." :type 'string :group 'org-contacts) -(defcustom org-contacts-matcher (concat org-contacts-email-property "<>\"\"") +(defcustom org-contacts-matcher + (mapconcat 'identity (list org-contacts-email-property + org-contacts-alias-property + org-contacts-tel-property + org-contacts-address-property + org-contacts-birthday-property) + "<>\"\"|") "Matching rule for finding heading that are contacts. This can be a tag name, or a property check." :type 'string @@ -131,6 +156,24 @@ This overrides `org-email-link-description-format' if set." :group 'org-contacts :type 'file) +(defcustom org-contacts-enable-completion t + "Enable or not the completion in `message-mode' with `org-contacts'." + :group 'org-contacts + :type 'boolean) + +;; Decalre external functions and variables +(declare-function org-reverse-string "org") +(declare-function diary-ordinal-suffix "ext:diary-lib") +(declare-function wl-summary-message-number "ext:wl-summary") +(declare-function wl-address-header-extract-address "ext:wl-address") +(declare-function wl-address-header-extract-realname "ext:wl-address") +(declare-function erc-buffer-list "ext:erc") +(declare-function erc-get-channel-user-list "ext:erc") +(declare-function google-maps-static-show "ext:google-maps-static") +(declare-function elmo-message-field "ext:elmo-pipe") +(declare-function std11-narrow-to-header "ext:std11") +(declare-function std11-fetch-field "ext:std11") + (defvar org-contacts-keymap (let ((map (make-sparse-keymap))) (define-key map "M" 'org-contacts-view-send-email) @@ -138,38 +181,66 @@ This overrides `org-email-link-description-format' if set." map) "The keymap used in `org-contacts' result list.") +(defvar org-contacts-db nil + "Org Contacts database.") + +(defvar org-contacts-last-update nil + "Last time the Org Contacts database has been updated.") + (defun org-contacts-files () "Return list of Org files to use for contact management." (or org-contacts-files (org-agenda-files t 'ifmode))) +(defun org-contacts-db-need-update-p () + "Determine whether `org-contacts-db' needs to be refreshed." + (or (null org-contacts-last-update) + (org-find-if (lambda (file) + (or (time-less-p org-contacts-last-update + (elt (file-attributes file) 5)))) + (org-contacts-files)))) + +(defun org-contacts-db () + "Return the latest Org Contacts Database." + (let* (todo-only + (contacts-matcher + (cdr (org-make-tags-matcher org-contacts-matcher))) + markers result) + (when (org-contacts-db-need-update-p) + (message "Update Org Contacts Database") + (dolist (file (org-contacts-files)) + (org-check-agenda-file file) + (with-current-buffer (org-get-agenda-file-buffer file) + (unless (eq major-mode 'org-mode) + (error "File %s is no in `org-mode'" file)) + (org-scan-tags + '(add-to-list 'markers (set-marker (make-marker) (point))) + contacts-matcher + todo-only))) + (dolist (marker markers result) + (org-with-point-at marker + (add-to-list 'result + (list (org-get-heading t) marker (org-entry-properties marker 'all))))) + (setf org-contacts-db result + org-contacts-last-update (current-time))) + org-contacts-db)) + (defun org-contacts-filter (&optional name-match tags-match) "Search for a contact maching NAME-MATCH and TAGS-MATCH. If both match values are nil, return all contacts." - (let* (todo-only - (tags-matcher - (if tags-match - (cdr (org-make-tags-matcher tags-match)) - t)) - (name-matcher - (if name-match - '(org-string-match-p name-match (org-get-heading t)) - t)) - (contacts-matcher - (cdr (org-make-tags-matcher org-contacts-matcher))) - markers result) - (dolist (file (org-contacts-files)) - (org-check-agenda-file file) - (with-current-buffer (org-get-agenda-file-buffer file) - (unless (eq major-mode 'org-mode) - (error "File %s is no in `org-mode'" file)) - (org-scan-tags - '(add-to-list 'markers (set-marker (make-marker) (point))) - `(and ,contacts-matcher ,tags-matcher ,name-matcher) - todo-only))) - (dolist (marker markers result) - (org-with-point-at marker - (add-to-list 'result - (list (org-get-heading t) marker (org-entry-properties marker 'all))))))) + (if (and (null name-match) + (null tags-match)) + (org-contacts-db) + (loop for contact in (org-contacts-db) + if (or + (and name-match + (org-string-match-p name-match + (first contact))) + (and tags-match + (org-find-if (lambda (tag) + (org-string-match-p tags-match tag)) + (org-split-string + (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":")))) + collect contact))) (when (not (fboundp 'completion-table-case-fold)) ;; That function is new in Emacs 24... @@ -178,67 +249,256 @@ If both match values are nil, return all contacts." (let ((completion-ignore-case (not dont-fold))) (complete-with-action action table string pred))))) -(defun org-contacts-complete-name (&optional start) - "Complete text at START with a user name and email." - (let* ((end (point)) - (start (or start - (save-excursion - (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") - (goto-char (match-end 0)) - (point)))) - (orig (buffer-substring start end)) - (completion-ignore-case org-contacts-completion-ignore-case) - (group-completion-p (org-string-match-p (concat "^" org-contacts-group-prefix) orig)) - (completion-list - (if group-completion-p - (mapcar (lambda (group) (propertize (concat org-contacts-group-prefix group) 'org-contacts-group group)) - (org-uniquify - (loop for contact in (org-contacts-filter) - with group-list - nconc (org-split-string - (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":")))) - (loop for contact in (org-contacts-filter) - ;; The contact name is always the car of the assoc-list - ;; returned by `org-contacts-filter'. - for contact-name = (car contact) - ;; Build the list of the user email addresses. - for email-list = (split-string (or - (cdr (assoc-string org-contacts-email-property (caddr contact))) - "")) - ;; If the user has email addresses… - if email-list - ;; … append a list of USER . - nconc (loop for email in email-list - collect (org-contacts-format-email contact-name email))))) - (completion-list (all-completions orig completion-list))) - ;; If we are completing a group, and that's the only group, just return - ;; the real result. - (when (and group-completion-p - (= (length completion-list) 1)) - (setq completion-list - (list (concat (car completion-list) ";: " - (mapconcat 'identity - (loop for contact in (org-contacts-filter - nil - (get-text-property 0 'org-contacts-group (car completion-list))) - ;; The contact name is always the car of the assoc-list - ;; returned by `org-contacts-filter'. - for contact-name = (car contact) - ;; Grab the first email of the contact - for email = (car (split-string (or - (cdr (assoc-string org-contacts-email-property (caddr contact))) - ""))) - ;; If the user has an email address, append USER . - if email collect (org-contacts-format-email contact-name email)) - ", "))))) - (list start end (completion-table-case-fold completion-list (not org-contacts-completion-ignore-case))))) +(defun org-contacts-try-completion-prefix (to-match collection &optional predicate) + "Custom implementation of `try-completion'. +This version works only with list and alist and it looks at all +prefixes rather than just the beginning of the string." + (loop with regexp = (concat "\\b" (regexp-quote to-match)) + with ret = nil + with ret-start = nil + with ret-end = nil -(defun org-contacts-message-complete-function () + for el in collection + for string = (if (listp el) (car el) el) + + for start = (when (or (null predicate) (funcall predicate string)) + (string-match regexp string)) + + if start + do (let ((end (match-end 0)) + (len (length string))) + (if (= end len) + (return t) + (destructuring-bind (string start end) + (if (null ret) + (values string start end) + (org-contacts-common-substring + ret ret-start ret-end + string start end)) + (setf ret string + ret-start start + ret-end end)))) + + finally (return + (replace-regexp-in-string "\\`[ \t\n]*" "" ret)))) + +(defun org-contacts-compare-strings (s1 start1 end1 s2 start2 end2 &optional ignore-case) + "Compare the contents of two strings, using `compare-strings'. + +This function works like `compare-strings' excepted that it +returns a cons. +- The CAR is the number of characters that match at the beginning. +- The CDR is T is the two strings are the same and NIL otherwise." + (let ((ret (compare-strings s1 start1 end1 s2 start2 end2 ignore-case))) + (if (eq ret t) + (cons (or end1 (length s1)) t) + (cons (1- (abs ret)) nil)))) + +(defun org-contacts-common-substring (s1 start1 end1 s2 start2 end2) + "Extract the common substring between S1 and S2. + +This function extracts the common substring between S1 and S2 and +adjust the part that remains common. + +START1 and END1 delimit the part in S1 that we know is common +between the two strings. This applies to START2 and END2 for S2. + +This function returns a list whose contains: +- The common substring found. +- The new value of the start of the known inner substring. +- The new value of the end of the known inner substring." + ;; Given two strings: + ;; s1: "foo bar baz" + ;; s2: "fooo bar baz" + ;; and the inner substring is "bar" + ;; then: start1 = 4, end1 = 6, start2 = 5, end2 = 7 + ;; + ;; To find the common substring we will compare two substrings: + ;; " oof" and " ooof" to find the beginning of the common substring. + ;; " baz" and " baz" to find the end of the common substring. + (let* ((len1 (length s1)) + (start1 (or start1 0)) + (end1 (or end1 len1)) + + (len2 (length s2)) + (start2 (or start2 0)) + (end2 (or end2 len2)) + + (new-start (car (org-contacts-compare-strings + (substring (org-reverse-string s1) (- len1 start1)) nil nil + (substring (org-reverse-string s2) (- len2 start2)) nil nil))) + + (new-end (+ end1 (car (org-contacts-compare-strings + (substring s1 end1) nil nil + (substring s2 end2) nil nil))))) + (list (substring s1 (- start1 new-start) new-end) + new-start + (+ new-start (- end1 start1))))) + +(defun org-contacts-all-completions-prefix (to-match collection &optional predicate) + "Custom version of `all-completions'. +This version works only with list and alist and it looks at all +prefixes rather than just the beginning of the string." + (loop with regexp = (concat "\\b" (regexp-quote to-match)) + for el in collection + for string = (if (listp el) (car el) el) + for match? = (when (and (or (null predicate) (funcall predicate string))) + (string-match regexp string)) + if match? + collect (progn + (let ((end (match-end 0))) + (org-no-properties string) + (when (< end (length string)) + ;; Here we add a text property that will be used + ;; later to highlight the character right after + ;; the common part between each addresses. + ;; See `org-contacts-display-sort-function'. + (put-text-property end (1+ end) 'org-contacts-prefix 't string))) + string))) + +(defun org-contacts-make-collection-prefix (collection) + "Make a collection function from COLLECTION which will match on prefixes." + (lexical-let ((collection collection)) + (lambda (string predicate flag) + (cond ((eq flag nil) + (org-contacts-try-completion-prefix string collection predicate)) + ((eq flag t) + ;; `org-contacts-all-completions-prefix' has already been + ;; used to compute `all-completions'. + collection) + ((eq flag 'lambda) + (org-contacts-test-completion-prefix string collection predicate)) + ((and (listp flag) (eq (car flag) 'boundaries)) + (destructuring-bind (to-ignore &rest suffix) + flag + (org-contacts-boundaries-prefix string collection predicate suffix))) + ((eq flag 'metadata) + (org-contacts-metadata-prefix string collection predicate)) + (t nil ; operation unsupported + ))))) + +(defun org-contacts-display-sort-function (completions) + "Sort function for contacts display." + (mapcar (lambda (string) + (loop with len = (1- (length string)) + for i upfrom 0 to len + if (memq 'org-contacts-prefix + (text-properties-at i string)) + do (set-text-properties + i (1+ i) + (list 'font-lock-face + (if (char-equal (aref string i) + (string-to-char " ")) + ;; Spaces can't be bold. + 'underline + 'bold)) string) + else + do (set-text-properties i (1+ i) nil string) + finally (return string))) + completions)) + +(defun org-contacts-test-completion-prefix (string collection predicate) + ;; Prevents `org-find-if' from redefining `predicate' and going into + ;; an infinite loop. + (lexical-let ((predicate predicate)) + (org-find-if (lambda (el) + (and (or (null predicate) (funcall predicate el)) + (string= string el))) + collection))) + +(defun org-contacts-boundaries-prefix (string collection predicate suffix) + (list* 'boundaries (completion-boundaries string collection predicate suffix))) + +(defun org-contacts-metadata-prefix (string collection predicate) + '(metadata . + ((display-sort-function . org-contacts-display-sort-function)))) + +(defun org-contacts-complete-group (start end string) + "Complete text at START from a group. + +A group FOO is composed of contacts with the tag FOO." + (let* ((completion-ignore-case org-contacts-completion-ignore-case) + (group-completion-p (org-string-match-p + (concat "^" org-contacts-group-prefix) string))) + (when group-completion-p + (let ((completion-list + (all-completions + string + (mapcar (lambda (group) + (propertize (concat org-contacts-group-prefix group) + 'org-contacts-group group)) + (org-uniquify + (loop for contact in (org-contacts-filter) + nconc (org-split-string + (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))))) + (list start end + (if (= (length completion-list) 1) + ;; We've foudn the correct group, returns the address + (lexical-let ((tag (get-text-property 0 'org-contacts-group + (car completion-list)))) + (lambda (string pred &optional to-ignore) + (mapconcat 'identity + (loop for contact in (org-contacts-filter + nil + tag) + ;; The contact name is always the car of the assoc-list + ;; returned by `org-contacts-filter'. + for contact-name = (car contact) + ;; Grab the first email of the contact + for email = (car (split-string + (or + (cdr (assoc-string org-contacts-email-property + (caddr contact))) + ""))) + ;; If the user has an email address, append USER . + if email collect (org-contacts-format-email contact-name email)) + ", "))) + ;; We haven't found the correct group + (completion-table-case-fold completion-list + (not org-contacts-completion-ignore-case)))))))) + +(defun org-contacts-complete-name (start end string) + "Complete text at START with a user name and email." + (let* ((completion-ignore-case org-contacts-completion-ignore-case) + (completion-list + (loop for contact in (org-contacts-filter) + ;; The contact name is always the car of the assoc-list + ;; returned by `org-contacts-filter'. + for contact-name = (car contact) + ;; Build the list of the user email addresses. + for email-list = (split-string (or + (cdr (assoc-string org-contacts-email-property + (caddr contact))) "")) + ;; If the user has email addresses… + if email-list + ;; … append a list of USER . + nconc (loop for email in email-list + collect (org-contacts-format-email contact-name email)))) + (completion-list (org-contacts-all-completions-prefix + string + (org-uniquify completion-list)))) + (when completion-list + (list start end + (org-contacts-make-collection-prefix completion-list))))) + +(defun org-contacts-message-complete-function (&optional start) "Function used in `completion-at-point-functions' in `message-mode'." + ;; Avoid to complete in `post-command-hook'. + (when completion-in-region-mode + (remove-hook 'post-command-hook #'completion-in-region--postch)) (let ((mail-abbrev-mode-regexp "^\\(Resent-To\\|To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\|Disposition-Notification-To\\|Return-Receipt-To\\):")) - (when (mail-abbrev-in-expansion-header-p) - (org-contacts-complete-name)))) + (when (mail-abbrev-in-expansion-header-p) + (lexical-let* + ((end (point)) + (start (or start + (save-excursion + (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") + (goto-char (match-end 0)) + (point)))) + (string (buffer-substring start end))) + (or (org-contacts-complete-group start end string) + (org-contacts-complete-name start end string)))))) (defun org-contacts-gnus-get-name-email () "Get name and email address from Gnus message." @@ -273,6 +533,7 @@ If both match values are nil, return all contacts." ;; show the next heading (org-flag-heading nil))))))) +(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el (defun org-contacts-anniversaries (&optional field format) "Compute FIELD anniversary for each contact, returning FORMAT. Default FIELD value is \"BIRTHDAY\". @@ -343,6 +604,7 @@ This function should be called from `gnus-article-prepare-hook'." (org-set-property org-contacts-last-read-mail-property link))))))) (defun org-contacts-icon-as-string () + "Return the contact icon as a string." (let ((image (org-contacts-get-icon))) (concat (propertize "-" 'display @@ -360,9 +622,9 @@ This function should be called from `gnus-article-prepare-hook'." (let ((org-agenda-files (org-contacts-files)) (org-agenda-skip-function (lambda () (org-agenda-skip-if nil `(notregexp ,name)))) - (org-agenda-format (propertize - "%(org-contacts-icon-as-string)% p% s%(org-contacts-irc-number-of-unread-messages)%+T" - 'keymap org-contacts-keymap)) + (org-agenda-prefix-format (propertize + "%(org-contacts-icon-as-string)% s%(org-contacts-irc-number-of-unread-messages) " + 'keymap org-contacts-keymap)) (org-agenda-overriding-header (or org-agenda-overriding-header (concat "List of contacts matching `" name "':")))) @@ -379,12 +641,17 @@ This function should be called from `gnus-article-prepare-hook'." (org-completing-read prompt (org-contacts-filter) predicate t initial-input hist def inherit-input-method)) +(defun org-contacts-format-name (name) + "Trim any local formatting to get a bare NAME." + ;; Remove radio targets characters + (replace-regexp-in-string org-radio-target-regexp "\\1" name)) + (defun org-contacts-format-email (name email) - "Format a mail address." + "Format an EMAIL address corresponding to NAME." (unless email (error "`email' cannot be nul")) (if name - (concat name " <" email ">") + (concat (org-contacts-format-name name) " <" email ">") email)) (defun org-contacts-check-mail-address (mail) @@ -407,7 +674,7 @@ This function should be called from `gnus-article-prepare-hook'." "Add some hooks for Gnus user. This adds `org-contacts-gnus-check-mail-address' and `org-contacts-gnus-store-last-mail' to -`gnus-article-prepare-hook'. It also adds a binding on `;' in +`gnus-article-prepare-hook'. It also adds a binding on `;' in `gnus-summary-mode-map' to `org-contacts-gnus-article-from-goto'" (require 'gnus) (require 'gnus-art) @@ -415,7 +682,8 @@ This adds `org-contacts-gnus-check-mail-address' and (add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-check-mail-address) (add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-store-last-mail)) -(when (boundp 'completion-at-point-functions) +(when (and org-contacts-enable-completion + (boundp 'completion-at-point-functions)) (add-hook 'message-mode-hook (lambda () (add-to-list 'completion-at-point-functions @@ -427,18 +695,19 @@ Works from wl-summary-mode and mime-view-mode - that is while viewing email. Depends on Wanderlust been loaded." (with-current-buffer (org-capture-get :original-buffer) (cond - ((eq major-mode 'wl-summary-mode) (when wl-summary-buffer-elmo-folder + ((eq major-mode 'wl-summary-mode) (when (and (boundp 'wl-summary-buffer-elmo-folder) + wl-summary-buffer-elmo-folder) (elmo-message-field wl-summary-buffer-elmo-folder (wl-summary-message-number) 'from))) ((eq major-mode 'mime-view-mode) (std11-narrow-to-header) - (prog1 - (std11-fetch-field "From") - (widen)))))) + (prog1 + (std11-fetch-field "From") + (widen)))))) (defun org-contacts-wl-get-name-email () - "Get name and email address from wanderlust email. + "Get name and email address from Wanderlust email. See `org-contacts-wl-get-from-header-content' for limitations." (let ((from (org-contacts-wl-get-from-header-content))) (when from @@ -447,13 +716,14 @@ See `org-contacts-wl-get-from-header-content' for limitations." (defun org-contacts-template-wl-name (&optional return-value) "Try to return the contact name for a template from wl. -If not found return RETURN-VALUE or something that would ask the user." +If not found, return RETURN-VALUE or something that would ask the +user." (or (car (org-contacts-wl-get-name-email)) return-value "%^{Name}")) (defun org-contacts-template-wl-email (&optional return-value) - "Try to return the contact email for a template from wl. + "Try to return the contact email for a template from Wanderlust. If not found return RETURN-VALUE or something that would ask the user." (or (cadr (org-contacts-wl-get-name-email)) return-value @@ -461,7 +731,8 @@ If not found return RETURN-VALUE or something that would ask the user." (defun org-contacts-view-send-email (&optional ask) "Send email to the contact at point. -If ASK is set, ask for the email address even if there's only one address." +If ASK is set, ask for the email address even if there's only one +address." (interactive "P") (let ((marker (org-get-at-bol 'org-hd-marker))) (org-with-point-at marker @@ -537,24 +808,31 @@ If ASK is set, ask for the email address even if there's only one address." (defun erc-nicknames-list () "Return all nicknames of all ERC buffers." - (if (fboundp 'erc-buffer-list) - (loop for buffer in (erc-buffer-list) - nconc (with-current-buffer buffer - (loop for user-entry in (mapcar 'car (erc-get-channel-user-list)) - collect (elt user-entry 1)))))) + (loop for buffer in (erc-buffer-list) + nconc (with-current-buffer buffer + (loop for user-entry in (mapcar 'car (erc-get-channel-user-list)) + collect (elt user-entry 1))))) (add-to-list 'org-property-set-functions-alist `(,org-contacts-nickname-property . org-contacts-completing-read-nickname)) (defun org-contacts-vcard-escape (str) - "Escape ; , and \n in STR for use in the VCard format. -Thanks to http://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el for the regexp." + "Escape ; , and \n in STR for the VCard format." + ;; Thanks to this library for the regexp: + ;; http://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el (when str - (replace-regexp-in-string "\n" "\\\\n" (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str)))) + (replace-regexp-in-string + "\n" "\\\\n" + (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str)))) (defun org-contacts-vcard-encode-name (name) - "Try to encode NAME as VCard's N property. The N property expects FamilyName;GivenName;AdditionalNames;Prefix;Postfix. -Org-contacts does not specify how to encode the name. So we try to do our best." + "Try to encode NAME as VCard's N property. +The N property expects + + FamilyName;GivenName;AdditionalNames;Prefix;Postfix. + +Org-contacts does not specify how to encode the name. So we try +to do our best." (concat (replace-regexp-in-string "\\(\\w+\\) \\(.*\\)" "\\2;\\1" name) ";;;")) (defun org-contacts-vcard-format (contact) @@ -562,16 +840,30 @@ Org-contacts does not specify how to encode the name. So we try to do our best." (let* ((properties (caddr contact)) (name (org-contacts-vcard-escape (car contact))) (n (org-contacts-vcard-encode-name name)) - (email (org-contacts-vcard-escape (cdr (assoc-string org-contacts-email-property properties)))) + (email (cdr (assoc-string org-contacts-email-property properties))) + (tel (cdr (assoc-string org-contacts-tel-property properties))) + (note (cdr (assoc-string org-contacts-note-property properties))) (bday (org-contacts-vcard-escape (cdr (assoc-string org-contacts-birthday-property properties)))) (addr (cdr (assoc-string org-contacts-address-property properties))) (nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-property properties)))) - (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name))) (concat head - (when email (format "EMAIL:%s\n" email)) + (when email (progn + (setq emails-list (split-string email "[,;: ]+")) + (setq result "") + (while emails-list + (setq result (concat result "EMAIL:" (car emails-list) "\n")) + (setq emails-list (cdr emails-list))) + result)) (when addr (format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr))) + (when tel (progn + (setq phones-list (split-string tel "[,;: ]+")) + (setq result "") + (while phones-list + (setq result (concat result "TEL:" (car phones-list) "\n")) + (setq phones-list (cdr phones-list))) + result)) (when bday (let ((cal-bday (calendar-gregorian-from-absolute (org-time-string-to-absolute bday)))) (format "BDAY:%04d-%02d-%02d\n" @@ -579,44 +871,47 @@ Org-contacts does not specify how to encode the name. So we try to do our best." (calendar-extract-month cal-bday) (calendar-extract-day cal-bday)))) (when nick (format "NICKNAME:%s\n" nick)) + (when note (format "NOTE:%s\n" note)) "END:VCARD\n\n"))) (defun org-contacts-export-as-vcard (&optional name file to-buffer) - "Export all contacts matching NAME as VCard 3.0. It TO-BUFFER is nil, the content is written to FILE or `org-contacts-vcard-file'. If TO-BUFFER is non-nil, the buffer is created and the VCard is written into that buffer." + "Export all contacts matching NAME as VCard 3.0. +If TO-BUFFER is nil, the content is written to FILE or +`org-contacts-vcard-file'. If TO-BUFFER is non-nil, the buffer +is created and the VCard is written into that buffer." (interactive) ; TODO ask for name? (let* ((filename (or file org-contacts-vcard-file)) (buffer (if to-buffer (get-buffer-create to-buffer) - (find-file-noselect filename)))) - + (find-file-noselect filename)))) (message "Exporting...") - (set-buffer buffer) (let ((inhibit-read-only t)) (erase-buffer)) (fundamental-mode) - (org-install-letbind) - (when (fboundp 'set-buffer-file-coding-system) (set-buffer-file-coding-system coding-system-for-write)) - (loop for contact in (org-contacts-filter name) - do (insert (org-contacts-vcard-format contact))) - + do (insert (org-contacts-vcard-format contact))) (if to-buffer (current-buffer) - (progn (save-buffer) (kill-buffer))))) + (progn (save-buffer) (kill-buffer))))) (defun org-contacts-show-map (&optional name) - "Show contacts on a map. Requires google-maps-el." + "Show contacts on a map. +Requires google-maps-el." (interactive) (unless (fboundp 'google-maps-static-show) (error "`org-contacts-show-map' requires `google-maps-el'")) (google-maps-static-show :markers (loop - for contact in (org-contacts-filter name) - for addr = (cdr (assoc-string org-contacts-address-property (caddr contact))) - if addr - collect (cons (list addr) (list :label (string-to-char (car contact))))))) + for contact in (org-contacts-filter name) + for addr = (cdr (assoc-string org-contacts-address-property (caddr contact))) + if addr + collect (cons (list addr) (list :label (string-to-char (car contact))))))) (provide 'org-contacts) + +(provide 'org-contacts) + +;;; org-contacts.el ends here diff --git a/contrib/lisp/org-contribdir.el b/contrib/lisp/org-contribdir.el index 5ea0ee713..8132750db 100644 --- a/contrib/lisp/org-contribdir.el +++ b/contrib/lisp/org-contribdir.el @@ -8,12 +8,12 @@ ;; ;; This file is not yet part of GNU Emacs. ;; -;; GNU Emacs is free software; you can redistribute it and/or modify +;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. diff --git a/contrib/lisp/org-depend.el b/contrib/lisp/org-depend.el index cc446d106..dc99a1d2e 100644 --- a/contrib/lisp/org-depend.el +++ b/contrib/lisp/org-depend.el @@ -13,15 +13,13 @@ ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el index 2ffc20194..5bf6dd490 100644 --- a/contrib/lisp/org-drill.el +++ b/contrib/lisp/org-drill.el @@ -1,28 +1,42 @@ -;;; -*- coding: utf-8-unix -*- +;; -*- coding: utf-8-unix -*- ;;; org-drill.el - Self-testing using spaced repetition ;;; -;;; Author: Paul Sexton -;;; Version: 2.3.6 -;;; Repository at http://bitbucket.org/eeeickythump/org-drill/ -;;; -;;; -;;; Synopsis -;;; ======== -;;; -;;; Uses the SuperMemo spaced repetition algorithms to conduct interactive -;;; "drill sessions", where the material to be remembered is presented to the -;;; student in random order. The student rates his or her recall of each item, -;;; and this information is used to schedule the item for later revision. -;;; -;;; Each drill session can be restricted to topics in the current buffer -;;; (default), one or several files, all agenda files, or a subtree. A single -;;; topic can also be drilled. -;;; -;;; Different "card types" can be defined, which present their information to -;;; the student in different ways. -;;; -;;; See the file README.org for more detailed documentation. +;; Author: Paul Sexton +;; Version: 2.3.7 +;; Repository at http://bitbucket.org/eeeickythump/org-drill/ +;; +;; This file is not part of GNU Emacs. +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . +;;; Commentary and synopsis: +;;; +;; Uses the SuperMemo spaced repetition algorithms to conduct interactive +;; "drill sessions", where the material to be remembered is presented to the +;; student in random order. The student rates his or her recall of each item, +;; and this information is used to schedule the item for later revision. +;; +;; Each drill session can be restricted to topics in the current buffer +;; (default), one or several files, all agenda files, or a subtree. A single +;; topic can also be drilled. +;; +;; Different "card types" can be defined, which present their information to +;; the student in different ways. +;; +;; See the file README.org for more detailed documentation. +;; +;;; Code: (eval-when-compile (require 'cl)) (eval-when-compile (require 'hi-lock)) @@ -30,41 +44,30 @@ (require 'org-id) (require 'org-learn) - (defgroup org-drill nil "Options concerning interactive drill sessions in Org mode (org-drill)." :tag "Org-Drill" :group 'org-link) - - -(defcustom org-drill-question-tag - "drill" +(defcustom org-drill-question-tag "drill" "Tag which topics must possess in order to be identified as review topics by `org-drill'." :group 'org-drill :type 'string) - -(defcustom org-drill-maximum-items-per-session - 30 +(defcustom org-drill-maximum-items-per-session 30 "Each drill session will present at most this many topics for review. Nil means unlimited." :group 'org-drill :type '(choice integer (const nil))) - - -(defcustom org-drill-maximum-duration - 20 +(defcustom org-drill-maximum-duration 20 "Maximum duration of a drill session, in minutes. Nil means unlimited." :group 'org-drill :type '(choice integer (const nil))) - -(defcustom org-drill-failure-quality - 2 +(defcustom org-drill-failure-quality 2 "If the quality of recall for an item is this number or lower, it is regarded as an unambiguous failure, and the repetition interval for the card is reset to 0 days. If the quality is higher @@ -78,9 +81,7 @@ really sensible." :group 'org-drill :type '(choice (const 2) (const 1))) - -(defcustom org-drill-forgetting-index - 10 +(defcustom org-drill-forgetting-index 10 "What percentage of items do you consider it is 'acceptable' to forget each drill session? The default is 10%. A warning message is displayed at the end of the session if the percentage forgotten @@ -88,17 +89,13 @@ climbs above this number." :group 'org-drill :type 'integer) - -(defcustom org-drill-leech-failure-threshold - 15 +(defcustom org-drill-leech-failure-threshold 15 "If an item is forgotten more than this many times, it is tagged as a 'leech' item." :group 'org-drill :type '(choice integer (const nil))) - -(defcustom org-drill-leech-method - 'skip +(defcustom org-drill-leech-method 'skip "How should 'leech items' be handled during drill sessions? Possible values: - nil :: Leech items are treated the same as normal items. @@ -109,71 +106,58 @@ Possible values: :group 'org-drill :type '(choice (const 'warn) (const 'skip) (const nil))) - (defface org-drill-visible-cloze-face '((t (:foreground "darkseagreen"))) "The face used to hide the contents of cloze phrases." :group 'org-drill) - (defface org-drill-visible-cloze-hint-face '((t (:foreground "dark slate blue"))) "The face used to hide the contents of cloze phrases." :group 'org-drill) - (defface org-drill-hidden-cloze-face '((t (:foreground "deep sky blue" :background "blue"))) "The face used to hide the contents of cloze phrases." :group 'org-drill) - -(defcustom org-drill-use-visible-cloze-face-p - nil +(defcustom org-drill-use-visible-cloze-face-p nil "Use a special face to highlight cloze-deleted text in org mode buffers?" :group 'org-drill :type 'boolean) - -(defcustom org-drill-hide-item-headings-p - nil +(defcustom org-drill-hide-item-headings-p nil "Conceal the contents of the main heading of each item during drill sessions? You may want to enable this behaviour if item headings or tags contain information that could 'give away' the answer." :group 'org-drill :type 'boolean) - -(defcustom org-drill-new-count-color - "royal blue" +(defcustom org-drill-new-count-color "royal blue" "Foreground colour used to display the count of remaining new items during a drill session." :group 'org-drill :type 'color) -(defcustom org-drill-mature-count-color - "green" +(defcustom org-drill-mature-count-color "green" "Foreground colour used to display the count of remaining mature items during a drill session. Mature items are due for review, but are not new." :group 'org-drill :type 'color) -(defcustom org-drill-failed-count-color - "red" +(defcustom org-drill-failed-count-color "red" "Foreground colour used to display the count of remaining failed items during a drill session." :group 'org-drill :type 'color) -(defcustom org-drill-done-count-color - "sienna" +(defcustom org-drill-done-count-color "sienna" "Foreground colour used to display the count of reviewed items during a drill session." :group 'org-drill :type 'color) - (setplist 'org-drill-cloze-overlay-defaults '(display "[...]" face org-drill-hidden-cloze-face @@ -187,60 +171,70 @@ during a drill session." face default window t)) +(defvar org-drill-hint-separator "||" + "String which, if it occurs within a cloze expression, signifies that the +rest of the expression after the string is a `hint', to be displayed instead of +the hidden cloze during a test.") (defvar org-drill-cloze-regexp - ;; ver 1 "[^][]\\(\\[[^][][^]]*\\]\\)" - ;; ver 2 "\\(\\[.*?\\]\\|^[^[[:cntrl:]]*?\\]\\|\\[.*?$\\)" - ;; ver 3! "\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)" - "\\(\\[[[:cntrl:][:graph:][:space:]]*?\\)\\(\\||.+?\\)\\(\\]\\)") - + (concat "\\(\\[[[:cntrl:][:graph:][:space:]]+?\\)\\(\\|" + (regexp-quote org-drill-hint-separator) + ".+?\\)\\(\\]\\)")) (defvar org-drill-cloze-keywords `((,org-drill-cloze-regexp (1 'org-drill-visible-cloze-face nil) (2 'org-drill-visible-cloze-hint-face t) - (3 'org-drill-visible-cloze-face nil) - ))) - + (3 'org-drill-visible-cloze-face nil)))) (defcustom org-drill-card-type-alist - '((nil . org-drill-present-simple-card) - ("simple" . org-drill-present-simple-card) - ("twosided" . org-drill-present-two-sided-card) - ("multisided" . org-drill-present-multi-sided-card) - ("hide1cloze" . org-drill-present-multicloze-hide1) - ("hide2cloze" . org-drill-present-multicloze-hide2) - ("show1cloze" . org-drill-present-multicloze-show1) - ("show2cloze" . org-drill-present-multicloze-show2) - ("multicloze" . org-drill-present-multicloze-hide1) - ("hidefirst" . org-drill-present-multicloze-hide-first) - ("hidelast" . org-drill-present-multicloze-hide-last) - ("hide1_firstmore" . org-drill-present-multicloze-hide1-firstmore) - ("show1_lastmore" . org-drill-present-multicloze-show1-lastmore) - ("show1_firstless" . org-drill-present-multicloze-show1-firstless) - ("conjugate" org-drill-present-verb-conjugation + '((nil org-drill-present-simple-card) + ("simple" org-drill-present-simple-card) + ("twosided" org-drill-present-two-sided-card nil t) + ("multisided" org-drill-present-multi-sided-card nil t) + ("hide1cloze" org-drill-present-multicloze-hide1) + ("hide2cloze" org-drill-present-multicloze-hide2) + ("show1cloze" org-drill-present-multicloze-show1) + ("show2cloze" org-drill-present-multicloze-show2) + ("multicloze" org-drill-present-multicloze-hide1) + ("hidefirst" org-drill-present-multicloze-hide-first) + ("hidelast" org-drill-present-multicloze-hide-last) + ("hide1_firstmore" org-drill-present-multicloze-hide1-firstmore) + ("show1_lastmore" org-drill-present-multicloze-show1-lastmore) + ("show1_firstless" org-drill-present-multicloze-show1-firstless) + ("conjugate" + org-drill-present-verb-conjugation org-drill-show-answer-verb-conjugation) - ("spanish_verb" . org-drill-present-spanish-verb) - ("translate_number" org-drill-present-translate-number - org-drill-show-answer-translate-number)) - "Alist associating card types with presentation functions. Each entry in the -alist takes one of two forms: -1. (CARDTYPE . QUESTION-FN), where CARDTYPE is a string or nil (for default), - and QUESTION-FN is a function which takes no arguments and returns a boolean - value. -2. (CARDTYPE QUESTION-FN ANSWER-FN), where ANSWER-FN is a function that takes - one argument -- the argument is a function that itself takes no arguments. - ANSWER-FN is called with the point on the active item's - heading, just prior to displaying the item's 'answer'. It can therefore be - used to modify the appearance of the answer. ANSWER-FN must call its argument - before returning. (Its argument is a function that prompts the user and - performs rescheduling)." + ("decline_noun" + org-drill-present-noun-declension + org-drill-show-answer-noun-declension) + ("spanish_verb" org-drill-present-spanish-verb) + ("translate_number" org-drill-present-translate-number)) + "Alist associating card types with presentation functions. Each +entry in the alist takes the form: + +;;; (CARDTYPE QUESTION-FN [ANSWER-FN DRILL-EMPTY-P]) + +Where CARDTYPE is a string or nil (for default), and QUESTION-FN +is a function which takes no arguments and returns a boolean +value. + +When supplied, ANSWER-FN is a function that takes one argument -- +that argument is a function of no arguments, which when called, +prompts the user to rate their recall and performs rescheduling +of the drill item. ANSWER-FN is called with the point on the +active item's heading, just prior to displaying the item's +'answer'. It can therefore be used to modify the appearance of +the answer. ANSWER-FN must call its argument before returning. + +When supplied, DRILL-EMPTY-P is a boolean value, default nil. +When non-nil, cards of this type will be presented during tests +even if their bodies are empty." :group 'org-drill - :type '(alist :key-type (choice string (const nil)) :value-type function)) + :type '(alist :key-type (choice string (const nil)) + :value-type function)) - -(defcustom org-drill-scope - 'file +(defcustom org-drill-scope 'file "The scope in which to search for drill items when conducting a drill session. This can be any of: @@ -267,17 +261,13 @@ directory All files with the extension '.org' in the same (const 'agenda-with-archives) (const 'directory) list)) - -(defcustom org-drill-save-buffers-after-drill-sessions-p - t +(defcustom org-drill-save-buffers-after-drill-sessions-p t "If non-nil, prompt to save all modified buffers after a drill session finishes." :group 'org-drill :type 'boolean) - -(defcustom org-drill-spaced-repetition-algorithm - 'sm5 +(defcustom org-drill-spaced-repetition-algorithm 'sm5 "Which SuperMemo spaced repetition algorithm to use for scheduling items. Available choices are: - SM2 :: the SM2 algorithm, used in SuperMemo 2.0 @@ -292,9 +282,7 @@ Available choices are: :group 'org-drill :type '(choice (const 'sm2) (const 'sm5) (const 'simple8))) - -(defcustom org-drill-optimal-factor-matrix - nil +(defcustom org-drill-optimal-factor-matrix nil "DO NOT CHANGE THE VALUE OF THIS VARIABLE. Persistent matrix of optimal factors, used by the SuperMemo SM5 algorithm. @@ -306,18 +294,14 @@ pace of learning." :group 'org-drill :type 'sexp) - -(defcustom org-drill-sm5-initial-interval - 4.0 +(defcustom org-drill-sm5-initial-interval 4.0 "In the SM5 algorithm, the initial interval after the first successful presentation of an item is always 4 days. If you wish to change this, you can do so here." :group 'org-drill :type 'float) - -(defcustom org-drill-add-random-noise-to-intervals-p - nil +(defcustom org-drill-add-random-noise-to-intervals-p nil "If true, the number of days until an item's next repetition will vary slightly from the interval calculated by the SM2 algorithm. The variation is very small when the interval is @@ -325,9 +309,7 @@ small, but scales up with the interval." :group 'org-drill :type 'boolean) - -(defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p - nil +(defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p nil "If true, when the student successfully reviews an item 1 or more days before or after the scheduled review date, this will affect that date of the item's next scheduled review, according to the algorithm presented at @@ -342,9 +324,7 @@ is used." :group 'org-drill :type 'boolean) - -(defcustom org-drill-cloze-text-weight - 4 +(defcustom org-drill-cloze-text-weight 4 "For card types 'hide1_firstmore', 'show1_lastmore' and 'show1_firstless', this number determines how often the 'less favoured' situation should arise. It will occur 1 in every N trials, where N is the @@ -363,15 +343,12 @@ all weighted card types are treated as their unweighted equivalents." :group 'org-drill :type '(choice integer (const nil))) - -(defcustom org-drill-cram-hours - 12 +(defcustom org-drill-cram-hours 12 "When in cram mode, items are considered due for review if they were reviewed at least this many hours ago." :group 'org-drill :type 'integer) - ;;; NEW items have never been presented in a drill session before. ;;; MATURE items HAVE been presented at least once before. ;;; - YOUNG mature items were scheduled no more than @@ -384,17 +361,13 @@ they were reviewed at least this many hours ago." ;;; LAST-INTERVAL * (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) days, ;;; regardless of young/old status. - -(defcustom org-drill-days-before-old - 10 +(defcustom org-drill-days-before-old 10 "When an item's inter-repetition interval rises above this value in days, it is no longer considered a 'young' (recently learned) item." :group 'org-drill :type 'integer) - -(defcustom org-drill-overdue-interval-factor - 1.2 +(defcustom org-drill-overdue-interval-factor 1.2 "An item is considered overdue if its scheduled review date is more than (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) * LAST-INTERVAL days in the past. For example, a value of 1.2 means an additional @@ -406,9 +379,7 @@ should never be less than 1.0." :group 'org-drill :type 'float) - -(defcustom org-drill-learn-fraction - 0.5 +(defcustom org-drill-learn-fraction 0.5 "Fraction between 0 and 1 that governs how quickly the spaces between successive repetitions increase, for all items. The default value is 0.5. Higher values make spaces increase more @@ -418,6 +389,15 @@ exponential effect on inter-repetition spacing." :group 'org-drill :type 'float) +(defvar drill-answer nil + "Global variable that can be bound to a correct answer when an +item is being presented. If this variable is non-nil, the default +presentation function will show its value instead of the default +behaviour of revealing the contents of the drilled item. + +This variable is useful for card types that compute their answers +-- for example, a card type that asks the student to translate a +random number to another language. ") (defvar *org-drill-session-qualities* nil) (defvar *org-drill-start-time* 0) @@ -448,10 +428,8 @@ for review unless they were already reviewed in the recent past?") "DRILL_TOTAL_REPEATS" "DRILL_FAILURE_COUNT" "DRILL_AVERAGE_QUALITY" "DRILL_EASE" "DRILL_LAST_QUALITY" "DRILL_LAST_REVIEWED")) - ;;; Make the above settings safe as file-local variables. - (put 'org-drill-question-tag 'safe-local-variable 'stringp) (put 'org-drill-maximum-items-per-session 'safe-local-variable '(lambda (val) (or (integerp val) (null val)))) @@ -480,14 +458,11 @@ for review unless they were already reviewed in the recent past?") (put 'org-drill-cloze-text-weight 'safe-local-variable '(lambda (val) (or (null val) (integerp val)))) - ;;;; Utilities ================================================================ - (defun free-marker (m) (set-marker m nil)) - (defmacro pop-random (place) (let ((idx (gensym))) `(if (null ,place) @@ -497,13 +472,11 @@ for review unless they were already reviewed in the recent past?") (setq ,place (append (subseq ,place 0 ,idx) (subseq ,place (1+ ,idx))))))))) - (defmacro push-end (val place) "Add VAL to the end of the sequence stored in PLACE. Return the new value." `(setq ,place (append ,place (list ,val)))) - (defun shuffle-list (list) "Randomly permute the elements of LIST (all permutations equally likely)." ;; Adapted from 'shuffle-vector' in cookie1.el @@ -519,27 +492,23 @@ value." (setq i (1+ i)))) list) - (defun round-float (floatnum fix) "Round the floating point number FLOATNUM to FIX decimal places. Example: (round-float 3.56755765 3) -> 3.568" (let ((n (expt 10 fix))) (/ (float (round (* floatnum n))) n))) - (defun command-keybinding-to-string (cmd) "Return a human-readable description of the key/keys to which the command CMD is bound, or nil if it is not bound to a key." (let ((key (where-is-internal cmd overriding-local-map t))) (if key (key-description key)))) - (defun time-to-inactive-org-timestamp (time) (format-time-string (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]") time)) - (defun org-map-drill-entries (func &optional scope &rest skip) "Like `org-map-entries', but only drill entries are processed." (let ((org-drill-scope (or scope org-drill-scope))) @@ -554,7 +523,6 @@ CMD is bound, or nil if it is not bound to a key." (t org-drill-scope)) skip))) - (defmacro with-hidden-cloze-text (&rest body) `(progn (org-drill-hide-clozed-text) @@ -563,7 +531,6 @@ CMD is bound, or nil if it is not bound to a key." ,@body) (org-drill-unhide-clozed-text)))) - (defmacro with-hidden-cloze-hints (&rest body) `(progn (org-drill-hide-cloze-hints) @@ -572,7 +539,6 @@ CMD is bound, or nil if it is not bound to a key." ,@body) (org-drill-unhide-text)))) - (defmacro with-hidden-comments (&rest body) `(progn (if org-drill-hide-item-headings-p @@ -583,7 +549,6 @@ CMD is bound, or nil if it is not bound to a key." ,@body) (org-drill-unhide-text)))) - (defun org-drill-days-since-last-review () "Nil means a last review date has not yet been stored for the item. @@ -597,7 +562,6 @@ this should never happen." (time-to-days (apply 'encode-time (org-parse-time-string datestr))))))) - (defun org-drill-hours-since-last-review () "Like `org-drill-days-since-last-review', but return value is in hours rather than days." @@ -609,7 +573,6 @@ in hours rather than days." (org-parse-time-string datestr)))) (* 60 60)))))) - (defun org-drill-entry-p (&optional marker) "Is MARKER, or the point, in a 'drill item'? This will return nil if the point is inside a subheading of a drill item -- to handle that @@ -619,12 +582,10 @@ situation use `org-part-of-drill-entry-p'." (org-drill-goto-entry marker)) (member org-drill-question-tag (org-get-local-tags)))) - (defun org-drill-goto-entry (marker) (switch-to-buffer (marker-buffer marker)) (goto-char marker)) - (defun org-part-of-drill-entry-p () "Is the current entry either the main heading of a 'drill item', or a subheading within a drill item?" @@ -632,7 +593,6 @@ or a subheading within a drill item?" ;; Does this heading INHERIT the drill tag (member org-drill-question-tag (org-get-tags-at)))) - (defun org-drill-goto-drill-entry-heading () "Move the point to the heading which holds the :drill: tag for this drill entry." @@ -644,14 +604,11 @@ drill entry." (unless (org-up-heading-safe) (error "Cannot find a parent heading that is marked as a drill entry")))) - - (defun org-drill-entry-leech-p () "Is the current entry a 'leech item'?" (and (org-drill-entry-p) (member "leech" (org-get-local-tags)))) - ;; (defun org-drill-entry-due-p () ;; (cond ;; (*org-drill-cram-mode* @@ -669,7 +626,6 @@ drill entry." ;; (- (time-to-days (current-time)) ;; (time-to-days item-time)))))))))) - (defun org-drill-entry-days-overdue () "Returns: - NIL if the item is not to be regarded as scheduled for review at all. @@ -699,7 +655,6 @@ drill entry." (- (time-to-days (current-time)) (time-to-days item-time)))))))) - (defun org-drill-entry-overdue-p (&optional days-overdue last-interval) "Returns true if entry that is scheduled DAYS-OVERDUE dasy in the past, and whose last inter-repetition interval was LAST-INTERVAL, should be @@ -715,34 +670,28 @@ from the entry at point." (> (/ (+ days-overdue last-interval 1.0) last-interval) org-drill-overdue-interval-factor))) - - (defun org-drill-entry-due-p () (let ((due (org-drill-entry-days-overdue))) (and (not (null due)) (not (minusp due))))) - (defun org-drill-entry-new-p () (and (org-drill-entry-p) (let ((item-time (org-get-scheduled-time (point)))) (null item-time)))) - (defun org-drill-entry-last-quality (&optional default) (let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY"))) (if quality (string-to-number quality) default))) - (defun org-drill-entry-failure-count () (let ((quality (org-entry-get (point) "DRILL_FAILURE_COUNT"))) (if quality (string-to-number quality) 0))) - (defun org-drill-entry-average-quality (&optional default) (let ((val (org-entry-get (point) "DRILL_AVERAGE_QUALITY"))) (if val @@ -773,7 +722,6 @@ from the entry at point." (string-to-number val) default))) - ;;; From http://www.supermemo.com/english/ol/sm5.htm (defun org-drill-random-dispersal-factor () "Returns a random number between 0.5 and 1.5." @@ -796,10 +744,9 @@ from the entry at point." (- variation) mean)) - (defun org-drill-early-interval-factor (optimal-factor - optimal-interval - days-ahead) + optimal-interval + days-ahead) "Arguments: - OPTIMAL-FACTOR: interval-factor if the item had been tested exactly when it was supposed to be. @@ -816,7 +763,6 @@ in the matrix." (- optimal-factor (* delta-ofmax (/ days-ahead (+ days-ahead (* 0.6 optimal-interval))))))) - (defun org-drill-get-item-data () "Returns a list of 6 items, containing all the stored recall data for the item at point: @@ -854,7 +800,6 @@ in the matrix." (t ; virgin item (list 0 0 0 0 nil nil))))) - (defun org-drill-store-item-data (last-interval repeats failures total-repeats meanq ease) @@ -870,11 +815,8 @@ in the matrix." (org-set-property "DRILL_EASE" (number-to-string (round-float ease 3)))) - - ;;; SM2 Algorithm ============================================================= - (defun determine-next-interval-sm2 (last-interval n ef quality failures meanq total-repeats) "Arguments: @@ -923,8 +865,6 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher ;;; SM5 Algorithm ============================================================= - - (defun initial-optimal-factor-sm5 (n ef) (if (= 1 n) org-drill-sm5-initial-interval @@ -937,7 +877,6 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher (and ef-of (cdr ef-of)))) (initial-optimal-factor-sm5 n ef)))) - (defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix) (let ((of (get-optimal-factor-sm5 n ef (or of-matrix org-drill-optimal-factor-matrix)))) @@ -945,7 +884,6 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher of (* of last-interval)))) - (defun determine-next-interval-sm5 (last-interval n ef quality failures meanq total-repeats of-matrix &optional delta-days) @@ -956,12 +894,10 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher (unless of-matrix (setq of-matrix org-drill-optimal-factor-matrix)) (setq of-matrix (cl-copy-tree of-matrix)) - (setq meanq (if meanq (/ (+ quality (* meanq total-repeats 1.0)) (1+ total-repeats)) quality)) - (let ((next-ef (modify-e-factor ef quality)) (old-ef ef) (new-of (modify-of (get-optimal-factor-sm5 n ef of-matrix) @@ -974,13 +910,10 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher (inter-repetition-interval-sm5 last-interval n ef of-matrix) delta-days))) - (setq of-matrix (set-optimal-factor n next-ef of-matrix (round-float new-of 3))) ; round OF to 3 d.p. - (setq ef next-ef) - (cond ;; "Failed" -- reset repetitions to 0, ((<= quality org-drill-failure-quality) @@ -1005,10 +938,8 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher (1+ total-repeats) of-matrix))))) - ;;; Simple8 Algorithm ========================================================= - (defun org-drill-simple8-first-interval (failures) "Arguments: - FAILURES: integer >= 0. The total number of times the item has @@ -1018,7 +949,6 @@ Returns the optimal FIRST interval for an item which has previously been forgotten on FAILURES occasions." (* 2.4849 (exp (* -0.057 failures)))) - (defun org-drill-simple8-interval-factor (ease repetition) "Arguments: - EASE: floating point number >= 1.2. Corresponds to `AF' in SM8 algorithm. @@ -1029,7 +959,6 @@ The factor by which the last interval should be multiplied to give the next interval. Corresponds to `RF' or `OF'." (+ 1.2 (* (- ease 1.2) (expt org-drill-learn-fraction (log repetition 2))))) - (defun org-drill-simple8-quality->ease (quality) "Returns the ease (`AF' in the SM8 algorithm) which corresponds to a mean item quality of QUALITY." @@ -1039,7 +968,6 @@ to a mean item quality of QUALITY." (* -1.2403 quality) 1.4515)) - (defun determine-next-interval-simple8 (last-interval repeats quality failures meanq totaln &optional delta-days) @@ -1106,11 +1034,7 @@ See the documentation for `org-drill-get-item-data' for a description of these." (org-drill-simple8-quality->ease meanq) failures meanq - totaln - ))) - - - + totaln))) ;;; Essentially copied from `org-learn.el', but modified to ;;; optionally call the SM2 or simple8 functions. @@ -1261,35 +1185,35 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)" ((and (>= ch ?0) (<= ch ?5)) (let ((quality (- ch ?0)) (failures (org-drill-entry-failure-count))) - (save-excursion - (org-drill-smart-reschedule quality - (nth quality next-review-dates))) - (push quality *org-drill-session-qualities*) - (cond - ((<= quality org-drill-failure-quality) - (when org-drill-leech-failure-threshold - ;;(setq failures (if failures (string-to-number failures) 0)) - ;; (org-set-property "DRILL_FAILURE_COUNT" - ;; (format "%d" (1+ failures))) - (if (> (1+ failures) org-drill-leech-failure-threshold) - (org-toggle-tag "leech" 'on)))) - (t - (let ((scheduled-time (org-get-scheduled-time (point)))) - (when scheduled-time - (message "Next review in %d days" - (- (time-to-days scheduled-time) - (time-to-days (current-time)))) - (sit-for 0.5))))) - (org-set-property "DRILL_LAST_QUALITY" (format "%d" quality)) - (org-set-property "DRILL_LAST_REVIEWED" - (time-to-inactive-org-timestamp (current-time))) + (unless *org-drill-cram-mode* + (save-excursion + (org-drill-smart-reschedule quality + (nth quality next-review-dates))) + (push quality *org-drill-session-qualities*) + (cond + ((<= quality org-drill-failure-quality) + (when org-drill-leech-failure-threshold + ;;(setq failures (if failures (string-to-number failures) 0)) + ;; (org-set-property "DRILL_FAILURE_COUNT" + ;; (format "%d" (1+ failures))) + (if (> (1+ failures) org-drill-leech-failure-threshold) + (org-toggle-tag "leech" 'on)))) + (t + (let ((scheduled-time (org-get-scheduled-time (point)))) + (when scheduled-time + (message "Next review in %d days" + (- (time-to-days scheduled-time) + (time-to-days (current-time)))) + (sit-for 0.5))))) + (org-set-property "DRILL_LAST_QUALITY" (format "%d" quality)) + (org-set-property "DRILL_LAST_REVIEWED" + (time-to-inactive-org-timestamp (current-time)))) quality)) ((= ch ?e) 'edit) (t nil)))) - ;; (defun org-drill-hide-all-subheadings-except (heading-list) ;; "Returns a list containing the position of each immediate subheading of ;; the current topic." @@ -1310,8 +1234,6 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)" ;; "" 'tree)) ;; (reverse drill-sections))) - - (defun org-drill-hide-subheadings-if (test) "TEST is a function taking no arguments. TEST will be called for each of the immediate subheadings of the current drill item, with the point @@ -1334,13 +1256,11 @@ the current topic." "" 'tree)) (reverse drill-sections))) - (defun org-drill-hide-all-subheadings-except (heading-list) (org-drill-hide-subheadings-if (lambda () (let ((drill-heading (org-get-heading t))) (not (member drill-heading heading-list)))))) - (defun org-drill-presentation-prompt (&rest fmt-and-args) (let* ((item-start-time (current-time)) (input nil) @@ -1361,9 +1281,13 @@ the current topic." (format "%s %s %s %s %s %s" (propertize (char-to-string - (case status - (:new ?N) (:young ?Y) (:old ?o) (:overdue ?!) - (:failed ?F) (t ??))) + (cond + ((eql status :failed) ?F) + (*org-drill-cram-mode* ?C) + (t + (case status + (:new ?N) (:young ?Y) (:old ?o) (:overdue ?!) + (t ??))))) 'face `(:foreground ,(case status (:new org-drill-new-count-color) @@ -1417,13 +1341,11 @@ Consider reformulating the item to make it easier to remember.\n" (?s 'skip) (otherwise t)))) - (defun org-pos-in-regexp (pos regexp &optional nlines) (save-excursion (goto-char pos) (org-in-regexp regexp nlines))) - (defun org-drill-hide-region (beg end &optional text) "Hide the buffer region between BEG and END with an 'invisible text' visual overlay, or with the string TEXT if it is supplied." @@ -1435,22 +1357,19 @@ visual overlay, or with the string TEXT if it is supplied." (overlay-put ovl 'face 'default) (overlay-put ovl 'display text)))) - (defun org-drill-hide-heading-at-point (&optional text) (unless (org-at-heading-p) - (error "Point is not on a heading")) + (error "Point is not on a heading.")) (save-excursion (let ((beg (point))) (end-of-line) (org-drill-hide-region beg (point) text)))) - (defun org-drill-hide-comments () (save-excursion (while (re-search-forward "^#.*$" nil t) (org-drill-hide-region (match-beginning 0) (match-end 0))))) - (defun org-drill-unhide-text () ;; This will also unhide the item's heading. (save-excursion @@ -1458,7 +1377,6 @@ visual overlay, or with the string TEXT if it is supplied." (when (eql 'org-drill-hidden-text-overlay (overlay-get ovl 'category)) (delete-overlay ovl))))) - (defun org-drill-hide-clozed-text () (save-excursion (while (re-search-forward org-drill-cloze-regexp nil t) @@ -1469,25 +1387,26 @@ visual overlay, or with the string TEXT if it is supplied." org-bracket-link-regexp 1)) (org-drill-hide-matched-cloze-text))))) - (defun org-drill-hide-matched-cloze-text () "Hide the current match with a 'cloze' visual overlay." - (let ((ovl (make-overlay (match-beginning 0) (match-end 0)))) + (let ((ovl (make-overlay (match-beginning 0) (match-end 0))) + (hint-sep-pos (string-match-p (regexp-quote org-drill-hint-separator) + (match-string 0)))) (overlay-put ovl 'category 'org-drill-cloze-overlay-defaults) - (when (find ?| (match-string 0)) + (when (and hint-sep-pos + (> hint-sep-pos 1)) (let ((hint (substring-no-properties (match-string 0) - (1+ (position ?| (match-string 0))) + (+ hint-sep-pos (length org-drill-hint-separator)) (1- (length (match-string 0)))))) (overlay-put ovl 'display ;; If hint is like `X...' then display [X...] ;; otherwise display [...X] - (format (if (string-match-p "\\.\\.\\." hint) "[%s]" "[%s...]") + (format (if (string-match-p (regexp-quote "...") hint) "[%s]" "[%s...]") hint)))))) - (defun org-drill-hide-cloze-hints () (save-excursion (while (re-search-forward org-drill-cloze-regexp nil t) @@ -1497,7 +1416,6 @@ visual overlay, or with the string TEXT if it is supplied." (null (match-beginning 2))) ; hint subexpression matched (org-drill-hide-region (match-beginning 2) (match-end 2)))))) - (defmacro with-replaced-entry-text (text &rest body) "During the execution of BODY, the entire text of the current entry is concealed by an overlay that displays the string TEXT." @@ -1508,7 +1426,6 @@ concealed by an overlay that displays the string TEXT." ,@body) (org-drill-unreplace-entry-text)))) - (defmacro with-replaced-entry-text-multi (replacements &rest body) "During the execution of BODY, the entire text of the current entry is concealed by an overlay that displays the overlays in REPLACEMENTS." @@ -1519,7 +1436,6 @@ concealed by an overlay that displays the overlays in REPLACEMENTS." ,@body) (org-drill-unreplace-entry-text)))) - (defun org-drill-replace-entry-text (text &optional multi-p) "Make an overlay that conceals the entire text of the item, not including properties or the contents of subheadings. The overlay shows @@ -1542,14 +1458,12 @@ Note: does not actually alter the item." 'org-drill-replaced-text-overlay) (overlay-put ovl 'display text))))) - (defun org-drill-unreplace-entry-text () (save-excursion (dolist (ovl (overlays-in (point-min) (point-max))) (when (eql 'org-drill-replaced-text-overlay (overlay-get ovl 'category)) (delete-overlay ovl))))) - (defun org-drill-replace-entry-text-multi (replacements) "Make overlays that conceal the entire text of the item, not including properties or the contents of subheadings. The overlay shows @@ -1570,7 +1484,6 @@ Note: does not actually alter the item." 'org-drill-replaced-text-overlay) (overlay-put ovl 'display (nth i replacements))))) - (defmacro with-replaced-entry-heading (heading &rest body) `(progn (org-drill-replace-entry-heading ,heading) @@ -1579,21 +1492,18 @@ Note: does not actually alter the item." ,@body) (org-drill-unhide-text)))) - (defun org-drill-replace-entry-heading (heading) "Make an overlay that conceals the heading of the item. The overlay shows the string TEXT. Note: does not actually alter the item." (org-drill-hide-heading-at-point heading)) - (defun org-drill-unhide-clozed-text () (save-excursion (dolist (ovl (overlays-in (point-min) (point-max))) (when (eql 'org-drill-cloze-overlay-defaults (overlay-get ovl 'category)) (delete-overlay ovl))))) - (defun org-drill-get-entry-text (&optional keep-properties-p) (let ((text (org-agenda-get-some-entry-text (point-marker) 100))) (if keep-properties-p @@ -1601,13 +1511,23 @@ Note: does not actually alter the item." (substring-no-properties text)))) -(defun org-drill-entry-empty-p () - (zerop (length (org-drill-get-entry-text)))) +;; (defun org-entry-empty-p () +;; (zerop (length (org-drill-get-entry-text)))) +;; This version is about 5x faster than the old version, above. +(defun org-entry-empty-p () + (save-excursion + (org-back-to-heading t) + (let ((lim (save-excursion + (outline-next-heading) (point)))) + (org-end-of-meta-data-and-drawers) + (or (>= (point) lim) + (null (re-search-forward "[[:graph:]]" lim t)))))) +(defun org-drill-entry-empty-p () (org-entry-empty-p)) ;;; Presentation functions ==================================================== - +;; ;; Each of these is called with point on topic heading. Each needs to show the ;; topic in the form of a 'question' or with some information 'hidden', as ;; appropriate for the card type. The user should then be prompted to press a @@ -1626,15 +1546,22 @@ Note: does not actually alter the item." (prog1 (org-drill-presentation-prompt) (org-drill-hide-subheadings-if 'org-drill-entry-p)))))) - (defun org-drill-present-default-answer (reschedule-fn) - (org-drill-hide-subheadings-if 'org-drill-entry-p) - (org-drill-unhide-clozed-text) - (ignore-errors - (org-display-inline-images t)) - (with-hidden-cloze-hints - (funcall reschedule-fn))) - + (cond + (drill-answer + (with-replaced-entry-text + (format "\nAnswer:\n\n %s\n" drill-answer) + (prog1 + (funcall reschedule-fn) + (setq drill-answer nil)))) + (t + (org-drill-hide-subheadings-if 'org-drill-entry-p) + (org-drill-unhide-clozed-text) + (ignore-errors + (org-display-inline-images t)) + (org-cycle-hide-drawers 'all) + (with-hidden-cloze-hints + (funcall reschedule-fn))))) (defun org-drill-present-two-sided-card () (with-hidden-comments @@ -1652,8 +1579,6 @@ Note: does not actually alter the item." (prog1 (org-drill-presentation-prompt) (org-drill-hide-subheadings-if 'org-drill-entry-p))))))) - - (defun org-drill-present-multi-sided-card () (with-hidden-comments (with-hidden-cloze-hints @@ -1669,7 +1594,6 @@ Note: does not actually alter the item." (prog1 (org-drill-presentation-prompt) (org-drill-hide-subheadings-if 'org-drill-entry-p))))))) - (defun org-drill-present-multicloze-hide-n (number-to-hide &optional force-show-first @@ -1749,7 +1673,6 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)." (org-drill-hide-subheadings-if 'org-drill-entry-p) (org-drill-unhide-clozed-text)))))) - (defun org-drill-present-multicloze-hide-nth (to-hide) "Hide the TO-HIDE'th piece of clozed text. 1 is the first piece. If TO-HIDE is negative, count backwards, so -1 means the last item, -2 @@ -1797,29 +1720,24 @@ the second to last, etc." (org-drill-hide-subheadings-if 'org-drill-entry-p) (org-drill-unhide-clozed-text)))))) - (defun org-drill-present-multicloze-hide1 () "Hides one of the pieces of text that are marked for cloze deletion, chosen at random." (org-drill-present-multicloze-hide-n 1)) - (defun org-drill-present-multicloze-hide2 () "Hides two of the pieces of text that are marked for cloze deletion, chosen at random." (org-drill-present-multicloze-hide-n 2)) - (defun org-drill-present-multicloze-hide-first () "Hides the first piece of text that is marked for cloze deletion." (org-drill-present-multicloze-hide-nth 1)) - (defun org-drill-present-multicloze-hide-last () "Hides the last piece of text that is marked for cloze deletion." (org-drill-present-multicloze-hide-nth -1)) - (defun org-drill-present-multicloze-hide1-firstmore () "Commonly, hides the FIRST piece of text that is marked for cloze deletion. Uncommonly, hide one of the other pieces of text, @@ -1849,7 +1767,6 @@ the value of `org-drill-cloze-text-weight'." ;; Commonly, hide first item (org-drill-present-multicloze-hide-first)))) - (defun org-drill-present-multicloze-show1-lastmore () "Commonly, hides all pieces except the last. Uncommonly, shows any random piece. The effect is similar to 'show1cloze' except @@ -1874,7 +1791,6 @@ the value of `org-drill-cloze-text-weight'." ;; Commonly, show the LAST item (org-drill-present-multicloze-hide-n -1 nil t)))) - (defun org-drill-present-multicloze-show1-firstless () "Commonly, hides all pieces except one, where the shown piece is guaranteed NOT to be the first piece. Uncommonly, shows any @@ -1900,20 +1816,17 @@ the value of `org-drill-cloze-text-weight'." ;; Commonly, show any item, except the first (org-drill-present-multicloze-hide-n -1 nil nil t)))) - (defun org-drill-present-multicloze-show1 () "Similar to `org-drill-present-multicloze-hide1', but hides all the pieces of text that are marked for cloze deletion, except for one piece which is chosen at random." (org-drill-present-multicloze-hide-n -1)) - (defun org-drill-present-multicloze-show2 () "Similar to `org-drill-present-multicloze-show1', but reveals two pieces rather than one." (org-drill-present-multicloze-hide-n -2)) - ;; (defun org-drill-present-multicloze-show1 () ;; "Similar to `org-drill-present-multicloze-hide1', but hides all ;; the pieces of text that are marked for cloze deletion, except for one @@ -1947,12 +1860,13 @@ pieces rather than one." ;; (org-drill-hide-subheadings-if 'org-drill-entry-p) ;; (org-drill-unhide-clozed-text)))))) - (defun org-drill-present-card-using-text (question &optional answer) - "Present the string QUESTION as the only visible content of the card." + "Present the string QUESTION as the only visible content of the card. +If ANSWER is supplied, set the global variable `drill-answer' to its value." + (if answer (setq drill-answer answer)) (with-hidden-comments (with-replaced-entry-text - question + (concat "\n" question) (org-drill-hide-all-subheadings-except nil) (org-cycle-hide-drawers 'all) (ignore-errors @@ -1960,11 +1874,12 @@ pieces rather than one." (prog1 (org-drill-presentation-prompt) (org-drill-hide-subheadings-if 'org-drill-entry-p))))) - (defun org-drill-present-card-using-multiple-overlays (replacements &optional answer) "TEXTS is a list of valid values for the 'display' text property. Present these overlays, in sequence, as the only -visible content of the card." +visible content of the card. +If ANSWER is supplied, set the global variable `drill-answer' to its value." + (if answer (setq drill-answer answer)) (with-hidden-comments (with-replaced-entry-text-multi replacements @@ -1975,7 +1890,6 @@ visible content of the card." (prog1 (org-drill-presentation-prompt) (org-drill-hide-subheadings-if 'org-drill-entry-p))))) - (defun org-drill-entry () "Present the current topic for interactive review, as in `org-drill'. Review will occur regardless of whether the topic is due for review or whether @@ -1995,20 +1909,24 @@ See `org-drill' for more details." ;; (org-back-to-heading)) (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE")) (answer-fn 'org-drill-present-default-answer) + (present-empty-cards nil) (cont nil) ;; fontification functions in `outline-view-change-hook' can cause big ;; slowdowns, so we temporarily bind this variable to nil here. (outline-view-change-hook nil)) + (setq drill-answer nil) (org-save-outline-visibility t (save-restriction (org-narrow-to-subtree) (org-show-subtree) (org-cycle-hide-drawers 'all) - (let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist)))) + (let ((presentation-fn + (cdr (assoc card-type org-drill-card-type-alist)))) (if (listp presentation-fn) (psetq answer-fn (or (second presentation-fn) 'org-drill-present-default-answer) + present-empty-cards (third presentation-fn) presentation-fn (first presentation-fn))) (cond ((null presentation-fn) @@ -2031,9 +1949,9 @@ See `org-drill' for more details." (funcall answer-fn (lambda () (org-drill-reschedule))))))))))))) - (defun org-drill-entries-pending-p () (or *org-drill-again-entries* + *org-drill-current-item* (and (not (org-drill-maximum-item-count-reached-p)) (not (org-drill-maximum-duration-reached-p)) (or *org-drill-new-entries* @@ -2043,33 +1961,32 @@ See `org-drill' for more details." *org-drill-overdue-entries* *org-drill-again-entries*)))) - (defun org-drill-pending-entry-count () - (+ (length *org-drill-new-entries*) + (+ (if (markerp *org-drill-current-item*) 1 0) + (length *org-drill-new-entries*) (length *org-drill-failed-entries*) (length *org-drill-young-mature-entries*) (length *org-drill-old-mature-entries*) (length *org-drill-overdue-entries*) (length *org-drill-again-entries*))) - (defun org-drill-maximum-duration-reached-p () "Returns true if the current drill session has continued past its maximum duration." (and org-drill-maximum-duration + (not *org-drill-cram-mode*) *org-drill-start-time* (> (- (float-time (current-time)) *org-drill-start-time*) (* org-drill-maximum-duration 60)))) - (defun org-drill-maximum-item-count-reached-p () "Returns true if the current drill session has reached the maximum number of items." (and org-drill-maximum-items-per-session + (not *org-drill-cram-mode*) (>= (length *org-drill-done-entries*) org-drill-maximum-items-per-session))) - (defun org-drill-pop-next-pending-entry () (block org-drill-pop-next-pending-entry (let ((m nil)) @@ -2117,7 +2034,6 @@ maximum number of items." (return-from org-drill-pop-next-pending-entry nil))))) m))) - (defun org-drill-entries (&optional resuming-p) "Returns nil, t, or a list of markers representing entries that were 'failed' and need to be presented again before the session ends. @@ -2157,6 +2073,7 @@ RESUMING-P is true if we are resuming a suspended drill session." (setq end-pos (point-marker)) (return-from org-drill-entries nil)) ((eql result 'skip) + (setq *org-drill-current-item* nil) nil) ; skip this item (t (cond @@ -2166,9 +2083,8 @@ RESUMING-P is true if we are resuming a suspended drill session." (shuffle-list *org-drill-again-entries*))) (push-end m *org-drill-again-entries*)) (t - (push m *org-drill-done-entries*)))))))))))) - - + (push m *org-drill-done-entries*))) + (setq *org-drill-current-item* nil)))))))))) (defun org-drill-final-report () (let ((pass-percent @@ -2176,7 +2092,8 @@ RESUMING-P is true if we are resuming a suspended drill session." (> qual org-drill-failure-quality)) *org-drill-session-qualities*)) (max 1 (length *org-drill-session-qualities*)))) - (prompt nil)) + (prompt nil) + (max-mini-window-height 0.6)) (setq prompt (format "%d items reviewed. Session duration %s. @@ -2255,10 +2172,7 @@ order to make items appear more frequently over time." *org-drill-overdue-entry-count* (round (* 100 *org-drill-overdue-entry-count*) (+ *org-drill-dormant-entry-count* - *org-drill-due-entry-count*))) - )))) - - + *org-drill-due-entry-count*))))))) (defun org-drill-free-markers (markers) "MARKERS is a list of markers, all of which will be freed (set to @@ -2305,8 +2219,14 @@ one of the following values: (cond ((not (org-drill-entry-p)) nil) - ((org-drill-entry-empty-p) - nil) ; skip -- item body is empty + ((and (org-entry-empty-p) + (let* ((card-type (org-entry-get (point) "DRILL_CARD_TYPE" nil)) + (dat (cdr (assoc card-type org-drill-card-type-alist)))) + (or (null card-type) + (not (third dat))))) + ;; body is empty, and this is not a card type where empty bodies are + ;; meaningful, so skip it. + nil) ((null due) ; unscheduled - usually a skipped leech :unscheduled) ;; ((eql -1 due) @@ -2446,47 +2366,16 @@ than starting a new one." (:overdue (push (cons (point-marker) due) overdue-data)) (:old - (push (point-marker) *org-drill-old-mature-entries*))))))) + (push (point-marker) *org-drill-old-mature-entries*)) + ))))) scope) - ;; (let ((due (org-drill-entry-days-overdue)) - ;; (last-int (org-drill-entry-last-interval 1))) - ;; (cond - ;; ((org-drill-entry-empty-p) - ;; nil) ; skip -- item body is empty - ;; ((or (null due) ; unscheduled - usually a skipped leech - ;; (minusp due)) ; scheduled in the future - ;; (incf *org-drill-dormant-entry-count*) - ;; (if (eq -1 due) - ;; (incf *org-drill-due-tomorrow-count*))) - ;; ((org-drill-entry-new-p) - ;; (push (point-marker) *org-drill-new-entries*)) - ;; ((<= (org-drill-entry-last-quality 9999) - ;; org-drill-failure-quality) - ;; ;; Mature entries that were failed last time are - ;; ;; FAILED, regardless of how young, old or overdue - ;; ;; they are. - ;; (push (point-marker) *org-drill-failed-entries*)) - ;; ((org-drill-entry-overdue-p due last-int) - ;; ;; Overdue status overrides young versus old - ;; ;; distinction. - ;; ;; Store marker + due, for sorting of overdue entries - ;; (push (cons (point-marker) due) overdue-data)) - ;; ((<= (org-drill-entry-last-interval 9999) - ;; org-drill-days-before-old) - ;; ;; Item is 'young'. - ;; (push (point-marker) - ;; *org-drill-young-mature-entries*)) - ;; (t - ;; (push (point-marker) - ;; *org-drill-old-mature-entries*)))) - ;; Order 'overdue' items so that the most overdue will tend to - ;; come up for review first, while keeping exact order random (org-drill-order-overdue-entries overdue-data) (setq *org-drill-overdue-entry-count* (length *org-drill-overdue-entries*)))) (setq *org-drill-due-entry-count* (org-drill-pending-entry-count)) (cond - ((and (null *org-drill-new-entries*) + ((and (null *org-drill-current-item*) + (null *org-drill-new-entries*) (null *org-drill-failed-entries*) (null *org-drill-overdue-entries*) (null *org-drill-young-mature-entries*) @@ -2497,6 +2386,7 @@ than starting a new one." (message "Drill session finished!")))) (progn (unless end-pos + (setq *org-drill-cram-mode* nil) (org-drill-free-markers *org-drill-done-entries*))))) (cond (end-pos @@ -2515,8 +2405,7 @@ than starting a new one." (org-drill-save-optimal-factor-matrix)) (if org-drill-save-buffers-after-drill-sessions-p (save-some-buffers)) - (message "Drill session finished!") - )))) + (message "Drill session finished!"))))) (defun org-drill-save-optimal-factor-matrix () @@ -2531,8 +2420,8 @@ all drill items are considered to be due for review, unless they have been reviewed within the last `org-drill-cram-hours' hours." (interactive) - (let ((*org-drill-cram-mode* t)) - (org-drill scope))) + (setq *org-drill-cram-mode* t) + (org-drill scope)) (defun org-drill-tree () @@ -2555,6 +2444,7 @@ were not reviewed during the last session, rather than scanning for unreviewed items. If there are no leftover items in memory, a full scan will be performed." (interactive) + (setq *org-drill-cram-mode* nil) (cond ((plusp (org-drill-pending-entry-count)) (org-drill-free-markers *org-drill-done-entries*) @@ -2675,9 +2565,7 @@ the tag 'imported'." (outline-next-heading) (newline) (forward-line -1) - (paste-tree-here (1+ (or (org-current-level) 0))) - ))))) - + (paste-tree-here (1+ (or (org-current-level) 0)))))))) (defun org-drill-merge-buffers (src &optional dest ignore-new-items-p) @@ -2770,15 +2658,12 @@ copy them across." (free-marker m)) *org-drill-dest-id-table*)))) - - ;;; Card types for learning languages ========================================= ;;; Get spell-number.el from: ;;; http://www.emacswiki.org/emacs/spell-number.el (autoload 'spelln-integer-in-words "spell-number") - ;;; `conjugate' card type ===================================================== ;;; See spanish.org for usage @@ -2883,19 +2768,120 @@ returns its return value." (mood (format "%s mood" mood)))) infinitive translation) + (org-cycle-hide-drawers 'all) + (funcall reschedule-fn)))) + + +;;; `decline_noun' card type ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(defvar org-drill-noun-gender-alist + '(("masculine" "dodgerblue") + ("masc" "dodgerblue") + ("male" "dodgerblue") + ("m" "dodgerblue") + ("feminine" "orchid") + ("fem" "orchid") + ("female" "orchid") + ("f" "orchid") + ("neuter" "green") + ("neutral" "green") + ("neut" "green") + ("n" "green") + )) + + +(defun org-drill-get-noun-info () + "Auxiliary function used by `org-drill-present-noun-declension' and +`org-drill-show-answer-noun-declension'." + (let ((noun (org-entry-get (point) "NOUN" t)) + (noun-hint (org-entry-get (point) "NOUN_HINT" t)) + (noun-root (org-entry-get (point) "NOUN_ROOT" t)) + (noun-gender (org-entry-get (point) "NOUN_GENDER" t)) + (translation (org-entry-get (point) "NOUN_TRANSLATION" t)) + (highlight-face nil)) + (unless (and noun translation) + (error "Missing information for `decline_noun' card (%s, %s, %s, %s) at %s" + noun translation noun-hint noun-root (point))) + (setq noun-root (if noun-root (car (read-from-string noun-root))) + noun (car (read-from-string noun)) + noun-gender (downcase (car (read-from-string noun-gender))) + noun-hint (if noun-hint (car (read-from-string noun-hint))) + translation (car (read-from-string translation))) + (setq highlight-face + (list :foreground + (or (second (assoc-string noun-gender + org-drill-noun-gender-alist t)) + "red"))) + (setq noun (propertize noun 'face highlight-face)) + (setq translation (propertize translation 'face highlight-face)) + (list noun noun-root noun-gender noun-hint translation))) + + +(defun org-drill-present-noun-declension () + "Present a drill entry whose card type is 'decline_noun'." + (destructuring-bind (noun noun-root noun-gender noun-hint translation) + (org-drill-get-noun-info) + (let* ((props (org-entry-properties (point))) + (definite + (cond + ((assoc "DECLINE_DEFINITE" props) + (propertize (if (org-entry-get (point) "DECLINE_DEFINITE") + "definite" "indefinite") + 'face 'warning)) + (t nil))) + (plural + (cond + ((assoc "DECLINE_PLURAL" props) + (propertize (if (org-entry-get (point) "DECLINE_PLURAL") + "plural" "singular") + 'face 'warning)) + (t nil)))) + (org-drill-present-card-using-text + (cond + ((zerop (random* 2)) + (format "\nTranslate the noun\n\n%s (%s)\n\nand list its declensions%s.\n\n" + noun noun-gender + (if (or plural definite) + (format " for the %s %s form" definite plural) + ""))) + (t + (format "\nGive the noun that means\n\n%s %s\n +and list its declensions%s.\n\n" + translation + (if noun-hint (format " [HINT: %s]" noun-hint) "") + (if (or plural definite) + (format " for the %s %s form" definite plural) + "")))))))) + + +(defun org-drill-show-answer-noun-declension (reschedule-fn) + "Show the answer for a drill item whose card type is 'decline_noun'. +RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and +returns its return value." + (destructuring-bind (noun noun-root noun-gender noun-hint translation) + (org-drill-get-noun-info) + (with-replaced-entry-heading + (format "Declensions of %s (%s) ==> %s\n\n" + noun noun-gender translation) + (org-cycle-hide-drawers 'all) (funcall reschedule-fn)))) ;;; `translate_number' card type ============================================== ;;; See spanish.org for usage -(defvar *drilled-number* 0) -(defvar *drilled-number-direction* 'to-english) + +(defun spelln-integer-in-language (n lang) + (let ((spelln-language lang)) + (spelln-integer-in-words n))) (defun org-drill-present-translate-number () (let ((num-min (read (org-entry-get (point) "DRILL_NUMBER_MIN"))) (num-max (read (org-entry-get (point) "DRILL_NUMBER_MAX"))) (language (read (org-entry-get (point) "DRILL_LANGUAGE" t))) + (drilled-number 0) + (drilled-number-direction 'to-english) (highlight-face 'font-lock-warning-face)) (cond ((not (fboundp 'spelln-integer-in-words)) @@ -2908,46 +2894,48 @@ returns its return value." (if (> num-min num-max) (psetf num-min num-max num-max num-min)) - (setq *drilled-number* + (setq drilled-number (+ num-min (random* (abs (1+ (- num-max num-min)))))) - (setq *drilled-number-direction* + (setq drilled-number-direction (if (zerop (random* 2)) 'from-english 'to-english)) - (org-drill-present-card-using-text - (if (eql 'to-english *drilled-number-direction*) - (format "\nTranslate into English:\n\n%s\n" - (let ((spelln-language language)) - (propertize - (spelln-integer-in-words *drilled-number*) - 'face highlight-face))) + (cond + ((eql 'to-english drilled-number-direction) + (org-drill-present-card-using-text + (format "\nTranslate into English:\n\n%s\n" + (propertize + (spelln-integer-in-language drilled-number language) + 'face highlight-face)) + (spelln-integer-in-language drilled-number 'english-gb))) + (t + (org-drill-present-card-using-text (format "\nTranslate into %s:\n\n%s\n" (capitalize (format "%s" language)) - (let ((spelln-language 'english-gb)) - (propertize - (spelln-integer-in-words *drilled-number*) - 'face highlight-face))))))))) + (propertize + (spelln-integer-in-language drilled-number 'english-gb) + 'face highlight-face)) + (spelln-integer-in-language drilled-number language)))))))) - -(defun org-drill-show-answer-translate-number (reschedule-fn) - (let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t))) - (highlight-face 'font-lock-warning-face) - (non-english - (let ((spelln-language language)) - (propertize (spelln-integer-in-words *drilled-number*) - 'face highlight-face))) - (english - (let ((spelln-language 'english-gb)) - (propertize (spelln-integer-in-words *drilled-number*) - 'face 'highlight-face)))) - (with-replaced-entry-text - (cond - ((eql 'to-english *drilled-number-direction*) - (format "\nThe English translation of %s is:\n\n%s\n" - non-english english)) - (t - (format "\nThe %s translation of %s is:\n\n%s\n" - (capitalize (format "%s" language)) - english non-english))) - (funcall reschedule-fn)))) +;; (defun org-drill-show-answer-translate-number (reschedule-fn) +;; (let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t))) +;; (highlight-face 'font-lock-warning-face) +;; (non-english +;; (let ((spelln-language language)) +;; (propertize (spelln-integer-in-words *drilled-number*) +;; 'face highlight-face))) +;; (english +;; (let ((spelln-language 'english-gb)) +;; (propertize (spelln-integer-in-words *drilled-number*) +;; 'face 'highlight-face)))) +;; (with-replaced-entry-text +;; (cond +;; ((eql 'to-english *drilled-number-direction*) +;; (format "\nThe English translation of %s is:\n\n%s\n" +;; non-english english)) +;; (t +;; (format "\nThe %s translation of %s is:\n\n%s\n" +;; (capitalize (format "%s" language)) +;; english non-english))) +;; (funcall reschedule-fn)))) ;;; `spanish_verb' card type ================================================== diff --git a/contrib/lisp/org-e-html.el b/contrib/lisp/org-e-html.el deleted file mode 100644 index 477bc235b..000000000 --- a/contrib/lisp/org-e-html.el +++ /dev/null @@ -1,3044 +0,0 @@ -;;; org-e-html.el --- HTML Back-End For Org Export Engine - -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. - -;; Author: Jambunathan K -;; Keywords: outlines, hypermedia, calendar, wp - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; This library implements a HTML back-end for Org generic exporter. - -;; To test it, run -;; -;; M-: (org-export-to-buffer 'e-html "*Test e-HTML*") RET -;; -;; in an org-mode buffer then switch to the buffer to see the HTML -;; export. See contrib/lisp/org-export.el for more details on how -;; this exporter works. - -;;; Code: - -;;; org-e-html.el -;;; Dependencies - -(require 'org-export) -(require 'format-spec) -(eval-when-compile (require 'cl) (require 'table)) - - - -;;; Function Declarations - -(declare-function org-id-find-id-file "org-id" (id)) -(declare-function htmlize-region "ext:htmlize" (beg end)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - - -;;; Define Back-End - -(org-export-define-backend e-html - ((bold . org-e-html-bold) - (center-block . org-e-html-center-block) - (clock . org-e-html-clock) - (code . org-e-html-code) - (drawer . org-e-html-drawer) - (dynamic-block . org-e-html-dynamic-block) - (entity . org-e-html-entity) - (example-block . org-e-html-example-block) - (export-block . org-e-html-export-block) - (export-snippet . org-e-html-export-snippet) - (fixed-width . org-e-html-fixed-width) - (footnote-definition . org-e-html-footnote-definition) - (footnote-reference . org-e-html-footnote-reference) - (headline . org-e-html-headline) - (horizontal-rule . org-e-html-horizontal-rule) - (inline-src-block . org-e-html-inline-src-block) - (inlinetask . org-e-html-inlinetask) - (italic . org-e-html-italic) - (item . org-e-html-item) - (keyword . org-e-html-keyword) - (latex-environment . org-e-html-latex-environment) - (latex-fragment . org-e-html-latex-fragment) - (line-break . org-e-html-line-break) - (link . org-e-html-link) - (macro . org-e-html-macro) - (paragraph . org-e-html-paragraph) - (plain-list . org-e-html-plain-list) - (plain-text . org-e-html-plain-text) - (planning . org-e-html-planning) - (property-drawer . org-e-html-property-drawer) - (quote-block . org-e-html-quote-block) - (quote-section . org-e-html-quote-section) - (radio-target . org-e-html-radio-target) - (section . org-e-html-section) - (special-block . org-e-html-special-block) - (src-block . org-e-html-src-block) - (statistics-cookie . org-e-html-statistics-cookie) - (strike-through . org-e-html-strike-through) - (subscript . org-e-html-subscript) - (superscript . org-e-html-superscript) - (table . org-e-html-table) - (table-cell . org-e-html-table-cell) - (table-row . org-e-html-table-row) - (target . org-e-html-target) - (template . org-e-html-template) - (timestamp . org-e-html-timestamp) - (underline . org-e-html-underline) - (verbatim . org-e-html-verbatim) - (verse-block . org-e-html-verse-block)) - :export-block "HTML" - :filters-alist ((:filter-final-output . org-e-html-final-function)) - :options-alist - ;; FIXME: Prefix KEYWORD and OPTION with "HTML_". Prefix - ;; corresponding properties with `:html-". If such a renaming is - ;; taken up, some changes will be required in `org-jsinfo.el', - ;; I think. So defer renaming for now. - ((:agenda-style nil nil org-agenda-export-html-style) - (:creator "CREATOR" nil org-e-html-creator-string) - (:convert-org-links nil nil org-e-html-link-org-files-as-html) - ;; (:expand-quoted-html nil "@" org-e-html-expand) - (:inline-images nil nil org-e-html-inline-images) - (:link-home "LINK_HOME" nil org-e-html-link-home) - (:link-up "LINK_UP" nil org-e-html-link-up) - (:style nil nil org-e-html-style) - (:style-extra "STYLE" nil org-e-html-style-extra newline) - (:style-include-default nil nil org-e-html-style-include-default) - (:style-include-scripts nil nil org-e-html-style-include-scripts) - ;; (:timestamp nil nil org-e-html-with-timestamp) - (:html-extension nil nil org-e-html-extension) - (:html-postamble nil nil org-e-html-postamble) - (:html-preamble nil nil org-e-html-preamble) - (:html-table-tag nil nil org-e-html-table-tag) - (:xml-declaration nil nil org-e-html-xml-declaration) - (:LaTeX-fragments nil "LaTeX" org-export-with-LaTeX-fragments) - (:mathjax "MATHJAX" nil "" space))) - - - -;;; Internal Variables - -;; FIXME: it already exists in org-e-html.el -(defconst org-e-html-cvt-link-fn - nil - "Function to convert link URLs to exportable URLs. -Takes two arguments, TYPE and PATH. -Returns exportable url as (TYPE PATH), or nil to signal that it -didn't handle this case. -Intended to be locally bound around a call to `org-export-as-html'." ) - -(defvar org-e-html-format-table-no-css) -(defvar htmlize-buffer-places) ; from htmlize.el -(defvar body-only) ; dynamically scoped into this. - -(defconst org-e-html-special-string-regexps - '(("\\\\-" . "­") - ("---\\([^-]\\)" . "—\\1") - ("--\\([^-]\\)" . "–\\1") - ("\\.\\.\\." . "…")) - "Regular expressions for special string conversion.") - - -(defconst org-e-html-scripts -"" -"Basic JavaScript that is needed by HTML files produced by Org-mode.") - - -(defconst org-e-html-style-default -"" - "The default style specification for exported HTML files. -Please use the variables `org-e-html-style' and -`org-e-html-style-extra' to add to this style. If you wish to not -have the default style included, customize the variable -`org-e-html-style-include-default'.") - - - -(defvar org-e-html-content-div "content" - "The name of the container DIV that holds all the page contents. - -This variable is obsolete since Org version 7.7. -Please set `org-e-html-divs' instead.") - - - -;;; User Configuration Variables - -(defgroup org-export-e-html nil - "Options for exporting Org mode files to HTML." - :tag "Org Export HTML" - :group 'org-export) - -(defgroup org-export-e-htmlize nil - "Options for processing examples with htmlize.el." - :tag "Org Export Htmlize" - :group 'org-export-e-html) - - -;;;; Bold etc - -(defcustom org-e-html-text-markup-alist - '((bold . "%s") - (code . "%s") - (italic . "%s") - (strike-through . "%s") - (underline . "%s") - (verbatim . "%s")) - "Alist of HTML expressions to convert text markup - -The key must be a symbol among `bold', `code', `italic', -`strike-through', `underline' and `verbatim'. The value is -a formatting string to wrap fontified text with. - -If no association can be found for a given markup, text will be -returned as-is." - :group 'org-export-e-html - :type '(alist :key-type (symbol :tag "Markup type") - :value-type (string :tag "Format string")) - :options '(bold code italic strike-through underline verbatim)) - - -;;;; Debugging - -(defcustom org-e-html-pretty-output nil - "Enable this to generate pretty HTML." - :group 'org-export-e-html - :type 'boolean) - - -;;;; Drawers - -(defcustom org-e-html-format-drawer-function nil - "Function called to format a drawer in HTML code. - -The function must accept two parameters: - NAME the drawer name, like \"LOGBOOK\" - CONTENTS the contents of the drawer. - -The function should return the string to be exported. - -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-e-html-format-drawer-default \(name contents\) - \"Format a drawer element for HTML export.\" - contents\)" - :group 'org-export-e-html - :type 'function) - - -;;;; Footnotes - -(defcustom org-e-html-footnotes-section "
-

%s:

-
-%s -
-
" - "Format for the footnotes section. -Should contain a two instances of %s. The first will be replaced with the -language-specific word for \"Footnotes\", the second one will be replaced -by the footnotes themselves." - :group 'org-export-e-html - :type 'string) - -(defcustom org-e-html-footnote-format "%s" - "The format for the footnote reference. -%s will be replaced by the footnote reference itself." - :group 'org-export-e-html - :type 'string) - -(defcustom org-e-html-footnote-separator ", " - "Text used to separate footnotes." - :group 'org-export-e-html - :type 'string) - - -;;;; Headline - -(defcustom org-e-html-toplevel-hlevel 2 - "The level for level 1 headings in HTML export. -This is also important for the classes that will be wrapped around headlines -and outline structure. If this variable is 1, the top-level headlines will -be

, and the corresponding classes will be outline-1, section-number-1, -and outline-text-1. If this is 2, all of these will get a 2 instead. -The default for this variable is 2, because we use

for formatting the -document title." - :group 'org-export-e-html - :type 'string) - -(defcustom org-e-html-format-headline-function nil - "Function to format headline text. - -This function will be called with 5 arguments: -TODO the todo keyword (string or nil). -TODO-TYPE the type of todo (symbol: `todo', `done', nil) -PRIORITY the priority of the headline (integer or nil) -TEXT the main headline text (string). -TAGS the tags (string or nil). - -The function result will be used in the section format string. - -As an example, one could set the variable to the following, in -order to reproduce the default set-up: - -\(defun org-e-html-format-headline \(todo todo-type priority text tags) - \"Default format function for an headline.\" - \(concat \(when todo - \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo)) - \(when priority - \(format \"\\\\framebox{\\\\#%c} \" priority)) - text - \(when tags (format \"\\\\hfill{}\\\\textsc{%s}\" tags))))" - :group 'org-export-e-html - :type 'function) - - -;;;; HTML-specific - -(defcustom org-e-html-allow-name-attribute-in-anchors t - "When nil, do not set \"name\" attribute in anchors. -By default, anchors are formatted with both \"id\" and \"name\" -attributes, when appropriate." - :group 'org-export-e-html - :type 'boolean) - - -;;;; Inlinetasks - -(defcustom org-e-html-format-inlinetask-function nil - "Function called to format an inlinetask in HTML code. - -The function must accept six parameters: - TODO the todo keyword, as a string - TODO-TYPE the todo type, a symbol among `todo', `done' and nil. - PRIORITY the inlinetask priority, as a string - NAME the inlinetask name, as a string. - TAGS the inlinetask tags, as a list of strings. - CONTENTS the contents of the inlinetask, as a string. - -The function should return the string to be exported. - -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-e-html-format-inlinetask \(todo type priority name tags contents\) -\"Format an inline task element for HTML export.\" - \(let \(\(full-title - \(concat - \(when todo - \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo)) - \(when priority (format \"\\\\framebox{\\\\#%c} \" priority)) - title - \(when tags (format \"\\\\hfill{}\\\\textsc{%s}\" tags))))) - \(format (concat \"\\\\begin{center}\\n\" - \"\\\\fbox{\\n\" - \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\" - \"%s\\n\\n\" - \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\" - \"%s\" - \"\\\\end{minipage}}\" - \"\\\\end{center}\") - full-title contents))" - :group 'org-export-e-html - :type 'function) - - -;;;; Links :: Generic - -(defcustom org-e-html-link-org-files-as-html t - "Non-nil means make file links to `file.org' point to `file.html'. -When org-mode is exporting an org-mode file to HTML, links to -non-html files are directly put into a href tag in HTML. -However, links to other Org-mode files (recognized by the -extension `.org.) should become links to the corresponding html -file, assuming that the linked org-mode file will also be -converted to HTML. -When nil, the links still point to the plain `.org' file." - :group 'org-export-e-html - :type 'boolean) - - -;;;; Links :: Inline images - -(defcustom org-e-html-inline-images 'maybe - "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." - :group 'org-export-e-html - :type '(choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "When there is no description" maybe))) - -(defcustom org-e-html-inline-image-rules - '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") - ("http" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") - ("https" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")) - "Rules characterizing image files that can be inlined into HTML. - -A rule consists in an association whose key is the type of link -to consider, and value is a regexp that will be matched against -link's path. - -Note that, by default, the image extension *actually* allowed -depend on the way the HTML file is processed. When used with -pdflatex, pdf, jpg and png images are OK. When processing -through dvi to Postscript, only ps and eps are allowed. The -default we use here encompasses both." - :group 'org-export-e-html - :type '(alist :key-type (string :tag "Type") - :value-type (regexp :tag "Path"))) - - -;;;; Plain Text - -(defcustom org-e-html-protect-char-alist - '(("&" . "&") - ("<" . "<") - (">" . ">")) - "Alist of characters to be converted by `org-e-html-protect'." - :group 'org-export-e-html - :type '(repeat (cons (string :tag "Character") - (string :tag "HTML equivalent")))) - -(defcustom org-e-html-quotes - '(("fr" - ("\\(\\s-\\|[[(]\\|^\\)\"" . "« ") - ("\\(\\S-\\)\"" . " »") - ("\\(\\s-\\|(\\|^\\)'" . "’")) - ("en" - ("\\(\\s-\\|[[(]\\|^\\)\"" . "“") - ("\\(\\S-\\)\"" . "”") - ("\\(\\s-\\|(\\|^\\)'" . "‘"))) - "Alist for quotes to use when converting english double-quotes. - -The CAR of each item in this alist is the language code. -The CDR of each item in this alist is a list of three CONS: -- the first CONS defines the opening quote; -- the second CONS defines the closing quote; -- the last CONS defines single quotes. - -For each item in a CONS, the first string is a regexp -for allowed characters before/after the quote, the second -string defines the replacement string for this quote." - :group 'org-export-e-html - :type '(list - (cons :tag "Opening quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")) - (cons :tag "Closing quote" - (string :tag "Regexp for char after ") - (string :tag "Replacement quote ")) - (cons :tag "Single quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")))) - - -;;;; Src Block - -(defcustom org-export-e-htmlize-output-type 'inline-css - "Output type to be used by htmlize when formatting code snippets. -Choices are `css', to export the CSS selectors only, or `inline-css', to -export the CSS attribute values inline in the HTML. We use as default -`inline-css', in order to make the resulting HTML self-containing. - -However, this will fail when using Emacs in batch mode for export, because -then no rich font definitions are in place. It will also not be good if -people with different Emacs setup contribute HTML files to a website, -because the fonts will represent the individual setups. In these cases, -it is much better to let Org/Htmlize assign classes only, and to use -a style file to define the look of these classes. -To get a start for your css file, start Emacs session and make sure that -all the faces you are interested in are defined, for example by loading files -in all modes you want. Then, use the command -\\[org-export-e-htmlize-generate-css] to extract class definitions." - :group 'org-export-e-htmlize - :type '(choice (const css) (const inline-css))) - -(defcustom org-export-e-htmlize-css-font-prefix "org-" - "The prefix for CSS class names for htmlize font specifications." - :group 'org-export-e-htmlize - :type 'string) - -(defcustom org-export-e-htmlized-org-css-url nil - "URL pointing to a CSS file defining text colors for htmlized Emacs buffers. -Normally when creating an htmlized version of an Org buffer, htmlize will -create CSS to define the font colors. However, this does not work when -converting in batch mode, and it also can look bad if different people -with different fontification setup work on the same website. -When this variable is non-nil, creating an htmlized version of an Org buffer -using `org-export-as-org' will remove the internal CSS section and replace it -with a link to this URL." - :group 'org-export-e-htmlize - :type '(choice - (const :tag "Keep internal css" nil) - (string :tag "URL or local href"))) - - -;;;; Table - -(defcustom org-e-html-table-tag - "" - "The HTML tag that is used to start a table. -This must be a
tag, but you may change the options like -borders and spacing." - :group 'org-export-e-html - :type 'string) - -(defcustom org-e-html-table-header-tags '("") - "The opening tag for table header fields. -This is customizable so that alignment options can be specified. -The first %s will be filled with the scope of the field, either row or col. -The second %s will be replaced by a style entry to align the field. -See also the variable `org-e-html-table-use-header-tags-for-first-column'. -See also the variable `org-e-html-table-align-individual-fields'." - :group 'org-export-tables ; FIXME: change group? - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-e-html-table-data-tags '("" . "") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified. -The first %s will be filled with the scope of the field, either row or col. -The second %s will be replaced by a style entry to align the field. -See also the variable `org-e-html-table-align-individual-fields'." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-e-html-table-row-tags '("" . "") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified. -Instead of strings, these can be Lisp forms that will be evaluated -for each row in order to construct the table row tags. During evaluation, -the variable `head' will be true when this is a header line, nil when this -is a body line. And the variable `nline' will contain the line number, -starting from 1 in the first header line. For example - - (setq org-e-html-table-row-tags - (cons '(if head - \"\" - (if (= (mod nline 2) 1) - \"\" - \"\")) - \"\")) - -will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"." - :group 'org-export-tables - :type '(cons - (choice :tag "Opening tag" - (string :tag "Specify") - (sexp)) - (choice :tag "Closing tag" - (string :tag "Specify") - (sexp)))) - -(defcustom org-e-html-table-align-individual-fields t - "Non-nil means attach style attributes for alignment to each table field. -When nil, alignment will only be specified in the column tags, but this -is ignored by some browsers (like Firefox, Safari). Opera does it right -though." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-e-html-table-use-header-tags-for-first-column nil - "Non-nil means format column one in tables with header tags. -When nil, also column one will use data tags." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-e-html-table-caption-above t - "When non-nil, place caption string at the beginning of the table. -Otherwise, place it near the end." - :group 'org-export-e-html - :type 'boolean) - - -;;;; Tags - -(defcustom org-e-html-tag-class-prefix "" - "Prefix to class names for TODO keywords. -Each tag gets a class given by the tag itself, with this prefix. -The default prefix is empty because it is nice to just use the keyword -as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefix can be very useful." - :group 'org-export-e-html - :type 'string) - - -;;;; Template :: Generic - -(defcustom org-e-html-extension "html" - "The extension for exported HTML files." - :group 'org-export-e-html - :type 'string) - -(defcustom org-e-html-xml-declaration - '(("html" . "") - ("php" . "\"; ?>")) - "The extension for exported HTML files. -%s will be replaced with the charset of the exported file. -This may be a string, or an alist with export extensions -and corresponding declarations." - :group 'org-export-e-html - :type '(choice - (string :tag "Single declaration") - (repeat :tag "Dependent on extension" - (cons (string :tag "Extension") - (string :tag "Declaration"))))) - -(defcustom org-e-html-coding-system 'utf-8 - "Coding system for HTML export. -Use utf-8 as the default value." - :group 'org-export-e-html - :type 'coding-system) - -(defcustom org-e-html-divs '("preamble" "content" "postamble") - "The name of the main divs for HTML export. -This is a list of three strings, the first one for the preamble -DIV, the second one for the content DIV and the third one for the -postamble DIV." - :group 'org-export-e-html - :type '(list - (string :tag " Div for the preamble:") - (string :tag " Div for the content:") - (string :tag "Div for the postamble:"))) - - -;;;; Template :: Mathjax - -(defcustom org-e-html-mathjax-options - '((path "http://orgmode.org/mathjax/MathJax.js") - (scale "100") - (align "center") - (indent "2em") - (mathml nil)) - "Options for MathJax setup. - -path The path where to find MathJax -scale Scaling for the HTML-CSS backend, usually between 100 and 133 -align How to align display math: left, center, or right -indent If align is not center, how far from the left/right side? -mathml Should a MathML player be used if available? - This is faster and reduces bandwidth use, but currently - sometimes has lower spacing quality. Therefore, the default is - nil. When browsers get better, this switch can be flipped. - -You can also customize this for each buffer, using something like - -#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\"" - :group 'org-export-e-html - :type '(list :greedy t - (list :tag "path (the path from where to load MathJax.js)" - (const :format " " path) (string)) - (list :tag "scale (scaling for the displayed math)" - (const :format " " scale) (string)) - (list :tag "align (alignment of displayed equations)" - (const :format " " align) (string)) - (list :tag "indent (indentation with left or right alignment)" - (const :format " " indent) (string)) - (list :tag "mathml (should MathML display be used is possible)" - (const :format " " mathml) (boolean)))) - -(defcustom org-e-html-mathjax-template - "" - "The MathJax setup for XHTML files." - :group 'org-export-e-html - :type 'string) - - -;;;; Template :: Postamble - -(defcustom org-e-html-postamble 'auto - "Non-nil means insert a postamble in HTML export. - -When `t', insert a string as defined by the formatting string in -`org-e-html-postamble-format'. When set to a string, this -string overrides `org-e-html-postamble-format'. When set to -'auto, discard `org-e-html-postamble-format' and honor -`org-export-author/email/creator-info' variables. When set to a -function, apply this function and insert the returned string. -The function takes the property list of export options as its -only argument. - -Setting :html-postamble in publishing projects will take -precedence over this variable." - :group 'org-export-e-html - :type '(choice (const :tag "No postamble" nil) - (const :tag "Auto preamble" 'auto) - (const :tag "Default formatting string" t) - (string :tag "Custom formatting string") - (function :tag "Function (must return a string)"))) - -(defcustom org-e-html-postamble-format - '(("en" "

Author: %a (%e)

-

Date: %d

-

Generated by %c

-

%v

-")) - "The format for the HTML postamble. - -%a stands for the author's name. -%e stands for the author's email. -%d stands for the date. -%c will be replaced by information about Org/Emacs versions. -%v will be replaced by `org-e-html-validation-link'. - -If you need to use a \"%\" character, you need to escape it -like that: \"%%\"." - :group 'org-export-e-html - :type 'string) - -(defcustom org-e-html-validation-link - "Validate XHTML 1.0" - "Link to HTML validation service." - :group 'org-export-e-html - :type 'string) - -(defcustom org-e-html-creator-string - (format "Generated by Org mode %s in Emacs %s." - (if (fboundp 'org-version) (org-version) "(Unknown)") - emacs-version) - "String to insert at the end of the HTML document." - :group 'org-export-e-html - :type '(string :tag "Creator string")) - - -;;;; Template :: Preamble - -(defcustom org-e-html-preamble t - "Non-nil means insert a preamble in HTML export. - -When `t', insert a string as defined by one of the formatting -strings in `org-e-html-preamble-format'. When set to a -string, this string overrides `org-e-html-preamble-format'. -When set to a function, apply this function and insert the -returned string. The function takes the property list of export -options as its only argument. - -Setting :html-preamble in publishing projects will take -precedence over this variable." - :group 'org-export-e-html - :type '(choice (const :tag "No preamble" nil) - (const :tag "Default preamble" t) - (string :tag "Custom formatting string") - (function :tag "Function (must return a string)"))) - -(defcustom org-e-html-preamble-format '(("en" "")) - "The format for the HTML preamble. - -%t stands for the title. -%a stands for the author's name. -%e stands for the author's email. -%d stands for the date. - -If you need to use a \"%\" character, you need to escape it -like that: \"%%\"." - :group 'org-export-e-html - :type 'string) - -(defcustom org-e-html-link-up "" - "Where should the \"UP\" link of exported HTML pages lead?" - :group 'org-export-e-html - :type '(string :tag "File or URL")) - -(defcustom org-e-html-link-home "" - "Where should the \"HOME\" link of exported HTML pages lead?" - :group 'org-export-e-html - :type '(string :tag "File or URL")) - -(defcustom org-e-html-home/up-format - "
- UP - | - HOME -
" - "Snippet used to insert the HOME and UP links. -This is a format string, the first %s will receive the UP link, -the second the HOME link. If both `org-e-html-link-up' and -`org-e-html-link-home' are empty, the entire snippet will be -ignored." - :group 'org-export-e-html - :type 'string) - - -;;;; Template :: Scripts - -(defcustom org-e-html-style-include-scripts t - "Non-nil means include the JavaScript snippets in exported HTML files. -The actual script is defined in `org-e-html-scripts' and should -not be modified." - :group 'org-export-e-html - :type 'boolean) - - -;;;; Template :: Styles - -(defcustom org-e-html-style-include-default t - "Non-nil means include the default style in exported HTML files. -The actual style is defined in `org-e-html-style-default' and should -not be modified. Use the variables `org-e-html-style' to add -your own style information." - :group 'org-export-e-html - :type 'boolean) -;;;###autoload -(put 'org-e-html-style-include-default 'safe-local-variable 'booleanp) - -(defcustom org-e-html-style "" - "Org-wide style definitions for exported HTML files. - -This variable needs to contain the full HTML structure to provide a style, -including the surrounding HTML tags. If you set the value of this variable, -you should consider to include definitions for the following classes: - title, todo, done, timestamp, timestamp-kwd, tag, target. - -For example, a valid value would be: - - - -If you'd like to refer to an external style file, use something like - - - -As the value of this option simply gets inserted into the HTML header, -you can \"misuse\" it to add arbitrary text to the header. -See also the variable `org-e-html-style-extra'." - :group 'org-export-e-html - :type 'string) -;;;###autoload -(put 'org-e-html-style 'safe-local-variable 'stringp) - -(defcustom org-e-html-style-extra "" - "Additional style information for HTML export. -The value of this variable is inserted into the HTML buffer right after -the value of `org-e-html-style'. Use this variable for per-file -settings of style information, and do not forget to surround the style -settings with tags." - :group 'org-export-e-html - :type 'string) -;;;###autoload -(put 'org-e-html-style-extra 'safe-local-variable 'stringp) - - -;;;; Todos - -(defcustom org-e-html-todo-kwd-class-prefix "" - "Prefix to class names for TODO keywords. -Each TODO keyword gets a class given by the keyword itself, with this prefix. -The default prefix is empty because it is nice to just use the keyword -as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefix can be very useful." - :group 'org-export-e-html - :type 'string) - - - -;;; Internal Functions - -(defun org-e-html-format-inline-image (src &optional - caption label attr standalone-p) - (let* ((id (if (not label) "" - (format " id=\"%s\"" (org-export-solidify-link-text label)))) - (attr (concat attr - (cond - ((string-match "\\" src attr))) - (format "\n%s%s\n" - id (format "\n

%s

" img) - (when caption (format "\n

%s

" caption))))) - (t (format "" src (concat attr id)))))) - -;;;; Bibliography - -(defun org-e-html-bibliography () - "Find bibliography, cut it out and return it." - (catch 'exit - (let (beg end (cnt 1) bib) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward - "^[ \t]*
" nil t) - (setq cnt (+ cnt (if (string= (match-string 0) "") (forward-char 1)) - (setq bib (buffer-substring beg (point))) - (delete-region beg (point)) - (throw 'exit bib)))) - nil)))) - -;;;; Table - -(defun org-e-html-splice-attributes (tag attributes) - "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG." - (if (not attributes) - tag - (let (oldatt newatt) - (setq oldatt (org-extract-attributes-from-string tag) - tag (pop oldatt) - newatt (cdr (org-extract-attributes-from-string attributes))) - (while newatt - (setq oldatt (plist-put oldatt (pop newatt) (pop newatt)))) - (if (string-match ">" tag) - (setq tag - (replace-match (concat (org-attributes-to-string oldatt) ">") - t t tag))) - tag))) - -(defun org-export-splice-style (style extra) - "Splice EXTRA into STYLE, just before \"\"." - (if (and (stringp extra) - (string-match "\\S-" extra) - (string-match "" style)) - (concat (substring style 0 (match-beginning 0)) - "\n" extra "\n" - (substring style (match-beginning 0))) - style)) - -(defun org-export-e-htmlize-region-for-paste (beg end) - "Convert the region to HTML, using htmlize.el. -This is much like `htmlize-region-for-paste', only that it uses -the settings define in the org-... variables." - (let* ((htmlize-output-type org-export-e-htmlize-output-type) - (htmlize-css-name-prefix org-export-e-htmlize-css-font-prefix) - (htmlbuf (htmlize-region beg end))) - (unwind-protect - (with-current-buffer htmlbuf - (buffer-substring (plist-get htmlize-buffer-places 'content-start) - (plist-get htmlize-buffer-places 'content-end))) - (kill-buffer htmlbuf)))) - -;;;###autoload -(defun org-export-e-htmlize-generate-css () - "Create the CSS for all font definitions in the current Emacs session. -Use this to create face definitions in your CSS style file that can then -be used by code snippets transformed by htmlize. -This command just produces a buffer that contains class definitions for all -faces used in the current Emacs session. You can copy and paste the ones you -need into your CSS file. - -If you then set `org-export-e-htmlize-output-type' to `css', calls to -the function `org-export-e-htmlize-region-for-paste' will produce code -that uses these same face definitions." - (interactive) - (require 'htmlize) - (and (get-buffer "*html*") (kill-buffer "*html*")) - (with-temp-buffer - (let ((fl (face-list)) - (htmlize-css-name-prefix "org-") - (htmlize-output-type 'css) - f i) - (while (setq f (pop fl) - i (and f (face-attribute f :inherit))) - (when (and (symbolp f) (or (not i) (not (listp i)))) - (insert (org-add-props (copy-sequence "1") nil 'face f)))) - (htmlize-region (point-min) (point-max)))) - (org-pop-to-buffer-same-window "*html*") - (goto-char (point-min)) - (if (re-search-forward "" nil t) - (delete-region (1+ (match-end 0)) (point-max))) - (beginning-of-line 1) - (if (looking-at " +") (replace-match "")) - (goto-char (point-min))) - -(defun org-e-html-make-string (n string) - (let (out) (dotimes (i n out) (setq out (concat string out))))) - -(defun org-e-html-toc-text (toc-entries) - (let* ((prev-level (1- (nth 1 (car toc-entries)))) - (start-level prev-level)) - (concat - (mapconcat - (lambda (entry) - (let ((headline (nth 0 entry)) - (level (nth 1 entry))) - (concat - (let* ((cnt (- level prev-level)) - (times (if (> cnt 0) (1- cnt) (- cnt))) - rtn) - (setq prev-level level) - (concat - (org-e-html-make-string - times (cond ((> cnt 0) "\n
    \n
  • ") - ((< cnt 0) "
  • \n
\n"))) - (if (> cnt 0) "\n
    \n
  • " "
  • \n
  • "))) - headline))) - toc-entries "") - (org-e-html-make-string - (- prev-level start-level) "
  • \n
\n")))) - -(defun* org-e-html-format-toc-headline - (todo todo-type priority text tags - &key level section-number headline-label &allow-other-keys) - (let ((headline (concat - section-number (and section-number ". ") - text - (and tags "   ") (org-e-html--tags tags)))) - (format "%s" - (org-export-solidify-link-text headline-label) - (if (not nil) headline - (format "%s" todo-type headline))))) - -(defun org-e-html-toc (depth info) - (let* ((headlines (org-export-collect-headlines info depth)) - (toc-entries - (loop for headline in headlines collect - (list (org-e-html-format-headline--wrap - headline info 'org-e-html-format-toc-headline) - (org-export-get-relative-level headline info))))) - (when toc-entries - (concat - "
\n" - (format "%s\n" - org-e-html-toplevel-hlevel - (org-e-html--translate "Table of Contents" info) - org-e-html-toplevel-hlevel) - "
" - (org-e-html-toc-text toc-entries) - "
\n" - "
\n")))) - -(defun org-e-html-fix-class-name (kwd) ; audit callers of this function - "Turn todo keyword into a valid class name. -Replaces invalid characters with \"_\"." - (save-match-data - (while (string-match "[^a-zA-Z0-9_]" kwd) - (setq kwd (replace-match "_" t t kwd)))) - kwd) - -(defun org-e-html-format-footnote-reference (n def refcnt) - (let ((extra (if (= refcnt 1) "" (format ".%d" refcnt)))) - (format org-e-html-footnote-format - (let* ((id (format "fnr.%s%s" n extra)) - (href (format " href=\"#fn.%s\"" n)) - (attributes (concat " class=\"footref\"" href))) - (org-e-html--anchor id n attributes))))) - -(defun org-e-html-format-footnotes-section (section-name definitions) - (if (not definitions) "" - (format org-e-html-footnotes-section section-name definitions))) - -(defun org-e-html-format-footnote-definition (fn) - (let ((n (car fn)) (def (cdr fn))) - (format - "
\n\n\n\n" - (format org-e-html-footnote-format - (let* ((id (format "fn.%s" n)) - (href (format " href=\"#fnr.%s\"" n)) - (attributes (concat " class=\"footnum\"" href))) - (org-e-html--anchor id n attributes))) - def))) - -(defun org-e-html-footnote-section (info) - (let* ((fn-alist (org-export-collect-footnote-definitions - (plist-get info :parse-tree) info)) - - (fn-alist - (loop for (n type raw) in fn-alist collect - (cons n (if (eq (org-element-type raw) 'org-data) - (org-trim (org-export-data raw info)) - (format "

%s

" - (org-trim (org-export-data raw info)))))))) - (when fn-alist - (org-e-html-format-footnotes-section - (org-e-html--translate "Footnotes" info) - (format - "
" . "
%s%s
\n%s\n
\n" - (mapconcat 'org-e-html-format-footnote-definition fn-alist "\n")))))) - -(defun org-e-html-format-date (info) - (let ((date (org-export-data (plist-get info :date) info))) - (cond - ((and date (string-match "%" date)) - (format-time-string date)) - (date date) - (t (format-time-string "%Y-%m-%d %T %Z"))))) - -(defun org-e-html--caption/label-string (caption label info) - "Return caption and label HTML string for floats. - -CAPTION is a cons cell of secondary strings, the car being the -standard caption and the cdr its short form. LABEL is a string -representing the label. INFO is a plist holding contextual -information. - -If there's no caption nor label, return the empty string. - -For non-floats, see `org-e-html--wrap-label'." - (setq label nil) ;; FIXME - - (let ((label-str (if label (format "\\label{%s}" label) ""))) - (cond - ((and (not caption) (not label)) "") - ((not caption) (format "\\label{%s}\n" label)) - ;; Option caption format with short name. - ((cdr caption) - (format "\\caption[%s]{%s%s}\n" - (org-export-data (cdr caption) info) - label-str - (org-export-data (car caption) info))) - ;; Standard caption format. - ;; (t (format "\\caption{%s%s}\n" - ;; label-str - ;; (org-export-data (car caption) info))) - (t (org-export-data (car caption) info))))) - -(defun org-e-html--find-verb-separator (s) - "Return a character not used in string S. -This is used to choose a separator for constructs like \\verb." - (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) - (loop for c across ll - when (not (string-match (regexp-quote (char-to-string c)) s)) - return (char-to-string c)))) - -(defun org-e-html--quotation-marks (text info) - "Export quotation marks depending on language conventions. -TEXT is a string containing quotation marks to be replaced. INFO -is a plist used as a communication channel." - (mapc (lambda(l) - (let ((start 0)) - (while (setq start (string-match (car l) text start)) - (let ((new-quote (concat (match-string 1 text) (cdr l)))) - (setq text (replace-match new-quote t t text)))))) - (cdr (or (assoc (plist-get info :language) org-e-html-quotes) - ;; Falls back on English. - (assoc "en" org-e-html-quotes)))) - text) - -(defun org-e-html--wrap-label (element output) - "Wrap label associated to ELEMENT around OUTPUT, if appropriate. -This function shouldn't be used for floats. See -`org-e-html--caption/label-string'." - ;; (let ((label (org-element-property :name element))) - ;; (if (or (not output) (not label) (string= output "") (string= label "")) - ;; output - ;; (concat (format "\\label{%s}\n" label) output))) - output) - - - -;;; Template - -(defun org-e-html-meta-info (info) - (let* ((title (org-export-data (plist-get info :title) info)) - (author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth (org-export-data auth info))))) - (description (plist-get info :description)) - (keywords (plist-get info :keywords))) - (concat - (format "\n%s\n" title) - (format - "\n" - (or (and org-e-html-coding-system - (fboundp 'coding-system-get) - (coding-system-get org-e-html-coding-system - 'mime-charset)) - "iso-8859-1")) - (format "\n" title) - (format "\n") - (format "\n" - (org-e-html-format-date info)) - (format "\n" author) - (format "\n" description) - (format "\n" keywords)))) - -(defun org-e-html-style (info) - (concat - "\n" (when (plist-get info :style-include-default) org-e-html-style-default) - (plist-get info :style) - (plist-get info :style-extra) - "\n" - (when (plist-get info :style-include-scripts) - org-e-html-scripts))) - -(defun org-e-html-mathjax-config (info) - "Insert the user setup into the matchjax template." - (when (member (plist-get info :LaTeX-fragments) '(mathjax t)) - (let ((template org-e-html-mathjax-template) - (options org-e-html-mathjax-options) - (in-buffer (or (plist-get info :mathjax) "")) - name val (yes " ") (no "// ") x) - (mapc - (lambda (e) - (setq name (car e) val (nth 1 e)) - (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer) - (setq val (car (read-from-string - (substring in-buffer (match-end 0)))))) - (if (not (stringp val)) (setq val (format "%s" val))) - (if (string-match (concat "%" (upcase (symbol-name name))) template) - (setq template (replace-match val t t template)))) - options) - (setq val (nth 1 (assq 'mathml options))) - (if (string-match (concat "\\ " (nth 0 org-e-html-divs)) - " -" - html-pre-real-contents - " -"))))) - -(defun org-e-html-postamble (info) - (concat - (when (and (not body-only) - (plist-get info :html-postamble)) - (let* ((html-post (plist-get info :html-postamble)) - (date (org-e-html-format-date info)) - (author (let ((author (plist-get info :author))) - (and author (org-export-data author info)))) - (email - (mapconcat (lambda(e) - (format "%s" e e)) - (split-string (plist-get info :email) ",+ *") - ", ")) - (html-validation-link (or org-e-html-validation-link "")) - (creator-info org-export-creator-string)) - (concat - ;; begin postamble - " -
" - (cond - ;; auto postamble - ((eq (plist-get info :html-postamble) 'auto) - (concat - (when (plist-get info :time-stamp-file) - (format " -

%s: %s

" (org-e-html--translate "Date" info) date)) - (when (and (plist-get info :with-author) author) - (format " -

%s : %s

" (org-e-html--translate "Author" info) author)) - (when (and (plist-get info :with-email) email) - (format " -

%s

" email)) - (when (plist-get info :with-creator) - (format " -

%s

" creator-info)) - html-validation-link "\n")) - ;; postamble from a string - ((stringp (plist-get info :html-postamble)) - (format-spec (plist-get info :html-postamble) - `((?a . ,author) (?e . ,email) - (?d . ,date) (?c . ,creator-info) - (?v . ,html-validation-link)))) - - ;; postamble from a function - ((functionp (plist-get info :html-postamble)) - (with-temp-buffer - (funcall (plist-get info :html-postamble)) - (buffer-string))) - ;; default postamble - (t - (format-spec - (or (cadr (assoc (plist-get info :language) - org-e-html-postamble-format)) - (cadr (assoc "en" org-e-html-postamble-format))) - `((?a . ,author) (?e . ,email) - (?d . ,date) (?c . ,creator-info) - (?v . ,html-validation-link))))) - " -
"))) - ;; org-e-html-html-helper-timestamp - )) - -(defun org-e-html-template (contents info) - "Return complete document string after HTML conversion. -CONTENTS is the transcoded contents string. RAW-DATA is the -original parsed data. INFO is a plist holding export options." - (concat - (format - (or (and (stringp org-e-html-xml-declaration) - org-e-html-xml-declaration) - (cdr (assoc (plist-get info :html-extension) - org-e-html-xml-declaration)) - (cdr (assoc "html" org-e-html-xml-declaration)) - - "") - (or (and org-e-html-coding-system - (fboundp 'coding-system-get) - (coding-system-get org-e-html-coding-system - 'mime-charset)) - "iso-8859-1")) - " -" - (format " - " - (plist-get info :language) (plist-get info :language)) - " -" - (org-e-html-meta-info info) ; meta - (org-e-html-style info) ; style - (org-e-html-mathjax-config info) ; mathjax - " -" - - " -" - (let ((link-up (org-trim (plist-get info :link-up))) - (link-home (org-trim (plist-get info :link-home)))) - (unless (and (string= link-up "") (string= link-up "")) - (format org-e-html-home/up-format - (or link-up link-home) - (or link-home link-up)))) - ;; preamble - (org-e-html-preamble info) - ;; begin content - (format " -
" (or org-e-html-content-div - (nth 1 org-e-html-divs))) - ;; document title - (format " -

%s

\n" (org-export-data (plist-get info :title) info)) - ;; table of contents - (let ((depth (plist-get info :with-toc))) - (when depth (org-e-html-toc depth info))) - ;; document contents - contents - ;; footnotes section - (org-e-html-footnote-section info) - ;; bibliography - (org-e-html-bibliography) - ;; end content - (unless body-only - " -
") - - ;; postamble - (org-e-html-postamble info) - - (unless body-only - " -") - " -")) - -(defun org-e-html--translate (s info) - "Transcode string S in to HTML. -INFO is a plist used as a communication channel. - -Lookup utf-8 equivalent of S in `org-export-dictionary' and -replace all non-ascii characters with its numeric reference." - (let ((s (org-export-translate s :utf-8 info))) - ;; Protect HTML metacharacters. - (setq s (org-e-html-encode-plain-text s)) - ;; Replace non-ascii characters with their numeric equivalents. - (replace-regexp-in-string - "[[:nonascii:]]" - (lambda (m) (format "&#%d;" (encode-char (string-to-char m) 'ucs))) - s t t))) - -;;;; Anchor - -(defun org-e-html--anchor (&optional id desc attributes) - (let* ((name (and org-e-html-allow-name-attribute-in-anchors id)) - (attributes (concat (and id (format " id=\"%s\"" id)) - (and name (format " name=\"%s\"" name)) - attributes))) - (format "%s" attributes (or desc "")))) - -;;;; Todo - -(defun org-e-html--todo (todo) - (when todo - (format "%s" - (if (member todo org-done-keywords) "done" "todo") - org-e-html-todo-kwd-class-prefix (org-e-html-fix-class-name todo) - todo))) - -;;;; Tags - -(defun org-e-html--tags (tags) - (when tags - (format "%s" - (mapconcat - (lambda (tag) - (format "%s" - (concat org-e-html-tag-class-prefix - (org-e-html-fix-class-name tag)) - tag)) - tags " ")))) - -;;;; Headline - -(defun* org-e-html-format-headline - (todo todo-type priority text tags - &key level section-number headline-label &allow-other-keys) - (let ((section-number - (when section-number - (format "%s " - level section-number))) - (todo (org-e-html--todo todo)) - (tags (org-e-html--tags tags))) - (concat section-number todo (and todo " ") text - (and tags "   ") tags))) - -;;;; Src Code - -(defun org-e-html-fontify-code (code lang) - (when code - (cond - ;; Case 1: No lang. Possibly an example block. - ((not lang) - ;; Simple transcoding. - (org-e-html-encode-plain-text code)) - ;; Case 2: No htmlize or an inferior version of htmlize - ((not (and (require 'htmlize nil t) (fboundp 'htmlize-region-for-paste))) - ;; Emit a warning. - (message "Cannot fontify src block (htmlize.el >= 1.34 required)") - ;; Simple transcoding. - (org-e-html-encode-plain-text code)) - (t - ;; Map language - (setq lang (or (assoc-default lang org-src-lang-modes) lang)) - (let* ((lang-mode (and lang (intern (format "%s-mode" lang))))) - (cond - ;; Case 1: Language is not associated with any Emacs mode - ((not (functionp lang-mode)) - ;; Simple transcoding. - (org-e-html-encode-plain-text code)) - ;; Case 2: Default. Fontify code. - (t - ;; htmlize - (setq code (with-temp-buffer - (insert code) - ;; Switch to language-specific mode. - (funcall lang-mode) - ;; Fontify buffer. - (font-lock-fontify-buffer) - ;; Remove formatting on newline characters. - (save-excursion - (let ((beg (point-min)) - (end (point-max))) - (goto-char beg) - (while (progn (end-of-line) (< (point) end)) - (put-text-property (point) (1+ (point)) 'face nil) - (forward-char 1)))) - (org-src-mode) - (set-buffer-modified-p nil) - ;; Htmlize region. - (org-export-e-htmlize-region-for-paste - (point-min) (point-max)))) - ;; Strip any encolosing
 tags.
-	  (if (string-match "]*>\n*\\([^\000]*\\)

" code) - (match-string 1 code) - code)))))))) - -(defun org-e-html-do-format-code - (code &optional lang refs retain-labels num-start textarea-p) - (when textarea-p - (setq num-start nil refs nil lang nil)) - (let* ((code-lines (org-split-string code "\n")) - (code-length (length code-lines)) - (num-fmt - (and num-start - (format "%%%ds: " - (length (number-to-string (+ code-length num-start)))))) - (code (org-e-html-fontify-code code lang))) - (assert (= code-length (length (org-split-string code "\n")))) - (org-export-format-code - code - (lambda (loc line-num ref) - (setq loc - (concat - ;; Add line number, if needed. - (when num-start - (format "%s" - (format num-fmt line-num))) - ;; Transcoded src line. - loc - ;; Add label, if needed. - (when (and ref retain-labels) (format " (%s)" ref)))) - ;; Mark transcoded line as an anchor, if needed. - (if (not ref) loc - (format "%s" - ref loc))) - num-start refs))) - -(defun org-e-html-format-code (element info) - (let* ((lang (org-element-property :language element)) - ;; (switches (org-element-property :switches element)) - (switches nil) ; FIXME - (textarea-p (and switches (string-match "-t\\>" switches))) - ;; Extract code and references. - (code-info (org-export-unravel-code element)) - (code (car code-info)) - (refs (cdr code-info)) - ;; Does the src block contain labels? - (retain-labels (org-element-property :retain-labels element)) - ;; Does it have line numbers? - (num-start (case (org-element-property :number-lines element) - (continued (org-export-get-loc element info)) - (new 0)))) - (org-e-html-do-format-code - code lang refs retain-labels num-start textarea-p))) - - - -;;; Transcode Functions - -;;;; Bold - -(defun org-e-html-bold (bold contents info) - "Transcode BOLD from Org to HTML. -CONTENTS is the text with bold markup. INFO is a plist holding -contextual information." - (format (or (cdr (assq 'bold org-e-html-text-markup-alist)) "%s") - contents)) - - -;;;; Center Block - -(defun org-e-html-center-block (center-block contents info) - "Transcode a CENTER-BLOCK element from Org to HTML. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (org-e-html--wrap-label - center-block - (format "
\n%s
" contents))) - - -;;;; Clock - -(defun org-e-html-clock (clock contents info) - "Transcode a CLOCK element from Org to HTML. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (format "

- -%s %s%s - -

" - org-clock-string - (org-translate-time (org-element-property :value clock)) - (let ((time (org-element-property :time clock))) - (and time (format " (%s)" time))))) - - -;;;; Code - -(defun org-e-html-code (code contents info) - "Transcode CODE from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual -information." - (format (or (cdr (assq 'code org-e-html-text-markup-alist)) "%s") - (org-element-property :value code))) - - -;;;; Comment - -;; Comments are ignored. - - -;;;; Comment Block - -;; Comment Blocks are ignored. - - -;;;; Drawer - -(defun org-e-html-drawer (drawer contents info) - "Transcode a DRAWER element from Org to HTML. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let* ((name (org-element-property :drawer-name drawer)) - (output (if (functionp org-e-html-format-drawer-function) - (funcall org-e-html-format-drawer-function - name contents) - ;; If there's no user defined function: simply - ;; display contents of the drawer. - contents))) - (org-e-html--wrap-label drawer output))) - - -;;;; Dynamic Block - -(defun org-e-html-dynamic-block (dynamic-block contents info) - "Transcode a DYNAMIC-BLOCK element from Org to HTML. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information. See `org-export-data'." - (org-e-html--wrap-label dynamic-block contents)) - - -;;;; Entity - -(defun org-e-html-entity (entity contents info) - "Transcode an ENTITY object from Org to HTML. -CONTENTS are the definition itself. INFO is a plist holding -contextual information." - (org-element-property :html entity)) - - -;;;; Example Block - -(defun org-e-html-example-block (example-block contents info) - "Transcode a EXAMPLE-BLOCK element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (let* ((options (or (org-element-property :options example-block) "")) - (lang (org-element-property :language example-block)) - (caption (org-element-property :caption example-block)) - (label (org-element-property :name example-block)) - (caption-str (org-e-html--caption/label-string caption label info)) - (attr (mapconcat #'identity - (org-element-property :attr_html example-block) - " ")) - ;; (switches (org-element-property :switches example-block)) - (switches nil) ; FIXME - (textarea-p (and switches (string-match "-t\\>" switches))) - (code (org-e-html-format-code example-block info))) - (cond - (textarea-p - (let ((cols (if (not (string-match "-w[ \t]+\\([0-9]+\\)" switches)) - 80 (string-to-number (match-string 1 switches)))) - (rows (if (string-match "-h[ \t]+\\([0-9]+\\)" switches) - (string-to-number (match-string 1 switches)) - (org-count-lines code)))) - (format - "

\n\n

" - cols rows code))) - (t (format "
\n%s
" code))))) - - -;;;; Export Snippet - -(defun org-e-html-export-snippet (export-snippet contents info) - "Transcode a EXPORT-SNIPPET object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (eq (org-export-snippet-backend export-snippet) 'e-html) - (org-element-property :value export-snippet))) - - -;;;; Export Block - -(defun org-e-html-export-block (export-block contents info) - "Transcode a EXPORT-BLOCK element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (string= (org-element-property :type export-block) "HTML") - (org-remove-indentation (org-element-property :value export-block)))) - - -;;;; Fixed Width - -(defun org-e-html-fixed-width (fixed-width contents info) - "Transcode a FIXED-WIDTH element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-html--wrap-label - fixed-width - (format "
\n%s
" - (org-e-html-do-format-code - (org-remove-indentation - (org-element-property :value fixed-width)))))) - - -;;;; Footnote Definition - -;; Footnote Definitions are ignored. - - -;;;; Footnote Reference - -(defun org-e-html-footnote-reference (footnote-reference contents info) - "Transcode a FOOTNOTE-REFERENCE element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (concat - ;; Insert separator between two footnotes in a row. - (let ((prev (org-export-get-previous-element footnote-reference info))) - (when (eq (org-element-type prev) 'footnote-reference) - org-e-html-footnote-separator)) - (cond - ((not (org-export-footnote-first-reference-p footnote-reference info)) - (org-e-html-format-footnote-reference - (org-export-get-footnote-number footnote-reference info) - "IGNORED" 100)) - ;; Inline definitions are secondary strings. - ((eq (org-element-property :type footnote-reference) 'inline) - (org-e-html-format-footnote-reference - (org-export-get-footnote-number footnote-reference info) - "IGNORED" 1)) - ;; Non-inline footnotes definitions are full Org data. - (t (org-e-html-format-footnote-reference - (org-export-get-footnote-number footnote-reference info) - "IGNORED" 1))))) - - -;;;; Headline - -(defun org-e-html-format-headline--wrap (headline info - &optional format-function - &rest extra-keys) - "Transcode an HEADLINE element from Org to HTML. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - (let* ((level (+ (org-export-get-relative-level headline info) - (1- org-e-html-toplevel-hlevel))) - (headline-number (org-export-get-headline-number headline info)) - (section-number (and (org-export-numbered-headline-p headline info) - (mapconcat 'number-to-string - headline-number "."))) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data todo info))))) - (todo-type (and todo (org-element-property :todo-type headline))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority headline))) - (text (org-export-data (org-element-property :title headline) info)) - (tags (and (plist-get info :with-tags) - (org-export-get-tags headline info))) - (headline-label (or (org-element-property :custom-id headline) - (concat "sec-" (mapconcat 'number-to-string - headline-number "-")))) - (format-function (cond - ((functionp format-function) format-function) - ((functionp org-e-html-format-headline-function) - (function* - (lambda (todo todo-type priority text tags - &allow-other-keys) - (funcall org-e-html-format-headline-function - todo todo-type priority text tags)))) - (t 'org-e-html-format-headline)))) - (apply format-function - todo todo-type priority text tags - :headline-label headline-label :level level - :section-number section-number extra-keys))) - -(defun org-e-html-headline (headline contents info) - "Transcode an HEADLINE element from Org to HTML. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - ;; Empty contents? - (setq contents (or contents "")) - (let* ((numberedp (org-export-numbered-headline-p headline info)) - (level (org-export-get-relative-level headline info)) - (text (org-export-data (org-element-property :title headline) info)) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data todo info))))) - (todo-type (and todo (org-element-property :todo-type headline))) - (tags (and (plist-get info :with-tags) - (org-export-get-tags headline info))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority headline))) - (section-number (and (org-export-numbered-headline-p headline info) - (mapconcat 'number-to-string - (org-export-get-headline-number - headline info) "."))) - ;; Create the headline text. - (full-text (org-e-html-format-headline--wrap headline info))) - (cond - ;; Case 1: This is a footnote section: ignore it. - ((org-element-property :footnote-section-p headline) nil) - ;; Case 2. This is a deep sub-tree: export it as a list item. - ;; Also export as items headlines for which no section - ;; format has been found. - ((org-export-low-level-p headline info) ; FIXME (or (not section-fmt)) - ;; Build the real contents of the sub-tree. - (let* ((type (if numberedp 'unordered 'unordered)) ; FIXME - (itemized-body (org-e-html-format-list-item - contents type nil nil full-text))) - (concat - (and (org-export-first-sibling-p headline info) - (org-e-html-begin-plain-list type)) - itemized-body - (and (org-export-last-sibling-p headline info) - (org-e-html-end-plain-list type))))) - ;; Case 3. Standard headline. Export it as a section. - (t - (let* ((section-number (mapconcat 'number-to-string - (org-export-get-headline-number - headline info) "-")) - (ids (remove 'nil - (list (org-element-property :custom-id headline) - (concat "sec-" section-number) - (org-element-property :id headline)))) - (preferred-id (car ids)) - (extra-ids (cdr ids)) - (extra-class (org-element-property :html-container-class headline)) - (level1 (+ level (1- org-e-html-toplevel-hlevel)))) - (format "
%s%s
\n" - (format "outline-container-%s" - (or (org-element-property :custom-id headline) - section-number)) - (concat (format "outline-%d" level1) (and extra-class " ") - extra-class) - (format "\n%s%s\n" - level1 - preferred-id - (mapconcat - (lambda (x) - (let ((id (org-export-solidify-link-text - (if (org-uuidgen-p x) (concat "ID-" x) - x)))) - (org-e-html--anchor id))) - extra-ids "") - full-text - level1) - contents)))))) - - -;;;; Horizontal Rule - -(defun org-e-html-horizontal-rule (horizontal-rule contents info) - "Transcode an HORIZONTAL-RULE object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((attr (mapconcat #'identity - (org-element-property :attr_html horizontal-rule) - " "))) - (org-e-html--wrap-label horizontal-rule "
"))) - - -;;;; Inline Babel Call - -;; Inline Babel Calls are ignored. - - -;;;; Inline Src Block - -(defun org-e-html-inline-src-block (inline-src-block contents info) - "Transcode an INLINE-SRC-BLOCK element from Org to HTML. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((org-lang (org-element-property :language inline-src-block)) - (code (org-element-property :value inline-src-block)) - (separator (org-e-html--find-verb-separator code))) - (error "FIXME"))) - - -;;;; Inlinetask - -(defun org-e-html-format-section (text class &optional id) - (let ((extra (concat (when id (format " id=\"%s\"" id))))) - (concat (format "
\n" class extra) text "
\n"))) - -(defun org-e-html-inlinetask (inlinetask contents info) - "Transcode an INLINETASK element from Org to HTML. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (cond - ;; If `org-e-html-format-inlinetask-function' is provided, call it - ;; with appropriate arguments. - ((functionp org-e-html-format-inlinetask-function) - (let ((format-function - (function* - (lambda (todo todo-type priority text tags - &key contents &allow-other-keys) - (funcall org-e-html-format-inlinetask-function - todo todo-type priority text tags contents))))) - (org-e-html-format-headline--wrap - inlinetask info format-function :contents contents))) - ;; Otherwise, use a default template. - (t (org-e-html--wrap-label - inlinetask - (format - "
\n%s
\n%s
" - (org-e-html-format-headline--wrap inlinetask info) - contents))))) - - -;;;; Italic - -(defun org-e-html-italic (italic contents info) - "Transcode ITALIC from Org to HTML. -CONTENTS is the text with italic markup. INFO is a plist holding -contextual information." - (format (or (cdr (assq 'italic org-e-html-text-markup-alist)) "%s") contents)) - - -;;;; Item - -(defun org-e-html-checkbox (checkbox) - (case checkbox (on "[X]") - (off "[ ]") - (trans "[-]") - (t ""))) - -(defun org-e-html-format-list-item (contents type checkbox - &optional term-counter-id - headline) - (let ((checkbox (concat (org-e-html-checkbox checkbox) (and checkbox " ")))) - (concat - (case type - (ordered - (let* ((counter term-counter-id) - (extra (if counter (format " value=\"%s\"" counter) ""))) - (format "" extra))) - (unordered - (let* ((id term-counter-id) - (extra (if id (format " id=\"%s\"" id) ""))) - (concat - (format "" extra) - (when headline (concat headline "
"))))) - (descriptive - (let* ((term term-counter-id)) - (setq term (or term "(no term)")) - ;; Check-boxes in descriptive lists are associated to tag. - (concat (format "
%s
" - (concat checkbox term)) - "
")))) - (unless (eq type 'descriptive) checkbox) - contents - (case type - (ordered "") - (unordered "") - (descriptive "
"))))) - -(defun org-e-html-item (item contents info) - "Transcode an ITEM element from Org to HTML. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((plain-list (org-export-get-parent item)) - (type (org-element-property :type plain-list)) - (counter (org-element-property :counter item)) - (checkbox (org-element-property :checkbox item)) - (tag (let ((tag (org-element-property :tag item))) - (and tag (org-export-data tag info))))) - (org-e-html-format-list-item - contents type checkbox (or tag counter)))) - - -;;;; Keyword - -(defun org-e-html-keyword (keyword contents info) - "Transcode a KEYWORD element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((key (org-element-property :key keyword)) - (value (org-element-property :value keyword))) - (cond - ((string= key "HTML") value) - ((string= key "INDEX") (format "\\index{%s}" value)) - ;; Invisible targets. - ((string= key "TARGET") nil) - ((string= key "TOC") - (let ((value (downcase value))) - (cond - ((string-match "\\" value) - (let ((depth (or (and (string-match "[0-9]+" value) - (string-to-number (match-string 0 value))) - (plist-get info :with-toc)))) - (org-e-html-toc depth info))) - ((string= "tables" value) "\\listoftables") - ((string= "figures" value) "\\listoffigures") - ((string= "listings" value) - (cond - ;; At the moment, src blocks with a caption are wrapped - ;; into a figure environment. - (t "\\listoffigures"))))))))) - - -;;;; Latex Environment - -(defun org-e-html-format-latex (latex-frag processing-type) - (let* ((cache-relpath - (concat "ltxpng/" (file-name-sans-extension - (file-name-nondirectory (buffer-file-name))))) - (cache-dir (file-name-directory (buffer-file-name ))) - (display-msg "Creating LaTeX Image...")) - - (with-temp-buffer - (insert latex-frag) - (org-format-latex cache-relpath cache-dir nil display-msg - nil nil processing-type) - (buffer-string)))) - -(defun org-e-html-latex-environment (latex-environment contents info) - "Transcode a LATEX-ENVIRONMENT element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-html--wrap-label - latex-environment - (let ((processing-type (plist-get info :LaTeX-fragments)) - (latex-frag (org-remove-indentation - (org-element-property :value latex-environment))) - (caption (org-e-html--caption/label-string - (org-element-property :caption latex-environment) - (org-element-property :name latex-environment) - info)) - (attr nil) ; FIXME - (label (org-element-property :name latex-environment))) - (cond - ((memq processing-type '(t mathjax)) - (org-e-html-format-latex latex-frag 'mathjax)) - ((eq processing-type 'dvipng) - (let* ((formula-link (org-e-html-format-latex - latex-frag processing-type))) - (when (and formula-link - (string-match "file:\\([^]]*\\)" formula-link)) - (org-e-html-format-inline-image - (match-string 1 formula-link) caption label attr t)))) - (t latex-frag))))) - - -;;;; Latex Fragment - -(defun org-e-html-latex-fragment (latex-fragment contents info) - "Transcode a LATEX-FRAGMENT object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((latex-frag (org-element-property :value latex-fragment)) - (processing-type (plist-get info :LaTeX-fragments))) - (case processing-type - ((t mathjax) - (org-e-html-format-latex latex-frag 'mathjax)) - (dvipng - (let* ((formula-link (org-e-html-format-latex - latex-frag processing-type))) - (when (and formula-link - (string-match "file:\\([^]]*\\)" formula-link)) - (org-e-html-format-inline-image - (match-string 1 formula-link))))) - (t latex-frag)))) - -;;;; Line Break - -(defun org-e-html-line-break (line-break contents info) - "Transcode a LINE-BREAK object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - "
") - - -;;;; Link - -(defun org-e-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." - (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-e-html--caption/label-string - (org-element-property :caption parent) - (org-element-property :name parent) - info)) - (label (org-element-property :name parent)) - ;; Retrieve latex attributes from the element around. - (attr (let ((raw-attr - (mapconcat #'identity - (org-element-property :attr_html parent) - " "))) - (unless (string= raw-attr "") raw-attr)))) - ;; Now clear ATTR from any special keyword and set a default - ;; value if nothing is left. - (setq attr (if (not attr) "" (org-trim attr))) - ;; Return proper string, depending on DISPOSITION. - (org-e-html-format-inline-image - path caption label attr (org-e-html-standalone-image-p link info)))) - -(defvar org-e-html-standalone-image-predicate) -(defun org-e-html-standalone-image-p (element info &optional predicate) - "Test if ELEMENT is a standalone image for the purpose HTML export. -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 -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 nil, otherwise. - -Bind `org-e-html-standalone-image-predicate' to constrain -paragraph further. For example, to check for only captioned -standalone images, do the following. - - \(setq org-e-html-standalone-image-predicate - \(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-e-html-inline-image-rules) - (org-export-get-parent element))) - (t nil)))) - (when paragraph - (assert (eq (org-element-type paragraph) 'paragraph)) - (when (or (not (and (boundp 'org-e-html-standalone-image-predicate) - (functionp org-e-html-standalone-image-predicate))) - (funcall org-e-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-e-html-inline-image-rules) - (= (incf inline-image-count) 1))) - (t nil)))))))) - -(defun org-e-html-link (link desc info) - "Transcode a LINK object from Org to HTML. - -DESC is the description part of the link, or the empty string. -INFO is a plist holding contextual information. See -`org-export-data'." - (let* ((--link-org-files-as-html-maybe - (function - (lambda (raw-path info) - "Treat links to `file.org' as links to `file.html', if needed. - See `org-e-html-link-org-files-as-html'." - (cond - ((and org-e-html-link-org-files-as-html - (string= ".org" - (downcase (file-name-extension raw-path ".")))) - (concat (file-name-sans-extension raw-path) "." - (plist-get info :html-extension))) - (t raw-path))))) - (type (org-element-property :type link)) - (raw-path (org-element-property :path link)) - ;; Ensure DESC really exists, or set it to nil. - (desc (and (not (string= desc "")) desc)) - (path (cond - ((member type '("http" "https" "ftp" "mailto")) - (concat type ":" raw-path)) - ((string= type "file") - ;; Extract just the file path and strip all other - ;; components. - (when (string-match "\\(.+\\)::.+" raw-path) - (setq raw-path (match-string 1 raw-path))) - ;; Treat links to ".org" files as ".html", if needed. - (setq raw-path (funcall --link-org-files-as-html-maybe - raw-path info)) - ;; If file path is absolute, prepend it with protocol - ;; component - "file://". - (if (not (file-name-absolute-p raw-path)) raw-path - (concat "file://" (expand-file-name raw-path)))) - (t raw-path))) - ;; Extract attributes from parent's paragraph. - (attributes - (let ((attr (mapconcat - 'identity - (org-element-property - :attr_html (org-export-get-parent-element link)) - " "))) - (if attr (concat " " attr) ""))) - protocol) - (cond - ;; Image file. - ((and (or (eq t org-e-html-inline-images) - (and org-e-html-inline-images (not desc))) - (org-export-inline-image-p link org-e-html-inline-image-rules)) - (org-e-html-link--inline-image link desc info)) - ;; Radio target: Transcode target's contents and use them as - ;; link's description. - ((string= type "radio") - (let ((destination (org-export-resolve-radio-link link info))) - (when destination - (format "%s" - (org-export-solidify-link-text path) - attributes - (org-export-data (org-element-contents destination) info))))) - ;; Links pointing to an headline: Find destination and build - ;; appropriate referencing command. - ((member type '("custom-id" "fuzzy" "id")) - (let ((destination (if (string= type "fuzzy") - (org-export-resolve-fuzzy-link link info) - (org-export-resolve-id-link link info)))) - (case (org-element-type destination) - ;; ID link points to an external file. - (plain-text - (assert (org-uuidgen-p path)) - (let ((fragment (concat "ID-" path)) - ;; Treat links to ".org" files as ".html", if needed. - (path (funcall --link-org-files-as-html-maybe - destination info))) - (format "%s" - path fragment attributes (or desc destination)))) - ;; Fuzzy link points nowhere. - ((nil) - (format "%s" - (or desc - (org-export-data - (org-element-property :raw-link link) info)))) - ;; Fuzzy link points to an invisible target. - (keyword nil) - ;; Link points to an headline. - (headline - (let ((href - ;; What href to use? - (cond - ;; Case 1: Headline is linked via it's CUSTOM_ID - ;; property. Use CUSTOM_ID. - ((string= type "custom-id") - (org-element-property :custom-id destination)) - ;; Case 2: Headline is linked via it's ID property - ;; or through other means. Use the default href. - ((member type '("id" "fuzzy")) - (format "sec-%s" - (mapconcat 'number-to-string - (org-export-get-headline-number - destination info) "-"))) - (t (error "Shouldn't reach here")))) - ;; What description to use? - (desc - ;; Case 1: Headline is numbered and LINK has no - ;; description or LINK's description matches - ;; headline's title. Display section number. - (if (and (org-export-numbered-headline-p destination info) - (or (not desc) - (string= desc (org-element-property - :raw-value destination)))) - (mapconcat 'number-to-string - (org-export-get-headline-number - destination info) ".") - ;; Case 2: Either the headline is un-numbered or - ;; LINK has a custom description. Display LINK's - ;; description or headline's title. - (or desc (org-export-data (org-element-property - :title destination) info))))) - (format "%s" - (org-export-solidify-link-text href) attributes desc))) - ;; Fuzzy link points to a target. Do as above. - (t - (let ((path (org-export-solidify-link-text path)) number) - (unless desc - (setq number (cond - ((org-e-html-standalone-image-p destination info) - (org-export-get-ordinal - (assoc 'link (org-element-contents destination)) - info 'link 'org-e-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 "FIXME"))))))) - ;; Coderef: replace link with the reference name or the - ;; equivalent line number. - ((string= type "coderef") - (let ((fragment (concat "coderef-" path))) - (format "%s" - fragment - (format (concat "class=\"coderef\"" - " onmouseover=\"CodeHighlightOn(this, '%s');\"" - " onmouseout=\"CodeHighlightOff(this, '%s');\"") - fragment fragment) - attributes - (format (org-export-get-coderef-format path desc) - (org-export-resolve-coderef path info))))) - ;; Link type is handled by a special function. - ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) - (funcall protocol (org-link-unescape path) desc 'html)) - ;; External link with a description part. - ((and path desc) (format "%s" path attributes desc)) - ;; External link without a description part. - (path (format "%s" path attributes path)) - ;; No path, only description. Try to do something useful. - (t (format "%s" desc))))) - - -;;;; Babel Call - -;; Babel Calls are ignored. - - -;;;; Macro - -(defun org-e-html-macro (macro contents info) - "Transcode a MACRO element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - ;; Use available tools. - (org-export-expand-macro macro info)) - - -;;;; Paragraph - -(defun org-e-html-paragraph (paragraph contents info) - "Transcode a PARAGRAPH element from Org to HTML. -CONTENTS is the contents of the paragraph, as a string. INFO is -the plist used as a communication channel." - (let* ((style nil) ; FIXME - (class (cdr (assoc style '((footnote . "footnote") - (verse . nil))))) - (extra (if class (format " class=\"%s\"" class) "")) - (parent (org-export-get-parent paragraph))) - (cond - ((and (eq (org-element-type parent) 'item) - (= (org-element-property :begin paragraph) - (org-element-property :contents-begin parent))) - ;; leading paragraph in a list item have no tags - contents) - ((org-e-html-standalone-image-p paragraph info) - ;; standalone image - contents) - (t (format "\n%s

" extra contents))))) - - -;;;; Plain List - -(defun org-e-html-begin-plain-list (type &optional arg1) - (case type - (ordered - (format "" (if arg1 ; FIXME - (format " start=\"%d\"" arg1) - ""))) - (unordered "
    ") - (descriptive "
    "))) - -(defun org-e-html-end-plain-list (type) - (case type - (ordered "") - (unordered "
") - (descriptive ""))) - -(defun org-e-html-plain-list (plain-list contents info) - "Transcode a PLAIN-LIST element from Org to HTML. -CONTENTS is the contents of the list. INFO is a plist holding -contextual information." - (let* (arg1 ;; FIXME - (type (org-element-property :type plain-list)) - (attr (mapconcat #'identity - (org-element-property :attr_html plain-list) - " "))) - (org-e-html--wrap-label - plain-list (format "%s\n%s%s" - (org-e-html-begin-plain-list type) - contents (org-e-html-end-plain-list type))))) - -;;;; Plain Text - -(defun org-e-html-convert-special-strings (string) - "Convert special characters in STRING to HTML." - (let ((all org-e-html-special-string-regexps) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (setq string (replace-match rpl t nil string)))) - string)) - -(defun org-e-html-encode-plain-text (text) - "Convert plain text characters to HTML equivalent. -Possible conversions are set in `org-export-html-protect-char-alist'." - (mapc - (lambda (pair) - (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))) - org-e-html-protect-char-alist) - text) - -(defun org-e-html-plain-text (text info) - "Transcode a TEXT string from Org to HTML. -TEXT is the string to transcode. INFO is a plist holding -contextual information." - ;; Protect following characters: <, >, &. - (setq text (org-e-html-encode-plain-text text)) - ;; Handle quotation marks. - (setq text (org-e-html--quotation-marks text info)) - ;; Handle special strings. - (when (plist-get info :with-special-strings) - (setq text (org-e-html-convert-special-strings text))) - ;; Handle break preservation if required. - (when (plist-get info :preserve-breaks) - (setq text (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" - text))) - ;; Return value. - text) - - -;; Planning - -(defun org-e-html-planning (planning contents info) - "Transcode a PLANNING element from Org to HTML. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (let ((span-fmt "%s %s")) - (format - "

%s

" - (mapconcat - 'identity - (delq nil - (list - (let ((closed (org-element-property :closed planning))) - (when closed - (format span-fmt org-closed-string - (org-translate-time closed)))) - (let ((deadline (org-element-property :deadline planning))) - (when deadline - (format span-fmt org-deadline-string - (org-translate-time deadline)))) - (let ((scheduled (org-element-property :scheduled planning))) - (when scheduled - (format span-fmt org-scheduled-string - (org-translate-time scheduled)))))) - " ")))) - - -;;;; Property Drawer - -(defun org-e-html-property-drawer (property-drawer contents info) - "Transcode a PROPERTY-DRAWER element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual -information." - ;; The property drawer isn't exported but we want separating blank - ;; lines nonetheless. - "") - - -;;;; Quote Block - -(defun org-e-html-quote-block (quote-block contents info) - "Transcode a QUOTE-BLOCK element from Org to HTML. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (org-e-html--wrap-label - quote-block (format "
\n%s
" contents))) - - -;;;; Quote Section - -(defun org-e-html-quote-section (quote-section contents info) - "Transcode a QUOTE-SECTION element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((value (org-remove-indentation - (org-element-property :value quote-section)))) - (when value (format "
\n%s
" value)))) - - -;;;; Section - -(defun org-e-html-section (section contents info) - "Transcode a SECTION element from Org to HTML. -CONTENTS holds the contents of the section. INFO is a plist -holding contextual information." - (let ((parent (org-export-get-parent-headline section))) - ;; Before first headline: no container, just return CONTENTS. - (if (not parent) contents - ;; Get div's class and id references. - (let* ((class-num (+ (org-export-get-relative-level parent info) - (1- org-e-html-toplevel-hlevel))) - (section-number - (mapconcat - 'number-to-string - (org-export-get-headline-number parent info) "-"))) - ;; Build return value. - (format "
\n%s
" - class-num - (or (org-element-property :custom-id parent) section-number) - contents))))) - -;;;; Radio Target - -(defun org-e-html-radio-target (radio-target text info) - "Transcode a RADIO-TARGET object from Org to HTML. -TEXT is the text of the target. INFO is a plist holding -contextual information." - (let ((id (org-export-solidify-link-text - (org-element-property :value radio-target)))) - (org-e-html--anchor id text))) - - -;;;; Special Block - -(defun org-e-html-special-block (special-block contents info) - "Transcode a SPECIAL-BLOCK element from Org to HTML. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let ((type (downcase (org-element-property :type special-block)))) - (org-e-html--wrap-label - special-block - (format "
\n%s\n
" type contents)))) - - -;;;; Src Block - -(defun org-e-html-src-block (src-block contents info) - "Transcode a SRC-BLOCK element from Org to HTML. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((lang (org-element-property :language src-block)) - (caption (org-element-property :caption src-block)) - (label (org-element-property :name src-block)) - (caption-str (org-e-html--caption/label-string caption label info)) - (attr (mapconcat #'identity - (org-element-property :attr_html src-block) - " ")) - ;; (switches (org-element-property :switches src-block)) - (switches nil) ; FIXME - (textarea-p (and switches (string-match "-t\\>" switches))) - (code (org-e-html-format-code src-block info))) - (cond - (lang (format - "
\n%s%s\n
" - (if (not caption) "" - (format "" caption-str)) - (format "\n
%s
" lang code))) - (textarea-p - (let ((cols (if (not (string-match "-w[ \t]+\\([0-9]+\\)" switches)) - 80 (string-to-number (match-string 1 switches)))) - (rows (if (string-match "-h[ \t]+\\([0-9]+\\)" switches) - (string-to-number (match-string 1 switches)) - (org-count-lines code)))) - (format - "

\n\n

" - cols rows code))) - (t (format "
\n%s
" code))))) - -;;;; Statistics Cookie - -(defun org-e-html-statistics-cookie (statistics-cookie contents info) - "Transcode a STATISTICS-COOKIE object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((cookie-value (org-element-property :value statistics-cookie))) - (format "%s" cookie-value))) - - -;;;; Strike-Through - -(defun org-e-html-strike-through (strike-through contents info) - "Transcode STRIKE-THROUGH from Org to HTML. -CONTENTS is the text with strike-through markup. INFO is a plist -holding contextual information." - (format (or (cdr (assq 'strike-through org-e-html-text-markup-alist)) "%s") - contents)) - - -;;;; Subscript - -(defun org-e-html-subscript (subscript contents info) - "Transcode a SUBSCRIPT object from Org to HTML. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (format "%s" contents)) - - -;;;; Superscript - -(defun org-e-html-superscript (superscript contents info) - "Transcode a SUPERSCRIPT object from Org to HTML. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (format "%s" contents)) - - -;;;; Tabel Cell - -(defun org-e-html-table-cell (table-cell contents info) - "Transcode a TABLE-CELL element from Org to HTML. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (let* ((table-row (org-export-get-parent table-cell)) - (table (org-export-get-parent-table table-cell)) - (cell-attrs - (if (not org-e-html-table-align-individual-fields) "" - (format (if (and (boundp 'org-e-html-format-table-no-css) - org-e-html-format-table-no-css) - " align=\"%s\"" " class=\"%s\"") - (org-export-table-cell-alignment table-cell info))))) - (when (or (not contents) (string= "" (org-trim contents))) - (setq contents " ")) - (cond - ((and (org-export-table-has-header-p table info) - (= 1 (org-export-table-row-group table-row info))) - (concat "\n" (format (car org-e-html-table-header-tags) "col" cell-attrs) - contents (cdr org-e-html-table-header-tags))) - ((and org-e-html-table-use-header-tags-for-first-column - (zerop (cdr (org-export-table-cell-address table-cell info)))) - (concat "\n" (format (car org-e-html-table-header-tags) "row" cell-attrs) - contents (cdr org-e-html-table-header-tags))) - (t (concat "\n" (format (car org-e-html-table-data-tags) cell-attrs) - contents (cdr org-e-html-table-data-tags)))))) - - -;;;; Table Row - -(defun org-e-html-table-row (table-row contents info) - "Transcode a TABLE-ROW element from Org to HTML. -CONTENTS is the contents of the row. INFO is a plist used as a -communication channel." - ;; Rules are ignored since table separators are deduced from - ;; borders of the current row. - (when (eq (org-element-property :type table-row) 'standard) - (let* ((first-rowgroup-p (= 1 (org-export-table-row-group table-row info))) - (rowgroup-tags - (cond - ;; Case 1: Row belongs to second or subsequent rowgroups. - ((not (= 1 (org-export-table-row-group table-row info))) - '("" . "\n")) - ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups. - ((org-export-table-has-header-p - (org-export-get-parent-table table-row) info) - '("" . "\n")) - ;; Case 2: Row is from first and only row group. - (t '("" . "\n"))))) - (concat - ;; Begin a rowgroup? - (when (org-export-table-row-starts-rowgroup-p table-row info) - (car rowgroup-tags)) - ;; Actual table row - (concat "\n" (eval (car org-e-html-table-row-tags)) - contents - "\n" - (eval (cdr org-e-html-table-row-tags))) - ;; End a rowgroup? - (when (org-export-table-row-ends-rowgroup-p table-row info) - (cdr rowgroup-tags)))))) - - -;;;; Table - -(defun org-e-html-table-first-row-data-cells (table info) - (let ((table-row - (org-element-map - table 'table-row - (lambda (row) - (unless (eq (org-element-property :type row) 'rule) row)) - info 'first-match)) - (special-column-p (org-export-table-has-special-column-p table))) - (if (not special-column-p) (org-element-contents table-row) - (cdr (org-element-contents table-row))))) - -(defun org-e-html-table--table.el-table (table info) - (when (eq (org-element-property :type table) 'table.el) - (require 'table) - (let ((outbuf (with-current-buffer - (get-buffer-create "*org-export-table*") - (erase-buffer) (current-buffer)))) - (with-temp-buffer - (insert (org-element-property :value table)) - (goto-char 1) - (re-search-forward "^[ \t]*|[^|]" nil t) - (table-generate-source 'html outbuf)) - (with-current-buffer outbuf - (prog1 (org-trim (buffer-string)) - (kill-buffer) ))))) - -(defun org-e-html-table (table contents info) - "Transcode a TABLE element from Org to HTML. -CONTENTS is the contents of the table. INFO is a plist holding -contextual information." - (case (org-element-property :type table) - ;; Case 1: table.el table. Convert it using appropriate tools. - (table.el (org-e-html-table--table.el-table table info)) - ;; Case 2: Standard table. - (t - (let* ((label (org-element-property :name table)) - (caption (org-e-html--caption/label-string - (org-element-property :caption table) label info)) - (attributes (mapconcat #'identity - (org-element-property :attr_html table) - " ")) - (alignspec - (if (and (boundp 'org-e-html-format-table-no-css) - org-e-html-format-table-no-css) - "align=\"%s\"" "class=\"%s\"")) - (table-column-specs - (function - (lambda (table info) - (mapconcat - (lambda (table-cell) - (let ((alignment (org-export-table-cell-alignment - table-cell info))) - (concat - ;; Begin a colgroup? - (when (org-export-table-cell-starts-colgroup-p - table-cell info) - "\n") - ;; Add a column. Also specify it's alignment. - (format "\n" (format alignspec alignment)) - ;; End a colgroup? - (when (org-export-table-cell-ends-colgroup-p - table-cell info) - "\n")))) - (org-e-html-table-first-row-data-cells table info) "\n")))) - (table-attributes - (let ((table-tag (plist-get info :html-table-tag))) - (concat - (and (string-match "" table-tag) - (match-string 1 table-tag)) - (and label (format " id=\"%s\"" - (org-export-solidify-link-text label))))))) - ;; Remove last blank line. - (setq contents (substring contents 0 -1)) - (format "\n%s\n%s\n%s\n" - table-attributes - (if (not caption) "" (format "%s" caption)) - (funcall table-column-specs table info) - contents))))) - -;;;; Target - -(defun org-e-html-target (target contents info) - "Transcode a TARGET object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual -information." - (let ((id (org-export-solidify-link-text - (org-element-property :value target)))) - (org-e-html--anchor id))) - - -;;;; Timestamp - -(defun org-e-html-timestamp (timestamp contents info) - "Transcode a TIMESTAMP object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual -information." - (let* ((f (if (eq (org-element-property :type timestamp) 'inactive) "[%s]" "<%s>")) - (value (org-translate-time (format f (org-element-property :value timestamp)))) - (range-end (org-element-property :range-end timestamp))) - (format "%s" - (if (not range-end) value - (concat value "–" (org-translate-time (format f range-end))))))) - - -;;;; Underline - -(defun org-e-html-underline (underline contents info) - "Transcode UNDERLINE from Org to HTML. -CONTENTS is the text with underline markup. INFO is a plist -holding contextual information." - (format (or (cdr (assq 'underline org-e-html-text-markup-alist)) "%s") - contents)) - - -;;;; Verbatim - -(defun org-e-html-verbatim (verbatim contents info) - "Transcode VERBATIM from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual -information." - (format (or (cdr (assq 'verbatim org-e-html-text-markup-alist)) "%s") - (org-element-property :value verbatim))) - - -;;;; Verse Block - -(defun org-e-html-verse-block (verse-block contents info) - "Transcode a VERSE-BLOCK element from Org to HTML. -CONTENTS is verse block contents. INFO is a plist holding -contextual information." - ;; Replace each newline character with line break. Also replace - ;; each blank line with a line break. - (setq contents (replace-regexp-in-string - "^ *\\\\\\\\$" "
\n" - (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" "
\n" contents))) - ;; Replace each white space at beginning of a line with a - ;; non-breaking space. - (while (string-match "^[ \t]+" contents) - (let* ((num-ws (length (match-string 0 contents))) - (ws (let (out) (dotimes (i num-ws out) - (setq out (concat out " ")))))) - (setq contents (replace-match ws nil t contents)))) - (org-e-html--wrap-label - verse-block (format "

\n%s

" contents))) - - - - -;;; Filter Functions - -(defun org-e-html-final-function (contents backend info) - (if (not org-e-html-pretty-output) contents - (with-temp-buffer - (html-mode) - (insert contents) - (indent-region (point-min) (point-max)) - (buffer-substring-no-properties (point-min) (point-max))))) - - -;;; Interactive functions - -;;;###autoload -(defun org-e-html-export-as-html - (&optional subtreep visible-only body-only ext-plist) - "Export current buffer to an HTML buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\" and \"\" tags. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Export is done in a buffer named \"*Org E-HTML Export*\", which -will be displayed when `org-export-show-temporary-export-buffer' -is non-nil." - (interactive) - (let ((outbuf - (org-export-to-buffer - 'e-html "*Org E-HTML Export*" - subtreep visible-only body-only ext-plist))) - ;; Set major mode. - (with-current-buffer outbuf (nxml-mode)) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window outbuf)))) - -;;;###autoload -(defun org-e-html-export-to-html - (&optional subtreep visible-only body-only ext-plist pub-dir) - "Export current buffer to a HTML file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\" and \"\" tags. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -When optional argument PUB-DIR is set, use it as the publishing -directory. - -Return output file's name." - (interactive) - (let* ((extension (concat "." org-e-html-extension)) - (file (org-export-output-file-name extension subtreep pub-dir)) - (org-export-coding-system org-e-html-coding-system)) - (org-export-to-file - 'e-html file subtreep visible-only body-only ext-plist))) - - - -;;; FIXME - -;;;; org-format-table-html -;;;; org-format-org-table-html -;;;; org-format-table-table-html -;;;; org-table-number-fraction -;;;; org-table-number-regexp -;;;; org-e-html-table-caption-above - -;;;; org-e-html-with-timestamp -;;;; org-e-html-html-helper-timestamp - -;;;; org-export-as-html-and-open -;;;; org-export-as-html-batch -;;;; org-export-as-html-to-buffer -;;;; org-replace-region-by-html -;;;; org-export-region-as-html -;;;; org-export-as-html - -;;;; (org-export-directory :html opt-plist) -;;;; (plist-get opt-plist :html-extension) -;;;; org-e-html-toplevel-hlevel -;;;; org-e-html-special-string-regexps -;;;; org-e-html-inline-images -;;;; org-e-html-inline-image-extensions -;;;; org-e-html-protect-char-alist -;;;; org-e-html-table-use-header-tags-for-first-column -;;;; org-e-html-todo-kwd-class-prefix -;;;; org-e-html-tag-class-prefix -;;;; org-e-html-footnote-separator - -;;;; org-export-preferred-target-alist -;;;; org-export-solidify-link-text -;;;; class for anchors -;;;; org-export-with-section-numbers, body-only -;;;; org-export-mark-todo-in-toc - -;;;; org-e-html-format-org-link -;;;; (caption (and caption (org-xml-encode-org-text caption))) -;;;; alt = (file-name-nondirectory path) - -;;;; org-export-time-stamp-file' - -(provide 'org-e-html) -;;; org-e-html.el ends here diff --git a/contrib/lisp/org-e-latex.el b/contrib/lisp/org-e-latex.el deleted file mode 100644 index 4e9639de1..000000000 --- a/contrib/lisp/org-e-latex.el +++ /dev/null @@ -1,2726 +0,0 @@ -;;; org-e-latex.el --- LaTeX Back-End For Org Export Engine - -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. - -;; Author: Nicolas Goaziou -;; Keywords: outlines, hypermedia, calendar, wp - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: -;; -;; This library implements a LaTeX back-end for Org generic exporter. -;; -;; To test it, run -;; -;; M-: (org-export-to-buffer 'e-latex "*Test e-LaTeX*") RET -;; -;; in an org-mode buffer then switch to the buffer to see the LaTeX -;; export. See contrib/lisp/org-export.el for more details on how -;; this exporter works. -;; -;; It introduces three new buffer keywords: "LATEX_CLASS", -;; "LATEX_CLASS_OPTIONS" and "LATEX_HEADER". - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'org-export) - -(defvar org-export-latex-default-packages-alist) -(defvar org-export-latex-packages-alist) -(defvar orgtbl-exp-regexp) - - - -;;; Define Back-End - -(org-export-define-backend e-latex - ((bold . org-e-latex-bold) - (center-block . org-e-latex-center-block) - (clock . org-e-latex-clock) - (code . org-e-latex-code) - (drawer . org-e-latex-drawer) - (dynamic-block . org-e-latex-dynamic-block) - (entity . org-e-latex-entity) - (example-block . org-e-latex-example-block) - (export-block . org-e-latex-export-block) - (export-snippet . org-e-latex-export-snippet) - (fixed-width . org-e-latex-fixed-width) - (footnote-definition . org-e-latex-footnote-definition) - (footnote-reference . org-e-latex-footnote-reference) - (headline . org-e-latex-headline) - (horizontal-rule . org-e-latex-horizontal-rule) - (inline-src-block . org-e-latex-inline-src-block) - (inlinetask . org-e-latex-inlinetask) - (italic . org-e-latex-italic) - (item . org-e-latex-item) - (keyword . org-e-latex-keyword) - (latex-environment . org-e-latex-latex-environment) - (latex-fragment . org-e-latex-latex-fragment) - (line-break . org-e-latex-line-break) - (link . org-e-latex-link) - (macro . org-e-latex-macro) - (paragraph . org-e-latex-paragraph) - (plain-list . org-e-latex-plain-list) - (plain-text . org-e-latex-plain-text) - (planning . org-e-latex-planning) - (property-drawer . org-e-latex-property-drawer) - (quote-block . org-e-latex-quote-block) - (quote-section . org-e-latex-quote-section) - (radio-target . org-e-latex-radio-target) - (section . org-e-latex-section) - (special-block . org-e-latex-special-block) - (src-block . org-e-latex-src-block) - (statistics-cookie . org-e-latex-statistics-cookie) - (strike-through . org-e-latex-strike-through) - (subscript . org-e-latex-subscript) - (superscript . org-e-latex-superscript) - (table . org-e-latex-table) - (table-cell . org-e-latex-table-cell) - (table-row . org-e-latex-table-row) - (target . org-e-latex-target) - (template . org-e-latex-template) - (timestamp . org-e-latex-timestamp) - (underline . org-e-latex-underline) - (verbatim . org-e-latex-verbatim) - (verse-block . org-e-latex-verse-block)) - :export-block "LATEX" - :options-alist ((:date "DATE" nil org-e-latex-date-format t) - (:latex-class "LATEX_CLASS" nil org-e-latex-default-class t) - (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t) - (:latex-header-extra "LATEX_HEADER" nil nil newline))) - - - -;;; Internal Variables - -(defconst org-e-latex-babel-language-alist - '(("af" . "afrikaans") - ("bg" . "bulgarian") - ("bt-br" . "brazilian") - ("ca" . "catalan") - ("cs" . "czech") - ("cy" . "welsh") - ("da" . "danish") - ("de" . "germanb") - ("de-at" . "naustrian") - ("de-de" . "ngerman") - ("el" . "greek") - ("en" . "english") - ("en-au" . "australian") - ("en-ca" . "canadian") - ("en-gb" . "british") - ("en-ie" . "irish") - ("en-nz" . "newzealand") - ("en-us" . "american") - ("es" . "spanish") - ("et" . "estonian") - ("eu" . "basque") - ("fi" . "finnish") - ("fr" . "frenchb") - ("fr-ca" . "canadien") - ("gl" . "galician") - ("hr" . "croatian") - ("hu" . "hungarian") - ("id" . "indonesian") - ("is" . "icelandic") - ("it" . "italian") - ("la" . "latin") - ("ms" . "malay") - ("nl" . "dutch") - ("no-no" . "nynorsk") - ("pl" . "polish") - ("pt" . "portuguese") - ("ro" . "romanian") - ("ru" . "russian") - ("sa" . "sanskrit") - ("sb" . "uppersorbian") - ("sk" . "slovak") - ("sl" . "slovene") - ("sq" . "albanian") - ("sr" . "serbian") - ("sv" . "swedish") - ("ta" . "tamil") - ("tr" . "turkish") - ("uk" . "ukrainian")) - "Alist between language code and corresponding Babel option.") - - - -;;; User Configurable Variables - -(defgroup org-export-e-latex nil - "Options for exporting Org mode files to LaTeX." - :tag "Org Export LaTeX" - :group 'org-export) - - -;;;; Preamble - -(defcustom org-e-latex-default-class "article" - "The default LaTeX class." - :group 'org-export-e-latex - :type '(string :tag "LaTeX class")) - -(defcustom org-e-latex-classes - '(("article" - "\\documentclass[11pt]{article}" - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}") - ("\\paragraph{%s}" . "\\paragraph*{%s}") - ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) - ("report" - "\\documentclass[11pt]{report}" - ("\\part{%s}" . "\\part*{%s}") - ("\\chapter{%s}" . "\\chapter*{%s}") - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) - ("book" - "\\documentclass[11pt]{book}" - ("\\part{%s}" . "\\part*{%s}") - ("\\chapter{%s}" . "\\chapter*{%s}") - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))) - "Alist of LaTeX classes and associated header and structure. -If #+LaTeX_CLASS is set in the buffer, use its value and the -associated information. Here is the structure of each cell: - - \(class-name - header-string - \(numbered-section . unnumbered-section\) - ...\) - -The header string ------------------ - -The HEADER-STRING is the header that will be inserted into the -LaTeX file. It should contain the \\documentclass macro, and -anything else that is needed for this setup. To this header, the -following commands will be added: - -- Calls to \\usepackage for all packages mentioned in the - variables `org-export-latex-default-packages-alist' and - `org-export-latex-packages-alist'. Thus, your header - definitions should avoid to also request these packages. - -- Lines specified via \"#+LaTeX_HEADER:\" - -If you need more control about the sequence in which the header -is built up, or if you want to exclude one of these building -blocks for a particular class, you can use the following -macro-like placeholders. - - [DEFAULT-PACKAGES] \\usepackage statements for default packages - [NO-DEFAULT-PACKAGES] do not include any of the default packages - [PACKAGES] \\usepackage statements for packages - [NO-PACKAGES] do not include the packages - [EXTRA] the stuff from #+LaTeX_HEADER - [NO-EXTRA] do not include #+LaTeX_HEADER stuff - -So a header like - - \\documentclass{article} - [NO-DEFAULT-PACKAGES] - [EXTRA] - \\providecommand{\\alert}[1]{\\textbf{#1}} - [PACKAGES] - -will omit the default packages, and will include the -#+LaTeX_HEADER lines, then have a call to \\providecommand, and -then place \\usepackage commands based on the content of -`org-export-latex-packages-alist'. - -If your header, `org-export-latex-default-packages-alist' or -`org-export-latex-packages-alist' inserts -\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be -replaced with a coding system derived from -`buffer-file-coding-system'. See also the variable -`org-e-latex-inputenc-alist' for a way to influence this -mechanism. - -The sectioning structure ------------------------- - -The sectioning structure of the class is given by the elements -following the header string. For each sectioning level, a number -of strings is specified. A %s formatter is mandatory in each -section string and will be replaced by the title of the section. - -Instead of a cons cell \(numbered . unnumbered\), you can also -provide a list of 2 or 4 elements, - - \(numbered-open numbered-close\) - -or - - \(numbered-open numbered-close unnumbered-open unnumbered-close\) - -providing opening and closing strings for a LaTeX environment -that should represent the document section. The opening clause -should have a %s to represent the section title. - -Instead of a list of sectioning commands, you can also specify -a function name. That function will be called with two -parameters, the \(reduced) level of the headline, and a predicate -non-nil when the headline should be numbered. It must return -a format string in which the section title will be added." - :group 'org-export-e-latex - :type '(repeat - (list (string :tag "LaTeX class") - (string :tag "LaTeX header") - (repeat :tag "Levels" :inline t - (choice - (cons :tag "Heading" - (string :tag " numbered") - (string :tag "unnumbered")) - (list :tag "Environment" - (string :tag "Opening (numbered)") - (string :tag "Closing (numbered)") - (string :tag "Opening (unnumbered)") - (string :tag "Closing (unnumbered)")) - (function :tag "Hook computing sectioning")))))) - -(defcustom org-e-latex-inputenc-alist nil - "Alist of inputenc coding system names, and what should really be used. -For example, adding an entry - - (\"utf8\" . \"utf8x\") - -will cause \\usepackage[utf8x]{inputenc} to be used for buffers that -are written as utf8 files." - :group 'org-export-e-latex - :type '(repeat - (cons - (string :tag "Derived from buffer") - (string :tag "Use this instead")))) - -(defcustom org-e-latex-date-format - "\\today" - "Format string for \\date{...}." - :group 'org-export-e-latex - :type 'boolean) - -(defcustom org-e-latex-title-command "\\maketitle" - "The command used to insert the title just after \\begin{document}. -If this string contains the formatting specification \"%s\" then -it will be used as a formatting string, passing the title as an -argument." - :group 'org-export-e-latex - :type 'string) - - -;;;; Headline - -(defcustom org-e-latex-format-headline-function nil - "Function to format headline text. - -This function will be called with 5 arguments: -TODO the todo keyword (string or nil). -TODO-TYPE the type of todo (symbol: `todo', `done', nil) -PRIORITY the priority of the headline (integer or nil) -TEXT the main headline text (string). -TAGS the tags as a list of strings (list of strings or nil). - -The function result will be used in the section format string. - -As an example, one could set the variable to the following, in -order to reproduce the default set-up: - -\(defun org-e-latex-format-headline (todo todo-type priority text tags) - \"Default format function for an headline.\" - \(concat (when todo - \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo)) - \(when priority - \(format \"\\\\framebox{\\\\#%c} \" priority)) - text - \(when tags - \(format \"\\\\hfill{}\\\\textsc{%s}\" - \(mapconcat 'identity tags \":\"))))" - :group 'org-export-e-latex - :type 'function) - - -;;;; Footnotes - -(defcustom org-e-latex-footnote-separator "\\textsuperscript{,}\\," - "Text used to separate footnotes." - :group 'org-export-e-latex - :type 'string) - - -;;;; Timestamps - -(defcustom org-e-latex-active-timestamp-format "\\textit{%s}" - "A printf format string to be applied to active timestamps." - :group 'org-export-e-latex - :type 'string) - -(defcustom org-e-latex-inactive-timestamp-format "\\textit{%s}" - "A printf format string to be applied to inactive timestamps." - :group 'org-export-e-latex - :type 'string) - -(defcustom org-e-latex-diary-timestamp-format "\\textit{%s}" - "A printf format string to be applied to diary timestamps." - :group 'org-export-e-latex - :type 'string) - - -;;;; Links - -(defcustom org-e-latex-image-default-option "width=.9\\linewidth" - "Default option for images." - :group 'org-export-e-latex - :type 'string) - -(defcustom org-e-latex-default-figure-position "htb" - "Default position for latex figures." - :group 'org-export-e-latex - :type 'string) - -(defcustom org-e-latex-inline-image-rules - '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\)\\'")) - "Rules characterizing image files that can be inlined into LaTeX. - -A rule consists in an association whose key is the type of link -to consider, and value is a regexp that will be matched against -link's path. - -Note that, by default, the image extension *actually* allowed -depend on the way the LaTeX file is processed. When used with -pdflatex, pdf, jpg and png images are OK. When processing -through dvi to Postscript, only ps and eps are allowed. The -default we use here encompasses both." - :group 'org-export-e-latex - :type '(alist :key-type (string :tag "Type") - :value-type (regexp :tag "Path"))) - -(defcustom org-e-latex-link-with-unknown-path-format "\\texttt{%s}" - "Format string for links with unknown path type." - :group 'org-export-latex - :type 'string) - - -;;;; Tables - -(defcustom org-e-latex-default-table-environment "tabular" - "Default environment used to build tables." - :group 'org-export-e-latex - :type 'string) - -(defcustom org-e-latex-tables-centered t - "When non-nil, tables are exported in a center environment." - :group 'org-export-e-latex - :type 'boolean) - -(defcustom org-e-latex-tables-verbatim nil - "When non-nil, tables are exported verbatim." - :group 'org-export-e-latex - :type 'boolean) - -(defcustom org-e-latex-tables-booktabs nil - "When non-nil, display tables in a formal \"booktabs\" style. -This option assumes that the \"booktabs\" package is properly -loaded in the header of the document. This value can be ignored -locally with \"booktabs=yes\" and \"booktabs=no\" LaTeX -attributes." - :group 'org-export-e-latex - :type 'boolean) - -(defcustom org-e-latex-table-caption-above t - "When non-nil, place caption string at the beginning of the table. -Otherwise, place it near the end." - :group 'org-export-e-latex - :type 'boolean) - -(defcustom org-e-latex-table-scientific-notation "%s\\,(%s)" - "Format string to display numbers in scientific notation. -The format should have \"%s\" twice, for mantissa and exponent -\(i.e. \"%s\\\\times10^{%s}\"). - -When nil, no transformation is made." - :group 'org-export-e-latex - :type '(choice - (string :tag "Format string") - (const :tag "No formatting"))) - - -;;;; Text markup - -(defcustom org-e-latex-text-markup-alist '((bold . "\\textbf{%s}") - (code . verb) - (italic . "\\emph{%s}") - (strike-through . "\\st{%s}") - (underline . "\\underline{%s}") - (verbatim . protectedtexttt)) - "Alist of LaTeX expressions to convert text markup. - -The key must be a symbol among `bold', `code', `italic', -`strike-through', `underline' and `verbatim'. The value is -a formatting string to wrap fontified text with. - -Value can also be set to the following symbols: `verb' and -`protectedtexttt'. For the former, Org will use \"\\verb\" to -create a format string and select a delimiter character that -isn't in the string. For the latter, Org will use \"\\texttt\" -to typeset and try to protect special characters. - -If no association can be found for a given markup, text will be -returned as-is." - :group 'org-export-e-latex - :type 'alist - :options '(bold code italic strike-through underline verbatim)) - - -;;;; Drawers - -(defcustom org-e-latex-format-drawer-function nil - "Function called to format a drawer in LaTeX code. - -The function must accept two parameters: - NAME the drawer name, like \"LOGBOOK\" - CONTENTS the contents of the drawer. - -The function should return the string to be exported. - -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-e-latex-format-drawer-default \(name contents\) - \"Format a drawer element for LaTeX export.\" - contents\)" - :group 'org-export-e-latex - :type 'function) - - -;;;; Inlinetasks - -(defcustom org-e-latex-format-inlinetask-function nil - "Function called to format an inlinetask in LaTeX code. - -The function must accept six parameters: - TODO the todo keyword, as a string - TODO-TYPE the todo type, a symbol among `todo', `done' and nil. - PRIORITY the inlinetask priority, as a string - NAME the inlinetask name, as a string. - TAGS the inlinetask tags, as a list of strings. - CONTENTS the contents of the inlinetask, as a string. - -The function should return the string to be exported. - -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-e-latex-format-inlinetask \(todo type priority name tags contents\) -\"Format an inline task element for LaTeX export.\" - \(let ((full-title - \(concat - \(when todo - \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo)) - \(when priority (format \"\\\\framebox{\\\\#%c} \" priority)) - title - \(when tags - \(format \"\\\\hfill{}\\\\textsc{:%s:}\" - \(mapconcat 'identity tags \":\"))))) - \(format (concat \"\\\\begin{center}\\n\" - \"\\\\fbox{\\n\" - \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\" - \"%s\\n\\n\" - \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\" - \"%s\" - \"\\\\end{minipage}}\" - \"\\\\end{center}\") - full-title contents))" - :group 'org-export-e-latex - :type 'function) - - -;; Src blocks - -(defcustom org-e-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 -package. Just add these to `org-export-latex-packages-alist', -for example using customize, or with something like: - - \(require 'org-e-latex) - \(add-to-list 'org-export-latex-packages-alist '\(\"\" \"listings\")) - \(add-to-list 'org-export-latex-packages-alist '\(\"\" \"color\")) - -Alternatively, - - \(setq org-e-latex-listings 'minted) - -causes source code to be exported using the minted package as -opposed to listings. If you want to use minted, you need to add -the minted package to `org-export-latex-packages-alist', for -example using customize, or with - - \(require 'org-e-latex) - \(add-to-list 'org-export-latex-packages-alist '\(\"\" \"minted\")) - -In addition, it is necessary to install pygments -\(http://pygments.org), and to configure the variable -`org-e-latex-pdf-process' so that the -shell-escape option is -passed to pdflatex." - :group 'org-export-e-latex - :type '(choice - (const :tag "Use listings" t) - (const :tag "Use minted" 'minted) - (const :tag "Export verbatim" nil))) - -(defcustom org-e-latex-listings-langs - '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp") - (c "C") (cc "C++") - (fortran "fortran") - (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby") - (html "HTML") (xml "XML") - (tex "TeX") (latex "TeX") - (shell-script "bash") - (gnuplot "Gnuplot") - (ocaml "Caml") (caml "Caml") - (sql "SQL") (sqlite "sql")) - "Alist mapping languages to their listing language counterpart. -The key is a symbol, the major mode symbol without the \"-mode\". -The value is the string that should be inserted as the language -parameter for the listings package. If the mode name and the -listings name are the same, the language does not need an entry -in this list - but it does not hurt if it is present." - :group 'org-export-e-latex - :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Listings language")))) - -(defcustom org-e-latex-listings-options nil - "Association list of options for the latex listings package. - -These options are supplied as a comma-separated list to the -\\lstset command. Each element of the association list should be -a list containing two strings: the name of the option, and the -value. For example, - - (setq org-e-latex-listings-options - '((\"basicstyle\" \"\\small\") - (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\"))) - -will typeset the code in a small size font with underlined, bold -black keywords. - -Note that the same options will be applied to blocks of all -languages." - :group 'org-export-e-latex - :type '(repeat - (list - (string :tag "Listings option name ") - (string :tag "Listings option value")))) - -(defcustom org-e-latex-minted-langs - '((emacs-lisp "common-lisp") - (cc "c++") - (cperl "perl") - (shell-script "bash") - (caml "ocaml")) - "Alist mapping languages to their minted language counterpart. -The key is a symbol, the major mode symbol without the \"-mode\". -The value is the string that should be inserted as the language -parameter for the minted package. If the mode name and the -listings name are the same, the language does not need an entry -in this list - but it does not hurt if it is present. - -Note that minted uses all lower case for language identifiers, -and that the full list of language identifiers can be obtained -with: - - pygmentize -L lexers" - :group 'org-export-e-latex - :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Minted language")))) - -(defcustom org-e-latex-minted-options nil - "Association list of options for the latex minted package. - -These options are supplied within square brackets in -\\begin{minted} environments. Each element of the alist should -be a list containing two strings: the name of the option, and the -value. For example, - - \(setq org-e-latex-minted-options - '\((\"bgcolor\" \"bg\") \(\"frame\" \"lines\"))) - -will result in src blocks being exported with - -\\begin{minted}[bgcolor=bg,frame=lines]{} - -as the start of the minted environment. Note that the same -options will be applied to blocks of all languages." - :group 'org-export-e-latex - :type '(repeat - (list - (string :tag "Minted option name ") - (string :tag "Minted option value")))) - -(defvar org-e-latex-custom-lang-environments nil - "Alist mapping languages to language-specific LaTeX environments. - -It is used during export of src blocks by the listings and minted -latex packages. For example, - - \(setq org-e-latex-custom-lang-environments - '\(\(python \"pythoncode\"\)\)\) - -would have the effect that if org encounters begin_src python -during latex export it will output - - \\begin{pythoncode} - - \\end{pythoncode}") - - -;;;; Plain text - -(defcustom org-e-latex-quotes - '(("fr" - ("\\(\\s-\\|[[(]\\|^\\)\"" . "«~") - ("\\(\\S-\\)\"" . "~»") - ("\\(\\s-\\|(\\|^\\)'" . "'")) - ("en" - ("\\(\\s-\\|[[(]\\|^\\)\"" . "``") - ("\\(\\S-\\)\"" . "''") - ("\\(\\s-\\|(\\|^\\)'" . "`"))) - "Alist for quotes to use when converting english double-quotes. - -The CAR of each item in this alist is the language code. -The CDR of each item in this alist is a list of three CONS: -- the first CONS defines the opening quote; -- the second CONS defines the closing quote; -- the last CONS defines single quotes. - -For each item in a CONS, the first string is a regexp -for allowed characters before/after the quote, the second -string defines the replacement string for this quote." - :group 'org-export-e-latex - :type '(list - (cons :tag "Opening quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")) - (cons :tag "Closing quote" - (string :tag "Regexp for char after ") - (string :tag "Replacement quote ")) - (cons :tag "Single quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")))) - - -;;;; Compilation - -(defcustom org-e-latex-pdf-process - '("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f") - "Commands to process a LaTeX file to a PDF file. -This is a list of strings, each of them will be given to the -shell as a command. %f in the command will be replaced by the -full file name, %b by the file base name \(i.e. without -extension) and %o by the base directory of the file. - -The reason why this is a list is that it usually takes several -runs of `pdflatex', maybe mixed with a call to `bibtex'. Org -does not have a clever mechanism to detect which of these -commands have to be run to get to a stable result, and it also -does not do any error checking. - -By default, Org uses 3 runs of `pdflatex' to do the processing. -If you have texi2dvi on your system and if that does not cause -the infamous egrep/locale bug: - - http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html - -then `texi2dvi' is the superior choice. Org does offer it as one -of the customize options. - -Alternatively, this may be a Lisp function that does the -processing, so you could use this to apply the machinery of -AUCTeX or the Emacs LaTeX mode. This function should accept the -file name as its single argument." - :group 'org-export-pdf - :type '(choice - (repeat :tag "Shell command sequence" - (string :tag "Shell command")) - (const :tag "2 runs of pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "3 runs of pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "pdflatex,bibtex,pdflatex,pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "texi2dvi" - ("texi2dvi -p -b -c -V %f")) - (const :tag "rubber" - ("rubber -d --into %o %f")) - (function))) - -(defcustom org-e-latex-logfiles-extensions - '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") - "The list of file extensions to consider as LaTeX logfiles." - :group 'org-export-e-latex - :type '(repeat (string :tag "Extension"))) - -(defcustom org-e-latex-remove-logfiles t - "Non-nil means remove the logfiles produced by PDF production. -These are the .aux, .log, .out, and .toc files." - :group 'org-export-e-latex - :type 'boolean) - - - -;;; Internal Functions - -(defun org-e-latex--caption/label-string (caption label info) - "Return caption and label LaTeX string for floats. - -CAPTION is a cons cell of secondary strings, the car being the -standard caption and the cdr its short form. LABEL is a string -representing the label. INFO is a plist holding contextual -information. - -If there's no caption nor label, return the empty string. - -For non-floats, see `org-e-latex--wrap-label'." - (let ((label-str (if label (format "\\label{%s}" label) ""))) - (cond - ((and (not caption) (not label)) "") - ((not caption) (format "\\label{%s}\n" label)) - ;; Option caption format with short name. - ((cdr caption) - (format "\\caption[%s]{%s%s}\n" - (org-export-data (cdr caption) info) - label-str - (org-export-data (car caption) info))) - ;; Standard caption format. - (t (format "\\caption{%s%s}\n" - label-str - (org-export-data (car caption) info)))))) - -(defun org-e-latex--guess-babel-language (header info) - "Set Babel's language according to LANGUAGE keyword. - -HEADER is the LaTeX header string. INFO is the plist used as -a communication channel. - -Insertion of guessed language only happens when Babel package has -explicitly been loaded. Then it is added to the rest of -package's options. - -Return the new header." - (let ((language-code (plist-get info :language))) - ;; If no language is set or Babel package is not loaded, return - ;; HEADER as-is. - (if (or (not (stringp language-code)) - (not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header))) - header - (let ((options (save-match-data - (org-split-string (match-string 1 header) ","))) - (language (cdr (assoc language-code - org-e-latex-babel-language-alist)))) - ;; If LANGUAGE is already loaded, return header. Otherwise, - ;; append LANGUAGE to other options. - (if (member language options) header - (replace-match (mapconcat 'identity - (append options (list language)) - ",") - nil nil header 1)))))) - -(defun org-e-latex--guess-inputenc (header) - "Set the coding system in inputenc to what the buffer is. -HEADER is the LaTeX header string. Return the new header." - (let* ((cs (or (ignore-errors - (latexenc-coding-system-to-inputenc - buffer-file-coding-system)) - "utf8"))) - (if (not cs) header - ;; First translate if that is requested. - (setq cs (or (cdr (assoc cs org-e-latex-inputenc-alist)) cs)) - ;; Then find the \usepackage statement and replace the option. - (replace-regexp-in-string "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}" - cs header t nil 1)))) - -(defun org-e-latex--find-verb-separator (s) - "Return a character not used in string S. -This is used to choose a separator for constructs like \\verb." - (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) - (loop for c across ll - when (not (string-match (regexp-quote (char-to-string c)) s)) - return (char-to-string c)))) - -(defun org-e-latex--make-option-string (options) - "Return a comma separated string of keywords and values. -OPTIONS is an alist where the key is the options keyword as -a string, and the value a list containing the keyword value, or -nil." - (mapconcat (lambda (pair) - (concat (first pair) - (when (> (length (second pair)) 0) - (concat "=" (second pair))))) - options - ",")) - -(defun org-e-latex--quotation-marks (text info) - "Export quotation marks depending on language conventions. -TEXT is a string containing quotation marks to be replaced. INFO -is a plist used as a communication channel." - (mapc (lambda(l) - (let ((start 0)) - (while (setq start (string-match (car l) text start)) - (let ((new-quote (concat (match-string 1 text) (cdr l)))) - (setq text (replace-match new-quote t t text)))))) - (cdr (or (assoc (plist-get info :language) org-e-latex-quotes) - ;; Falls back on English. - (assoc "en" org-e-latex-quotes)))) - text) - -(defun org-e-latex--wrap-label (element output) - "Wrap label associated to ELEMENT around OUTPUT, if appropriate. -This function shouldn't be used for floats. See -`org-e-latex--caption/label-string'." - (let ((label (org-element-property :name element))) - (if (or (not output) (not label) (string= output "") (string= label "")) - output - (concat (format "\\label{%s}\n" label) output)))) - -(defun org-e-latex--text-markup (text markup) - "Format TEXT depending on MARKUP text markup. -See `org-e-latex-text-markup-alist' for details." - (let ((fmt (cdr (assq markup org-e-latex-text-markup-alist)))) - (cond - ;; No format string: Return raw text. - ((not fmt) text) - ;; Handle the `verb' special case: Find and appropriate separator - ;; and use "\\verb" command. - ((eq 'verb fmt) - (let ((separator (org-e-latex--find-verb-separator text))) - (concat "\\verb" separator text separator))) - ;; Handle the `protectedtexttt' special case: Protect some - ;; special chars and use "\texttt{%s}" format string. - ((eq 'protectedtexttt fmt) - (let ((start 0) - (trans '(("\\" . "\\textbackslash{}") - ("~" . "\\textasciitilde{}") - ("^" . "\\textasciicircum{}"))) - (rtn "") - char) - (while (string-match "[\\{}$%&_#~^]" text) - (setq char (match-string 0 text)) - (if (> (match-beginning 0) 0) - (setq rtn (concat rtn (substring text 0 (match-beginning 0))))) - (setq text (substring text (1+ (match-beginning 0)))) - (setq char (or (cdr (assoc char trans)) (concat "\\" char)) - rtn (concat rtn char))) - (setq text (concat rtn text) - fmt "\\texttt{%s}") - (while (string-match "--" text) - (setq text (replace-match "-{}-" t t text))) - (format fmt text))) - ;; Else use format string. - (t (format fmt text))))) - -(defun org-e-latex--delayed-footnotes-definitions (element info) - "Return footnotes definitions in ELEMENT as a string. - -INFO is a plist used as a communication channel. - -Footnotes definitions are returned within \"\\footnotetxt{}\" -commands. - -This function is used within constructs that don't support -\"\\footnote{}\" command (i.e. an item's tag). In that case, -\"\\footnotemark\" is used within the construct and the function -just outside of it." - (mapconcat - (lambda (ref) - (format - "\\footnotetext[%s]{%s}" - (org-export-get-footnote-number ref info) - (org-trim - (org-export-data - (org-export-get-footnote-definition ref info) info)))) - ;; Find every footnote reference in ELEMENT. - (let* (all-refs - search-refs ; For byte-compiler. - (search-refs - (function - (lambda (data) - ;; Return a list of all footnote references never seen - ;; before in DATA. - (org-element-map - data 'footnote-reference - (lambda (ref) - (when (org-export-footnote-first-reference-p ref info) - (push ref all-refs) - (when (eq (org-element-property :type ref) 'standard) - (funcall search-refs - (org-export-get-footnote-definition ref info))))) - info) - (reverse all-refs))))) - (funcall search-refs element)) - "")) - - - -;;; Template - -(defun org-e-latex-template (contents info) - "Return complete document string after LaTeX conversion. -CONTENTS is the transcoded contents string. INFO is a plist -holding export options." - (let ((title (org-export-data (plist-get info :title) info))) - (concat - ;; Time-stamp. - (and (plist-get info :time-stamp-file) - (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) - ;; Document class and packages. - (let ((class (plist-get info :latex-class)) - (class-options (plist-get info :latex-class-options))) - (org-element-normalize-string - (let* ((header (nth 1 (assoc class org-e-latex-classes))) - (document-class-string - (and (stringp header) - (if class-options - (replace-regexp-in-string - "^[ \t]*\\\\documentclass\\(\\[.*?\\]\\)" - class-options header t nil 1) - header)))) - (when document-class-string - (org-e-latex--guess-babel-language - (org-e-latex--guess-inputenc - (org-splice-latex-header - document-class-string - org-export-latex-default-packages-alist ; defined in org.el - org-export-latex-packages-alist nil ; defined in org.el - (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) - (format "\\setcounter{secnumdepth}{%d}\n" sec-num))) - ;; Author. - (let ((author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth (org-export-data auth info))))) - (email (and (plist-get info :with-email) - (org-export-data (plist-get info :email) info)))) - (cond ((and author email (not (string= "" email))) - (format "\\author{%s\\thanks{%s}}\n" author email)) - (author (format "\\author{%s}\n" author)) - (t "\\author{}\n"))) - ;; Date. - (let ((date (org-export-data (plist-get info :date) info))) - (and date (format "\\date{%s}\n" date))) - ;; Title - (format "\\title{%s}\n" title) - ;; Hyperref options. - (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" - (or (plist-get info :keywords) "") - (or (plist-get info :description) "") - (if (not (plist-get info :with-creator)) "" - (plist-get info :creator))) - ;; Document start. - "\\begin{document}\n\n" - ;; Title command. - (org-element-normalize-string - (cond ((string= "" title) nil) - ((not (stringp org-e-latex-title-command)) nil) - ((string-match "\\(?:[^%]\\|^\\)%s" - org-e-latex-title-command) - (format org-e-latex-title-command title)) - (t org-e-latex-title-command))) - ;; Table of contents. - (let ((depth (plist-get info :with-toc))) - (when depth - (concat (when (wholenump depth) - (format "\\setcounter{tocdepth}{%d}\n" depth)) - "\\tableofcontents\n\\vspace*{1cm}\n\n"))) - ;; Document's body. - contents - ;; Creator. - (let ((creator-info (plist-get info :with-creator))) - (cond - ((not creator-info) "") - ((eq creator-info 'comment) - (format "%% %s\n" (plist-get info :creator))) - (t (concat (plist-get info :creator) "\n")))) - ;; Document end. - "\\end{document}"))) - - - -;;; Transcode Functions - -;;;; Babel Call -;; -;; Babel Calls are ignored. - - -;;;; Bold - -(defun org-e-latex-bold (bold contents info) - "Transcode BOLD from Org to LaTeX. -CONTENTS is the text with bold markup. INFO is a plist holding -contextual information." - (org-e-latex--text-markup contents 'bold)) - - -;;;; Center Block - -(defun org-e-latex-center-block (center-block contents info) - "Transcode a CENTER-BLOCK element from Org to LaTeX. -CONTENTS holds the contents of the center block. INFO is a plist -holding contextual information." - (org-e-latex--wrap-label - center-block - (format "\\begin{center}\n%s\\end{center}" contents))) - - -;;;; Clock - -(defun org-e-latex-clock (clock contents info) - "Transcode a CLOCK element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual -information." - (concat - "\\noindent" - (format "\\textbf{%s} " org-clock-string) - (format org-e-latex-inactive-timestamp-format - (concat (org-translate-time (org-element-property :value clock)) - (let ((time (org-element-property :time clock))) - (and time (format " (%s)" time))))) - "\\\\")) - - -;;;; Code - -(defun org-e-latex-code (code contents info) - "Transcode a CODE object from Org to LaTeX. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (org-e-latex--text-markup (org-element-property :value code) 'code)) - - -;;;; Comment -;; -;; Comments are ignored. - - -;;;; Comment Block -;; -;; Comment Blocks are ignored. - - -;;;; Drawer - -(defun org-e-latex-drawer (drawer contents info) - "Transcode a DRAWER element from Org to LaTeX. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let* ((name (org-element-property :drawer-name drawer)) - (output (if (functionp org-e-latex-format-drawer-function) - (funcall org-e-latex-format-drawer-function - name contents) - ;; If there's no user defined function: simply - ;; display contents of the drawer. - contents))) - (org-e-latex--wrap-label drawer output))) - - -;;;; Dynamic Block - -(defun org-e-latex-dynamic-block (dynamic-block contents info) - "Transcode a DYNAMIC-BLOCK element from Org to LaTeX. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information. See `org-export-data'." - (org-e-latex--wrap-label dynamic-block contents)) - - -;;;; Entity - -(defun org-e-latex-entity (entity contents info) - "Transcode an ENTITY object from Org to LaTeX. -CONTENTS are the definition itself. INFO is a plist holding -contextual information." - (let ((ent (org-element-property :latex entity))) - (if (org-element-property :latex-math-p entity) (format "$%s$" ent) ent))) - - -;;;; Example Block - -(defun org-e-latex-example-block (example-block contents info) - "Transcode an EXAMPLE-BLOCK element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual -information." - (org-e-latex--wrap-label - example-block - (format "\\begin{verbatim}\n%s\\end{verbatim}" - (org-export-format-code-default example-block info)))) - - -;;;; Export Block - -(defun org-e-latex-export-block (export-block contents info) - "Transcode a EXPORT-BLOCK element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (string= (org-element-property :type export-block) "LATEX") - (org-remove-indentation (org-element-property :value export-block)))) - - -;;;; Export Snippet - -(defun org-e-latex-export-snippet (export-snippet contents info) - "Transcode a EXPORT-SNIPPET object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (eq (org-export-snippet-backend export-snippet) 'e-latex) - (org-element-property :value export-snippet))) - - -;;;; Fixed Width - -(defun org-e-latex-fixed-width (fixed-width contents info) - "Transcode a FIXED-WIDTH element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-latex--wrap-label - fixed-width - (format "\\begin{verbatim}\n%s\\end{verbatim}" - (org-remove-indentation - (org-element-property :value fixed-width))))) - - -;;;; Footnote Definition -;; -;; Footnote Definitions are ignored. - - -;;;; Footnote Reference -;; -;; Footnote reference export is handled by -;; `org-e-latex-footnote-reference'. -;; -;; Internally, `org-e-latex--get-footnote-counter' is used to restore -;; the value of the LaTeX "footnote" counter after a jump due to -;; a reference to an already defined footnote. It is only needed in -;; item tags since the optional argument to \footnotemark is not -;; allowed there. - -(defun org-e-latex--get-footnote-counter (footnote-reference info) - "Return \"footnote\" counter before FOOTNOTE-REFERENCE is encountered. -INFO is a plist used as a communication channel." - ;; Find original counter value by counting number of footnote - ;; references appearing for the first time before the current - ;; footnote reference. - (let* ((label (org-element-property :label footnote-reference)) - seen-refs - search-ref ; For byte-compiler. - (search-ref - (function - (lambda (data) - ;; Search footnote references through DATA, filling - ;; SEEN-REFS along the way. - (org-element-map - data 'footnote-reference - (lambda (fn) - (let ((fn-lbl (org-element-property :label fn))) - (cond - ;; Anonymous footnote match: return number. - ((eq fn footnote-reference) (length seen-refs)) - ;; Anonymous footnote: it's always a new one. - ;; Also, be sure to return nil from the `cond' so - ;; `first-match' doesn't get us out of the loop. - ((not fn-lbl) (push 'inline seen-refs) nil) - ;; Label not seen so far: add it so SEEN-REFS. - ;; - ;; Also search for subsequent references in - ;; footnote definition so numbering follows reading - ;; logic. Note that we don't have to care about - ;; inline definitions, since `org-element-map' - ;; already traverse them at the right time. - ((not (member fn-lbl seen-refs)) - (push fn-lbl seen-refs) - (funcall search-ref - (org-export-get-footnote-definition fn info)))))) - ;; Don't enter footnote definitions since it will happen - ;; when their first reference is found. - info 'first-match 'footnote-definition))))) - (funcall search-ref (plist-get info :parse-tree)))) - -(defun org-e-latex-footnote-reference (footnote-reference contents info) - "Transcode a FOOTNOTE-REFERENCE element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (concat - ;; Insert separator between two footnotes in a row. - (let ((prev (org-export-get-previous-element footnote-reference info))) - (when (eq (org-element-type prev) 'footnote-reference) - org-e-latex-footnote-separator)) - (cond - ;; Use \footnotemark if reference is within an item's tag. - ((eq (org-element-type (org-export-get-parent-element footnote-reference)) - 'item) - (if (org-export-footnote-first-reference-p footnote-reference info) - "\\footnotemark" - ;; Since we can't specify footnote number as an optional - ;; argument within an item tag, some extra work has to be done - ;; when the footnote has already been referenced. In that - ;; case, set footnote counter to the desired number, use the - ;; footnotemark, then set counter back to its original value. - (format - "\\setcounter{footnote}{%s}\\footnotemark\\setcounter{footnote}{%s}" - (1- (org-export-get-footnote-number footnote-reference info)) - (org-e-latex--get-footnote-counter footnote-reference info)))) - ;; Use \footnotemark if the footnote has already been defined. - ((not (org-export-footnote-first-reference-p footnote-reference info)) - (format "\\footnotemark[%s]{}" - (org-export-get-footnote-number footnote-reference info))) - ;; Use \footnotemark if reference is within another footnote - ;; reference or footnote definition. - ((loop for parent in (org-export-get-genealogy footnote-reference) - thereis (memq (org-element-type parent) - '(footnote-reference footnote-definition))) - "\\footnotemark") - ;; Otherwise, define it with \footnote command. - (t - (let ((def (org-export-get-footnote-definition footnote-reference info))) - (unless (eq (org-element-type def) 'org-data) - (setq def (cons 'org-data (cons nil def)))) - (concat - (format "\\footnote{%s}" (org-trim (org-export-data def info))) - ;; Retrieve all footnote references within the footnote and - ;; add their definition after it, since LaTeX doesn't support - ;; them inside. - (org-e-latex--delayed-footnotes-definitions def info))))))) - - -;;;; Headline - -(defun org-e-latex-headline (headline contents info) - "Transcode an HEADLINE element from Org to LaTeX. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - (let* ((class (plist-get info :latex-class)) - (level (org-export-get-relative-level headline info)) - (numberedp (org-export-numbered-headline-p headline info)) - (class-sectionning (assoc class org-e-latex-classes)) - ;; Section formatting will set two placeholders: one for the - ;; title and the other for the contents. - (section-fmt - (let ((sec (if (and (symbolp (nth 2 class-sectionning)) - (fboundp (nth 2 class-sectionning))) - (funcall (nth 2 class-sectionning) level numberedp) - (nth (1+ level) class-sectionning)))) - (cond - ;; No section available for that LEVEL. - ((not sec) nil) - ;; Section format directly returned by a function. - ((stringp sec) sec) - ;; (numbered-section . unnumbered-section) - ((not (consp (cdr sec))) - (concat (funcall (if numberedp #'car #'cdr) sec) "\n%s")) - ;; (numbered-open numbered-close) - ((= (length sec) 2) - (when numberedp (concat (car sec) "\n%s" (nth 1 sec)))) - ;; (num-in num-out no-num-in no-num-out) - ((= (length sec) 4) - (if numberedp (concat (car sec) "\n%s" (nth 1 sec)) - (concat (nth 2 sec) "\n%s" (nth 3 sec))))))) - (text (org-export-data (org-element-property :title headline) info)) - (todo - (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data todo info))))) - (todo-type (and todo (org-element-property :todo-type headline))) - (tags (and (plist-get info :with-tags) - (org-export-get-tags headline info))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority headline))) - ;; Create the headline text along with a no-tag version. The - ;; latter is required to remove tags from table of contents. - (full-text (if (functionp org-e-latex-format-headline-function) - ;; User-defined formatting function. - (funcall org-e-latex-format-headline-function - todo todo-type priority text tags) - ;; Default formatting. - (concat - (when todo - (format "\\textbf{\\textsf{\\textsc{%s}}} " todo)) - (when priority (format "\\framebox{\\#%c} " priority)) - text - (when tags - (format "\\hfill{}\\textsc{:%s:}" - (mapconcat 'identity tags ":")))))) - (full-text-no-tag - (if (functionp org-e-latex-format-headline-function) - ;; User-defined formatting function. - (funcall org-e-latex-format-headline-function - todo todo-type priority text nil) - ;; Default formatting. - (concat - (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo)) - (when priority (format "\\framebox{\\#%c} " priority)) - text))) - ;; Associate some \label to the headline for internal links. - (headline-label - (format "\\label{sec-%s}\n" - (mapconcat 'number-to-string - (org-export-get-headline-number headline info) - "-"))) - (pre-blanks - (make-string (org-element-property :pre-blank headline) 10))) - (cond - ;; Case 1: This is a footnote section: ignore it. - ((org-element-property :footnote-section-p headline) nil) - ;; Case 2. This is a deep sub-tree: export it as a list item. - ;; Also export as items headlines for which no section - ;; format has been found. - ((or (not section-fmt) (org-export-low-level-p headline info)) - ;; Build the real contents of the sub-tree. - (let ((low-level-body - (concat - ;; If the headline is the first sibling, start a list. - (when (org-export-first-sibling-p headline info) - (format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize))) - ;; Itemize headline - "\\item " full-text "\n" headline-label pre-blanks contents))) - ;; If headline is not the last sibling simply return - ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any - ;; blank line. - (if (not (org-export-last-sibling-p headline info)) low-level-body - (replace-regexp-in-string - "[ \t\n]*\\'" - (format "\n\\\\end{%s}" (if numberedp 'enumerate 'itemize)) - low-level-body)))) - ;; Case 3. Standard headline. Export it as a section. - (t - (cond - ((not (and tags (eq (plist-get info :with-tags) 'not-in-toc))) - ;; Regular section. Use specified format string. - (format section-fmt full-text - (concat headline-label pre-blanks contents))) - ((string-match "\\`\\\\\\(.*?\\){" section-fmt) - ;; If tags should be removed from table of contents, insert - ;; title without tags as an alternative heading in sectioning - ;; command. - (format (replace-match (concat (match-string 1 section-fmt) "[%s]") - nil nil section-fmt 1) - ;; Replace square brackets with parenthesis since - ;; square brackets are not supported in optional - ;; arguments. - (replace-regexp-in-string - "\\[" "(" - (replace-regexp-in-string - "\\]" ")" - full-text-no-tag)) - full-text - (concat headline-label pre-blanks contents))) - (t - ;; Impossible to add an alternative heading. Fallback to - ;; regular sectioning format string. - (format section-fmt full-text - (concat headline-label pre-blanks contents)))))))) - - -;;;; Horizontal Rule - -(defun org-e-latex-horizontal-rule (horizontal-rule contents info) - "Transcode an HORIZONTAL-RULE object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((attr (org-export-read-attribute :attr_latex horizontal-rule)) - (prev (org-export-get-previous-element horizontal-rule info))) - (concat - ;; Make sure the rule doesn't start at the end of the current - ;; line by separating it with a blank line from previous element. - (when (and prev - (let ((prev-blank (org-element-property :post-blank prev))) - (or (not prev-blank) (zerop prev-blank)))) - "\n") - (org-e-latex--wrap-label - horizontal-rule - (format "\\rule{%s}{%s}" - (or (plist-get attr :width) "\\linewidth") - (or (plist-get attr :thickness) "0.5pt")))))) - - -;;;; Inline Babel Call -;; -;; Inline Babel Calls are ignored. - - -;;;; Inline Src Block - -(defun org-e-latex-inline-src-block (inline-src-block contents info) - "Transcode an INLINE-SRC-BLOCK element from Org to LaTeX. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((code (org-element-property :value inline-src-block)) - (separator (org-e-latex--find-verb-separator code))) - (cond - ;; Do not use a special package: transcode it verbatim. - ((not org-e-latex-listings) - (concat "\\verb" separator code separator)) - ;; Use minted package. - ((eq org-e-latex-listings 'minted) - (let* ((org-lang (org-element-property :language inline-src-block)) - (mint-lang (or (cadr (assq (intern org-lang) - org-e-latex-minted-langs)) - org-lang)) - (options (org-e-latex--make-option-string - org-e-latex-minted-options))) - (concat (format "\\mint%s{%s}" - (if (string= options "") "" (format "[%s]" options)) - mint-lang) - separator code separator))) - ;; Use listings package. - (t - ;; Maybe translate language's name. - (let* ((org-lang (org-element-property :language inline-src-block)) - (lst-lang (or (cadr (assq (intern org-lang) - org-e-latex-listings-langs)) - org-lang)) - (options (org-e-latex--make-option-string - (append org-e-latex-listings-options - `(("language" ,lst-lang)))))) - (concat (format "\\lstinline[%s]" options) - separator code separator)))))) - - -;;;; Inlinetask - -(defun org-e-latex-inlinetask (inlinetask contents info) - "Transcode an INLINETASK element from Org to LaTeX. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let ((title (org-export-data (org-element-property :title inlinetask) info)) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword inlinetask))) - (and todo (org-export-data todo info))))) - (todo-type (org-element-property :todo-type inlinetask)) - (tags (and (plist-get info :with-tags) - (org-export-get-tags inlinetask info))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority inlinetask)))) - ;; If `org-e-latex-format-inlinetask-function' is provided, call it - ;; with appropriate arguments. - (if (functionp org-e-latex-format-inlinetask-function) - (funcall org-e-latex-format-inlinetask-function - todo todo-type priority title tags contents) - ;; Otherwise, use a default template. - (org-e-latex--wrap-label - inlinetask - (let ((full-title - (concat - (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo)) - (when priority (format "\\framebox{\\#%c} " priority)) - title - (when tags (format "\\hfill{}\\textsc{:%s:}" - (mapconcat 'identity tags ":")))))) - (format (concat "\\begin{center}\n" - "\\fbox{\n" - "\\begin{minipage}[c]{.6\\textwidth}\n" - "%s\n\n" - "\\rule[.8em]{\\textwidth}{2pt}\n\n" - "%s" - "\\end{minipage}\n" - "}\n" - "\\end{center}") - full-title contents)))))) - - -;;;; Italic - -(defun org-e-latex-italic (italic contents info) - "Transcode ITALIC from Org to LaTeX. -CONTENTS is the text with italic markup. INFO is a plist holding -contextual information." - (org-e-latex--text-markup contents 'italic)) - - -;;;; Item - -(defun org-e-latex-item (item contents info) - "Transcode an ITEM element from Org to LaTeX. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((counter - (let ((count (org-element-property :counter item)) - (level - (loop for parent in (org-export-get-genealogy item) - count (eq (org-element-type parent) 'plain-list) - until (eq (org-element-type parent) 'headline)))) - (and count - (< level 5) - (format "\\setcounter{enum%s}{%s}\n" - (nth (1- level) '("i" "ii" "iii" "iv")) - (1- count))))) - (checkbox (case (org-element-property :checkbox item) - (on "$\\boxtimes$ ") - (off "$\\Box$ ") - (trans "$\\boxminus$ "))) - (tag (let ((tag (org-element-property :tag item))) - ;; Check-boxes must belong to the tag. - (and tag (format "[%s] " - (concat checkbox - (org-export-data tag info))))))) - (concat counter "\\item" (or tag (concat " " checkbox)) - (and contents (org-trim contents)) - ;; If there are footnotes references in tag, be sure to - ;; add their definition at the end of the item. This - ;; workaround is necessary since "\footnote{}" command is - ;; not supported in tags. - (and tag - (org-e-latex--delayed-footnotes-definitions - (org-element-property :tag item) info))))) - - -;;;; Keyword - -(defun org-e-latex-keyword (keyword contents info) - "Transcode a KEYWORD element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((key (org-element-property :key keyword)) - (value (org-element-property :value keyword))) - (cond - ((string= key "LATEX") value) - ((string= key "INDEX") (format "\\index{%s}" value)) - ;; Invisible targets. - ((string= key "TARGET") nil) - ((string= key "TOC") - (let ((value (downcase value))) - (cond - ((string-match "\\" value) - (let ((depth (or (and (string-match "[0-9]+" value) - (string-to-number (match-string 0 value))) - (plist-get info :with-toc)))) - (concat - (when (wholenump depth) - (format "\\setcounter{tocdepth}{%s}\n" depth)) - "\\tableofcontents"))) - ((string= "tables" value) "\\listoftables") - ((string= "figures" value) "\\listoffigures") - ((string= "listings" value) - (cond - ((eq org-e-latex-listings 'minted) "\\listoflistings") - (org-e-latex-listings "\\lstlistoflistings") - ;; At the moment, src blocks with a caption are wrapped - ;; into a figure environment. - (t "\\listoffigures"))))))))) - - -;;;; Latex Environment - -(defun org-e-latex-latex-environment (latex-environment contents info) - "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((label (org-element-property :name latex-environment)) - (value (org-remove-indentation - (org-element-property :value latex-environment)))) - (if (not (org-string-nw-p label)) value - ;; Environment is labelled: label must be within the environment - ;; (otherwise, a reference pointing to that element will count - ;; the section instead). - (with-temp-buffer - (insert value) - (goto-char (point-min)) - (forward-line) - (insert (format "\\label{%s}\n" label)) - (buffer-string))))) - - -;;;; Latex Fragment - -(defun org-e-latex-latex-fragment (latex-fragment contents info) - "Transcode a LATEX-FRAGMENT object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-element-property :value latex-fragment)) - - -;;;; Line Break - -(defun org-e-latex-line-break (line-break contents info) - "Transcode a LINE-BREAK object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - "\\\\") - - -;;;; Link - -(defun org-e-latex-link--inline-image (link info) - "Return LaTeX code for an inline image. -LINK is the link pointing to the inline image. INFO is a plist -used as a communication channel." - (let* ((parent (org-export-get-parent-element link)) - (path (let ((raw-path (org-element-property :path link))) - (if (not (file-name-absolute-p raw-path)) raw-path - (expand-file-name raw-path)))) - (caption (org-e-latex--caption/label-string - (org-element-property :caption parent) - (org-element-property :name parent) - info)) - ;; Retrieve latex attributes from the element around. - (attr (let ((raw-attr - (mapconcat #'identity - (org-element-property :attr_latex parent) - " "))) - (unless (string= raw-attr "") raw-attr))) - (disposition - (cond - ((and attr (string-match "\\" attr)) 'wrap) - ((and attr (string-match "\\" attr)) 'multicolumn) - ((or (and attr (string-match "\\" attr)) - (not (string= caption ""))) - 'float))) - (placement - (cond - ((and attr (string-match "\\" paralist-regexp) attr)) - (match-string 1 attr)) - ((eq type 'ordered) "enumerate") - ((eq type 'unordered) "itemize") - ((eq type 'descriptive) "description")))) - (org-e-latex--wrap-label - plain-list - (format "\\begin{%s}%s\n%s\\end{%s}" - latex-type - ;; Once special environment, if any, has been removed, the - ;; rest of the attributes will be optional arguments. - ;; They will be put inside square brackets if necessary. - (let ((opt (replace-regexp-in-string - (format " *%s *" paralist-regexp) "" attr))) - (cond ((string= opt "") "") - ((string-match "\\`\\[[^][]+\\]\\'" opt) opt) - (t (format "[%s]" opt)))) - contents - latex-type)))) - - -;;;; Plain Text - -(defun org-e-latex-plain-text (text info) - "Transcode a TEXT string from Org to LaTeX. -TEXT is the string to transcode. INFO is a plist holding -contextual information." - ;; Protect %, #, &, $, ~, ^, _, { and }. - (while (string-match "\\([^\\]\\|^\\)\\([%$#&{}~^_]\\)" text) - (setq text - (replace-match (format "\\%s" (match-string 2 text)) nil t text 2))) - ;; Protect \ - (setq text (replace-regexp-in-string - "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)" - "$\\backslash$" text nil t 1)) - ;; LaTeX into \LaTeX{} and TeX into \TeX{}. - (let ((case-fold-search nil) - (start 0)) - (while (string-match "\\<\\(\\(?:La\\)?TeX\\)\\>" text start) - (setq text (replace-match - (format "\\%s{}" (match-string 1 text)) nil t text) - start (match-end 0)))) - ;; Handle quotation marks - (setq text (org-e-latex--quotation-marks text info)) - ;; Convert special strings. - (when (plist-get info :with-special-strings) - (while (string-match (regexp-quote "...") text) - (setq text (replace-match "\\ldots{}" nil t text)))) - ;; Handle break preservation if required. - (when (plist-get info :preserve-breaks) - (setq text (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" - text))) - ;; Return value. - text) - - -;;;; Planning - -(defun org-e-latex-planning (planning contents info) - "Transcode a PLANNING element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual -information." - (concat - "\\noindent" - (mapconcat - 'identity - (delq nil - (list - (let ((closed (org-element-property :closed planning))) - (when closed - (concat - (format "\\textbf{%s} " org-closed-string) - (format org-e-latex-inactive-timestamp-format - (org-translate-time closed))))) - (let ((deadline (org-element-property :deadline planning))) - (when deadline - (concat - (format "\\textbf{%s} " org-deadline-string) - (format org-e-latex-active-timestamp-format - (org-translate-time deadline))))) - (let ((scheduled (org-element-property :scheduled planning))) - (when scheduled - (concat - (format "\\textbf{%s} " org-scheduled-string) - (format org-e-latex-active-timestamp-format - (org-translate-time scheduled))))))) - " ") - "\\\\")) - - -;;;; Property Drawer - -(defun org-e-latex-property-drawer (property-drawer contents info) - "Transcode a PROPERTY-DRAWER element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual -information." - ;; The property drawer isn't exported but we want separating blank - ;; lines nonetheless. - "") - - -;;;; Quote Block - -(defun org-e-latex-quote-block (quote-block contents info) - "Transcode a QUOTE-BLOCK element from Org to LaTeX. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (org-e-latex--wrap-label - quote-block - (format "\\begin{quote}\n%s\\end{quote}" contents))) - - -;;;; Quote Section - -(defun org-e-latex-quote-section (quote-section contents info) - "Transcode a QUOTE-SECTION element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((value (org-remove-indentation - (org-element-property :value quote-section)))) - (when value (format "\\begin{verbatim}\n%s\\end{verbatim}" value)))) - - -;;;; Radio Target - -(defun org-e-latex-radio-target (radio-target text info) - "Transcode a RADIO-TARGET object from Org to LaTeX. -TEXT is the text of the target. INFO is a plist holding -contextual information." - (format "\\label{%s}%s" - (org-export-solidify-link-text - (org-element-property :value radio-target)) - text)) - - -;;;; Section - -(defun org-e-latex-section (section contents info) - "Transcode a SECTION element from Org to LaTeX. -CONTENTS holds the contents of the section. INFO is a plist -holding contextual information." - contents) - - -;;;; Special Block - -(defun org-e-latex-special-block (special-block contents info) - "Transcode a SPECIAL-BLOCK element from Org to LaTeX. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let ((type (downcase (org-element-property :type special-block)))) - (org-e-latex--wrap-label - special-block - (format "\\begin{%s}\n%s\\end{%s}" type contents type)))) - - -;;;; Src Block - -(defun org-e-latex-src-block (src-block contents info) - "Transcode a SRC-BLOCK element from Org to LaTeX. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((lang (org-element-property :language src-block)) - (caption (org-element-property :caption src-block)) - (label (org-element-property :name src-block)) - (custom-env (and lang - (cadr (assq (intern lang) - org-e-latex-custom-lang-environments)))) - (num-start (case (org-element-property :number-lines src-block) - (continued (org-export-get-loc src-block info)) - (new 0))) - (retain-labels (org-element-property :retain-labels src-block))) - (cond - ;; Case 1. No source fontification. - ((not org-e-latex-listings) - (let ((caption-str (org-e-latex--caption/label-string caption label info)) - (float-env (when caption "\\begin{figure}[H]\n%s\n\\end{figure}"))) - (format - (or float-env "%s") - (concat caption-str - (format "\\begin{verbatim}\n%s\\end{verbatim}" - (org-export-format-code-default src-block info)))))) - ;; Case 2. Custom environment. - (custom-env (format "\\begin{%s}\n%s\\end{%s}\n" - custom-env - (org-export-format-code-default src-block info) - custom-env)) - ;; Case 3. Use minted package. - ((eq org-e-latex-listings 'minted) - (let ((float-env (when (or label caption) - (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}" - (org-e-latex--caption/label-string - caption label info)))) - (body - (format - "\\begin{minted}[%s]{%s}\n%s\\end{minted}" - ;; Options. - (org-e-latex--make-option-string - (if (not num-start) org-e-latex-minted-options - (append `(("linenos") - ("firstnumber" ,(number-to-string (1+ num-start)))) - org-e-latex-minted-options))) - ;; Language. - (or (cadr (assq (intern lang) org-e-latex-minted-langs)) lang) - ;; Source code. - (let* ((code-info (org-export-unravel-code src-block)) - (max-width - (apply 'max - (mapcar 'length - (org-split-string (car code-info) "\n"))))) - (org-export-format-code - (car code-info) - (lambda (loc num ref) - (concat - loc - (when ref - ;; Ensure references are flushed to the right, - ;; separated with 6 spaces from the widest line - ;; of code. - (concat (make-string (+ (- max-width (length loc)) 6) ? ) - (format "(%s)" ref))))) - nil (and retain-labels (cdr code-info))))))) - ;; Return value. - (if float-env (format float-env body) body))) - ;; Case 4. Use listings package. - (t - (let ((lst-lang - (or (cadr (assq (intern lang) org-e-latex-listings-langs)) lang)) - (caption-str - (when caption - (let ((main (org-export-data (car caption) info))) - (if (not (cdr caption)) (format "{%s}" main) - (format "{[%s]%s}" - (org-export-data (cdr caption) info) - main)))))) - (concat - ;; Options. - (format "\\lstset{%s}\n" - (org-e-latex--make-option-string - (append org-e-latex-listings-options - `(("language" ,lst-lang)) - (when label `(("label" ,label))) - (when caption-str `(("caption" ,caption-str))) - (cond ((not num-start) '(("numbers" "none"))) - ((zerop num-start) '(("numbers" "left"))) - (t `(("numbers" "left") - ("firstnumber" - ,(number-to-string (1+ num-start))))))))) - ;; Source code. - (format - "\\begin{lstlisting}\n%s\\end{lstlisting}" - (let* ((code-info (org-export-unravel-code src-block)) - (max-width - (apply 'max - (mapcar 'length - (org-split-string (car code-info) "\n"))))) - (org-export-format-code - (car code-info) - (lambda (loc num ref) - (concat - loc - (when ref - ;; Ensure references are flushed to the right, - ;; separated with 6 spaces from the widest line of - ;; code - (concat (make-string (+ (- max-width (length loc)) 6) ? ) - (format "(%s)" ref))))) - nil (and retain-labels (cdr code-info))))))))))) - - -;;;; Statistics Cookie - -(defun org-e-latex-statistics-cookie (statistics-cookie contents info) - "Transcode a STATISTICS-COOKIE object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (replace-regexp-in-string - "%" "\\%" (org-element-property :value statistics-cookie) nil t)) - - -;;;; Strike-Through - -(defun org-e-latex-strike-through (strike-through contents info) - "Transcode STRIKE-THROUGH from Org to LaTeX. -CONTENTS is the text with strike-through markup. INFO is a plist -holding contextual information." - (org-e-latex--text-markup contents 'strike-through)) - - -;;;; Subscript - -(defun org-e-latex-subscript (subscript contents info) - "Transcode a SUBSCRIPT object from Org to LaTeX. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (if (= (length contents) 1) (format "$_%s$" contents) - ;; Handle multiple objects in SUBSCRIPT by creating a subscript - ;; command for each of them. - (let ((prev-blanks 0)) - (mapconcat - (lambda (obj) - (case (org-element-type obj) - ((entity latex-fragment) - (setq prev-blanks (org-element-property :post-blank obj)) - (let ((data (org-trim (org-export-data obj info)))) - (string-match - "\\`\\(?:\\\\[([]\\|\\$+\\)?\\(.*?\\)\\(?:\\\\[])]\\|\\$+\\)?\\'" - data) - (format "$_{%s}$" (match-string 1 data)))) - (plain-text - (format "$_\\mathrm{%s}$" - (concat (make-string prev-blanks ? ) - ;; mathrm command doesn't handle spaces, - ;; so we have to enforce them. - (replace-regexp-in-string - " " "\\\\ " (org-export-data obj info))))) - (otherwise - (setq prev-blanks (org-element-property :post-blank obj)) - (format "$_{%s}$" (org-export-data obj info))))) - (org-element-contents subscript) "")))) - - -;;;; Superscript - -(defun org-e-latex-superscript (superscript contents info) - "Transcode a SUPERSCRIPT object from Org to LaTeX. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (if (= (length contents) 1) (format "$^%s$" contents) - ;; Handle multiple objects in SUPERSCRIPT by creating - ;; a superscript command for each of them. - (let ((prev-blanks 0)) - (mapconcat - (lambda (obj) - (case (org-element-type obj) - ((entity latex-fragment) - (setq prev-blanks (org-element-property :post-blank obj)) - (let ((data (org-trim (org-export-data obj info)))) - (string-match - "\\`\\(?:\\\\[([]\\|\\$+\\)?\\(.*?\\)\\(?:\\\\[])]\\|\\$+\\)?\\'" - data) - (format "$^{%s}$" (match-string 1 data)))) - (plain-text - (format "$^\\mathrm{%s}$" - (concat (make-string prev-blanks ? ) - ;; mathrm command doesn't handle spaces, - ;; so we have to enforce them. - (replace-regexp-in-string - " " "\\\\ " (org-export-data obj info))))) - (otherwise - (setq prev-blanks (org-element-property :post-blank obj)) - (format "$^{%s}$" (org-export-data obj info))))) - (org-element-contents superscript) "")))) - - -;;;; Table -;; -;; `org-e-latex-table' is the entry point for table transcoding. It -;; takes care of tables with a "verbatim" attribute. Otherwise, it -;; delegates the job to either `org-e-latex-table--table.el-table' or -;; `org-e-latex-table--org-table' functions, depending of the type of -;; the table. -;; -;; `org-e-latex-table--align-string' is a subroutine used to build -;; alignment string for Org tables. - -(defun org-e-latex-table (table contents info) - "Transcode a TABLE element from Org to LaTeX. -CONTENTS is the contents of the table. INFO is a plist holding -contextual information." - (cond - ;; Case 1: verbatim table. - ((or org-e-latex-tables-verbatim - (let ((attr (mapconcat 'identity - (org-element-property :attr_latex table) - " "))) - (and attr (string-match "\\" attr)))) - (format "\\begin{verbatim}\n%s\n\\end{verbatim}" - ;; Re-create table, without affiliated keywords. - (org-trim - (org-element-interpret-data - `(table nil ,@(org-element-contents table)))))) - ;; Case 2: table.el table. Convert it using appropriate tools. - ((eq (org-element-property :type table) 'table.el) - (org-e-latex-table--table.el-table table contents info)) - ;; Case 3: Standard table. - (t (org-e-latex-table--org-table table contents info)))) - -(defun org-e-latex-table--align-string (table info) - "Return an appropriate LaTeX alignment string. -TABLE is the considered table. INFO is a plist used as -a communication channel." - (let ((attr (mapconcat 'identity - (org-element-property :attr_latex table) - " "))) - (if (string-match "\\" attr) "longtable") - ((string-match "\\" attr) - (org-match-string-no-properties 0 attr)) - (t org-e-latex-default-table-environment))) - ;; If table is a float, determine environment: table, table* - ;; or sidewaystable. - (float-env (cond - ((string= "longtable" table-env) nil) - ((and attr (string-match "\\" attr)) - "sidewaystable") - ((and attr - (or (string-match (regexp-quote "table*") attr) - (string-match "\\" attr))) - "table*") - ((or (not (string= caption "")) label) "table"))) - ;; Extract others display options. - (width (and attr (string-match "\\" attr)) - (let ((n 0) (pos 0)) - (while (and (< (length output) pos) - (setq pos (string-match "^\\\\hline\n?" output pos))) - (incf n) - (unless (= n 2) - (setq output (replace-match "" nil nil output))))))) - (if (not org-e-latex-tables-centered) output - (format "\\begin{center}\n%s\n\\end{center}" output)))) - - -;;;; Table Cell - -(defun org-e-latex-table-cell (table-cell contents info) - "Transcode a TABLE-CELL element from Org to LaTeX. -CONTENTS is the cell contents. INFO is a plist used as -a communication channel." - (concat (if (and contents - org-e-latex-table-scientific-notation - (string-match orgtbl-exp-regexp contents)) - ;; Use appropriate format string for scientific - ;; notation. - (format org-e-latex-table-scientific-notation - (match-string 1 contents) - (match-string 2 contents)) - contents) - (when (org-export-get-next-element table-cell info) " & "))) - - -;;;; Table Row - -(defun org-e-latex-table-row (table-row contents info) - "Transcode a TABLE-ROW element from Org to LaTeX. -CONTENTS is the contents of the row. INFO is a plist used as -a communication channel." - ;; Rules are ignored since table separators are deduced from - ;; borders of the current row. - (when (eq (org-element-property :type table-row) 'standard) - (let* ((attr (mapconcat 'identity - (org-element-property - :attr_latex (org-export-get-parent table-row)) - " ")) - (longtablep (and attr (string-match "\\" attr))) - (booktabsp - (or (and attr (string-match "\\" attr)) - org-e-latex-tables-booktabs)) - ;; TABLE-ROW's borders are extracted from its first cell. - (borders - (org-export-table-cell-borders - (car (org-element-contents table-row)) info))) - (concat - ;; When BOOKTABS are activated enforce top-rule even when no - ;; hline was specifically marked. - (cond ((and booktabsp (memq 'top borders)) "\\toprule\n") - ((and (memq 'top borders) (memq 'above borders)) "\\hline\n")) - contents "\\\\\n" - (cond - ;; Special case for long tables. Define header and footers. - ((and longtablep (org-export-table-row-ends-header-p table-row info)) - (format "%s -\\endhead -%s\\multicolumn{%d}{r}{Continued on next page} \\\\ -\\endfoot -\\endlastfoot" - (if booktabsp "\\midrule" "\\hline") - (if booktabsp "\\midrule" "\\hline") - ;; Number of columns. - (cdr (org-export-table-dimensions - (org-export-get-parent-table table-row) info)))) - ;; When BOOKTABS are activated enforce bottom rule even when - ;; no hline was specifically marked. - ((and booktabsp (memq 'bottom borders)) "\\bottomrule") - ((and (memq 'bottom borders) (memq 'below borders)) "\\hline") - ((memq 'below borders) (if booktabsp "\\midrule" "\\hline"))))))) - - -;;;; Target - -(defun org-e-latex-target (target contents info) - "Transcode a TARGET object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual -information." - (format "\\label{%s}" - (org-export-solidify-link-text (org-element-property :value target)))) - - -;;;; Timestamp - -(defun org-e-latex-timestamp (timestamp contents info) - "Transcode a TIMESTAMP object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual -information." - (let ((value (org-translate-time (org-element-property :value timestamp))) - (range-end (org-element-property :range-end timestamp))) - (case (org-element-property :type timestamp) - (active (format org-e-latex-active-timestamp-format value)) - (active-range - (concat (format org-e-latex-active-timestamp-format value) - "--" - (format org-e-latex-active-timestamp-format - (org-translate-time range-end)))) - (inactive (format org-e-latex-inactive-timestamp-format value)) - (inactive-range - (concat (format org-e-latex-inactive-timestamp-format value) - "--" - (format org-e-latex-inactive-timestamp-format - (org-translate-time range-end)))) - (otherwise (format org-e-latex-diary-timestamp-format value))))) - - -;;;; Underline - -(defun org-e-latex-underline (underline contents info) - "Transcode UNDERLINE from Org to LaTeX. -CONTENTS is the text with underline markup. INFO is a plist -holding contextual information." - (org-e-latex--text-markup contents 'underline)) - - -;;;; Verbatim - -(defun org-e-latex-verbatim (verbatim contents info) - "Transcode a VERBATIM object from Org to LaTeX. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (org-e-latex--text-markup (org-element-property :value verbatim) 'verbatim)) - - -;;;; Verse Block - -(defun org-e-latex-verse-block (verse-block contents info) - "Transcode a VERSE-BLOCK element from Org to LaTeX. -CONTENTS is verse block contents. INFO is a plist holding -contextual information." - (org-e-latex--wrap-label - verse-block - ;; In a verse environment, add a line break to each newline - ;; character and change each white space at beginning of a line - ;; into a space of 1 em. Also change each blank line with - ;; a vertical space of 1 em. - (progn - (setq contents (replace-regexp-in-string - "^ *\\\\\\\\$" "\\\\vspace*{1em}" - (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" contents))) - (while (string-match "^[ \t]+" contents) - (let ((new-str (format "\\hspace*{%dem}" - (length (match-string 0 contents))))) - (setq contents (replace-match new-str nil t contents)))) - (format "\\begin{verse}\n%s\\end{verse}" contents)))) - - - -;;; Interactive functions - -;;;###autoload -(defun org-e-latex-export-as-latex - (&optional subtreep visible-only body-only ext-plist) - "Export current buffer as a LaTeX buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Export is done in a buffer named \"*Org E-LATEX Export*\", which -will be displayed when `org-export-show-temporary-export-buffer' -is non-nil." - (interactive) - (let ((outbuf (org-export-to-buffer - 'e-latex "*Org E-LATEX Export*" - subtreep visible-only body-only ext-plist))) - (with-current-buffer outbuf (LaTeX-mode)) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window outbuf)))) - -;;;###autoload -(defun org-e-latex-export-to-latex - (&optional subtreep visible-only body-only ext-plist pub-dir) - "Export current buffer to a LaTeX file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -When optional argument PUB-DIR is set, use it as the publishing -directory. - -Return output file's name." - (interactive) - (let ((outfile (org-export-output-file-name ".tex" subtreep pub-dir))) - (org-export-to-file - 'e-latex outfile subtreep visible-only body-only ext-plist))) - -;;;###autoload -(defun org-e-latex-export-to-pdf - (&optional subtreep visible-only body-only ext-plist pub-dir) - "Export current buffer to LaTeX then process through to PDF. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -When optional argument PUB-DIR is set, use it as the publishing -directory. - -Return PDF file's name." - (interactive) - (org-e-latex-compile - (org-e-latex-export-to-latex - subtreep visible-only body-only ext-plist pub-dir))) - -(defun org-e-latex-compile (texfile) - "Compile a TeX file. - -TEXFILE is the name of the file being compiled. Processing is -done through the command specified in `org-e-latex-pdf-process'. - -Return PDF file name or an error if it couldn't be produced." - (let* ((wconfig (current-window-configuration)) - (texfile (file-truename texfile)) - (base (file-name-sans-extension texfile)) - errors) - (message (format "Processing LaTeX file %s ..." texfile)) - (unwind-protect - (progn - (cond - ;; A function is provided: Apply it. - ((functionp org-e-latex-pdf-process) - (funcall org-e-latex-pdf-process (shell-quote-argument texfile))) - ;; A list is provided: Replace %b, %f and %o with appropriate - ;; values in each command before applying it. Output is - ;; redirected to "*Org PDF LaTeX Output*" buffer. - ((consp org-e-latex-pdf-process) - (let* ((out-dir (or (file-name-directory texfile) "./")) - (outbuf (get-buffer-create "*Org PDF LaTeX Output*"))) - (mapc - (lambda (command) - (shell-command - (replace-regexp-in-string - "%b" (shell-quote-argument base) - (replace-regexp-in-string - "%f" (shell-quote-argument texfile) - (replace-regexp-in-string - "%o" (shell-quote-argument out-dir) command t t) t t) t t) - outbuf)) - org-e-latex-pdf-process) - ;; Collect standard errors from output buffer. - (setq errors (org-e-latex--collect-errors outbuf)))) - (t (error "No valid command to process to PDF"))) - (let ((pdffile (concat base ".pdf"))) - ;; Check for process failure. Provide collected errors if - ;; possible. - (if (not (file-exists-p pdffile)) - (error (concat (format "PDF file %s wasn't produced" pdffile) - (when errors (concat ": " errors)))) - ;; Else remove log files, when specified, and signal end of - ;; process to user, along with any error encountered. - (when org-e-latex-remove-logfiles - (dolist (ext org-e-latex-logfiles-extensions) - (let ((file (concat base "." ext))) - (when (file-exists-p file) (delete-file file))))) - (message (concat "Process completed" - (if (not errors) "." - (concat " with errors: " errors))))) - ;; Return output file name. - pdffile)) - (set-window-configuration wconfig)))) - -(defun org-e-latex--collect-errors (buffer) - "Collect some kind of errors from \"pdflatex\" command output. - -BUFFER is the buffer containing output. - -Return collected error types as a string, or nil if there was -none." - (with-current-buffer buffer - (save-excursion - (goto-char (point-max)) - ;; Find final "pdflatex" run. - (when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t) - (let ((case-fold-search t) - (errors "")) - (when (save-excursion - (re-search-forward "Reference.*?undefined" nil t)) - (setq errors (concat errors " [undefined reference]"))) - (when (save-excursion - (re-search-forward "Citation.*?undefined" nil t)) - (setq errors (concat errors " [undefined citation]"))) - (when (save-excursion - (re-search-forward "Undefined control sequence" nil t)) - (setq errors (concat errors " [undefined control sequence]"))) - (when (save-excursion - (re-search-forward "^! LaTeX.*?Error" nil t)) - (setq errors (concat errors " [LaTeX error]"))) - (when (save-excursion - (re-search-forward "^! Package.*?Error" nil t)) - (setq errors (concat errors " [package error]"))) - (and (org-string-nw-p errors) (org-trim errors))))))) - - -(provide 'org-e-latex) -;;; org-e-latex.el ends here diff --git a/contrib/lisp/org-e-odt.el b/contrib/lisp/org-e-odt.el deleted file mode 100644 index b52d5efe7..000000000 --- a/contrib/lisp/org-e-odt.el +++ /dev/null @@ -1,3763 +0,0 @@ -;;; org-e-odt.el --- OpenDocument Text exporter for Org-mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Jambunathan K -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; This file is not part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;;; Code: - -(eval-when-compile - (require 'cl) - (require 'table)) -(require 'format-spec) -(require 'org-export) - -;;; Define Back-End - -(org-export-define-backend e-odt - ((bold . org-e-odt-bold) - (center-block . org-e-odt-center-block) - (clock . org-e-odt-clock) - (code . org-e-odt-code) - (drawer . org-e-odt-drawer) - (dynamic-block . org-e-odt-dynamic-block) - (entity . org-e-odt-entity) - (example-block . org-e-odt-example-block) - (export-block . org-e-odt-export-block) - (export-snippet . org-e-odt-export-snippet) - (fixed-width . org-e-odt-fixed-width) - (footnote-definition . org-e-odt-footnote-definition) - (footnote-reference . org-e-odt-footnote-reference) - (headline . org-e-odt-headline) - (horizontal-rule . org-e-odt-horizontal-rule) - (inline-src-block . org-e-odt-inline-src-block) - (inlinetask . org-e-odt-inlinetask) - (italic . org-e-odt-italic) - (item . org-e-odt-item) - (keyword . org-e-odt-keyword) - (latex-environment . org-e-odt-latex-environment) - (latex-fragment . org-e-odt-latex-fragment) - (line-break . org-e-odt-line-break) - (link . org-e-odt-link) - (macro . org-e-odt-macro) - (paragraph . org-e-odt-paragraph) - (plain-list . org-e-odt-plain-list) - (plain-text . org-e-odt-plain-text) - (planning . org-e-odt-planning) - (property-drawer . org-e-odt-property-drawer) - (quote-block . org-e-odt-quote-block) - (quote-section . org-e-odt-quote-section) - (radio-target . org-e-odt-radio-target) - (section . org-e-odt-section) - (special-block . org-e-odt-special-block) - (src-block . org-e-odt-src-block) - (statistics-cookie . org-e-odt-statistics-cookie) - (strike-through . org-e-odt-strike-through) - (subscript . org-e-odt-subscript) - (superscript . org-e-odt-superscript) - (table . org-e-odt-table) - (table-cell . org-e-odt-table-cell) - (table-row . org-e-odt-table-row) - (target . org-e-odt-target) - (template . org-e-odt-template) - (timestamp . org-e-odt-timestamp) - (underline . org-e-odt-underline) - (verbatim . org-e-odt-verbatim) - (verse-block . org-e-odt-verse-block)) - :export-block "ODT" - :options-alist - ((:odt-styles-file "ODT_STYLES_FILE" nil nil t) - (:LaTeX-fragments nil "LaTeX" org-export-with-LaTeX-fragments))) - - -;;; Dependencies - -;;; Hooks - -;;; Function Declarations - -(declare-function org-id-find-id-file "org-id" (id)) -(declare-function hfy-face-to-style "htmlfontify" (fn)) -(declare-function hfy-face-or-def-to-name "htmlfontify" (fn)) -(declare-function archive-zip-extract "arc-mode" (archive name)) -(declare-function org-create-math-formula "org" (latex-frag &optional mathml-file)) -(declare-function browse-url-file-url "browse-url" (file)) -(declare-function org-solidify-link-text "org-exp" (s &optional alist)) - - - - -;;; Internal Variables - -(defconst org-e-odt-lib-dir - (file-name-directory load-file-name) - "Location of ODT exporter. -Use this to infer values of `org-e-odt-styles-dir' and -`org-e-odt-schema-dir'.") - -(defvar org-e-odt-data-dir - (expand-file-name "../../etc/" org-e-odt-lib-dir) - "Data directory for ODT exporter. -Use this to infer values of `org-e-odt-styles-dir' and -`org-e-odt-schema-dir'.") - -(defconst org-e-odt-special-string-regexps - '(("\\\\-" . "­\\1") ; shy - ("---\\([^-]\\)" . "—\\1") ; mdash - ("--\\([^-]\\)" . "–\\1") ; ndash - ("\\.\\.\\." . "…")) ; hellip - "Regular expressions for special string conversion.") - -(defconst org-e-odt-schema-dir-list - (list - (and org-e-odt-data-dir - (expand-file-name "./schema/" org-e-odt-data-dir)) ; bail out - (eval-when-compile - (and (boundp 'org-e-odt-data-dir) org-e-odt-data-dir ; see make install - (expand-file-name "./schema/" org-e-odt-data-dir)))) - "List of directories to search for OpenDocument schema files. -Use this list to set the default value of -`org-e-odt-schema-dir'. The entries in this list are -populated heuristically based on the values of `org-e-odt-lib-dir' -and `org-e-odt-data-dir'.") - -(defconst org-e-odt-styles-dir-list - (list - (and org-e-odt-data-dir - (expand-file-name "./styles/" org-e-odt-data-dir)) ; bail out - (eval-when-compile - (and (boundp 'org-e-odt-data-dir) org-e-odt-data-dir ; see make install - (expand-file-name "./styles/" org-e-odt-data-dir))) - (expand-file-name "../../etc/styles/" org-e-odt-lib-dir) ; git - (expand-file-name "./etc/styles/" org-e-odt-lib-dir) ; elpa - (expand-file-name "./org/" data-directory) ; system - ) - "List of directories to search for OpenDocument styles files. -See `org-e-odt-styles-dir'. The entries in this list are populated -heuristically based on the values of `org-e-odt-lib-dir' and -`org-e-odt-data-dir'.") - -(defconst org-e-odt-styles-dir - (let* ((styles-dir - (catch 'styles-dir - (message "Debug (org-e-odt): Searching for OpenDocument styles files...") - (mapc (lambda (styles-dir) - (when styles-dir - (message "Debug (org-e-odt): Trying %s..." styles-dir) - (when (and (file-readable-p - (expand-file-name - "OrgOdtContentTemplate.xml" styles-dir)) - (file-readable-p - (expand-file-name - "OrgOdtStyles.xml" styles-dir))) - (message "Debug (org-e-odt): Using styles under %s" - styles-dir) - (throw 'styles-dir styles-dir)))) - org-e-odt-styles-dir-list) - nil))) - (unless styles-dir - (error "Error (org-e-odt): Cannot find factory styles files, aborting")) - styles-dir) - "Directory that holds auxiliary XML files used by the ODT exporter. - -This directory contains the following XML files - - \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These - XML files are used as the default values of - `org-e-odt-styles-file' and - `org-e-odt-content-template-file'. - -The default value of this variable varies depending on the -version of org in use and is initialized from -`org-e-odt-styles-dir-list'. Note that the user could be using org -from one of: org's own private git repository, GNU ELPA tar or -standard Emacs.") - -(defconst org-e-odt-bookmark-prefix "OrgXref.") - -(defconst org-e-odt-manifest-file-entry-tag - "\n") - -(defconst org-e-odt-file-extensions - '(("odt" . "OpenDocument Text") - ("ott" . "OpenDocument Text Template") - ("odm" . "OpenDocument Master Document") - ("ods" . "OpenDocument Spreadsheet") - ("ots" . "OpenDocument Spreadsheet Template") - ("odg" . "OpenDocument Drawing (Graphics)") - ("otg" . "OpenDocument Drawing Template") - ("odp" . "OpenDocument Presentation") - ("otp" . "OpenDocument Presentation Template") - ("odi" . "OpenDocument Image") - ("odf" . "OpenDocument Formula") - ("odc" . "OpenDocument Chart"))) - -(defvar org-e-odt-table-style-format - " - - - -" - "Template for auto-generated Table styles.") - -(defvar org-e-odt-automatic-styles '() - "Registry of automatic styles for various OBJECT-TYPEs. -The variable has the following form: -\(\(OBJECT-TYPE-A - \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\) - \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\) - \(OBJECT-TYPE-B - \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\) - \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\) - ...\). - -OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc. -OBJECT-PROPS is (typically) a plist created by passing -\"#+ATTR_ODT: \" option to `org-e-odt-parse-block-attributes'. - -Use `org-e-odt-add-automatic-style' to add update this variable.'") - -(defvar org-e-odt-object-counters nil - "Running counters for various OBJECT-TYPEs. -Use this to generate automatic names and style-names. See -`org-e-odt-add-automatic-style'.") - -(defvar org-e-odt-src-block-paragraph-format - " - - - - - " - "Custom paragraph style for colorized source and example blocks. -This style is much the same as that of \"OrgFixedWidthBlock\" -except that the foreground and background colors are set -according to the default face identified by the `htmlfontify'.") - -(defvar hfy-optimisations) -(defvar org-e-odt-embedded-formulas-count 0) -(defvar org-e-odt-entity-frame-styles - '(("As-CharImage" "__Figure__" ("OrgInlineImage" nil "as-char")) - ("ParagraphImage" "__Figure__" ("OrgDisplayImage" nil "paragraph")) - ("PageImage" "__Figure__" ("OrgPageImage" nil "page")) - ("CaptionedAs-CharImage" "__Figure__" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgInlineImage" nil "as-char")) - ("CaptionedParagraphImage" "__Figure__" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgImageCaptionFrame" nil "paragraph")) - ("CaptionedPageImage" "__Figure__" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgPageImageCaptionFrame" nil "page")) - ("InlineFormula" "__MathFormula__" ("OrgInlineFormula" nil "as-char")) - ("DisplayFormula" "__MathFormula__" ("OrgDisplayFormula" nil "as-char")) - ("CaptionedDisplayFormula" "__MathFormula__" - ("OrgCaptionedFormula" nil "paragraph") - ("OrgFormulaCaptionFrame" nil "as-char")))) - -(defvar org-e-odt-embedded-images-count 0) -(defvar org-e-odt-image-size-probe-method - (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675 - '(emacs fixed)) - "Ordered list of methods for determining image sizes.") - -(defvar org-e-odt-default-image-sizes-alist - '(("as-char" . (5 . 0.4)) - ("paragraph" . (5 . 5))) - "Hardcoded image dimensions one for each of the anchor - methods.") - -;; A4 page size is 21.0 by 29.7 cms -;; The default page settings has 2cm margin on each of the sides. So -;; the effective text area is 17.0 by 25.7 cm -(defvar org-e-odt-max-image-size '(17.0 . 20.0) - "Limiting dimensions for an embedded image.") - -(defvar org-e-odt-label-styles - '(("math-formula" "%c" "text" "(%n)") - ("math-label" "(%n)" "text" "(%n)") - ("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 -\" SEQNO \". %c is replaced -with CAPTION. See `org-e-odt-format-label-definition'. - -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 -specifiers - %e and %n. %e is replaced with the CATEGORY-NAME. -%n is replaced with SEQNO. See -`org-e-odt-format-label-reference'.") - -(defvar org-e-odt-category-map-alist - '(("__Table__" "Table" "value" "Table") - ("__Figure__" "Illustration" "value" "Figure") - ("__MathFormula__" "Text" "math-formula" "Equation") - ("__DvipngImage__" "Equation" "value" "Equation") - ("__Listing__" "Listing" "value" "Listing") - ;; ("__Table__" "Table" "category-and-value") - ;; ("__Figure__" "Figure" "category-and-value") - ;; ("__DvipngImage__" "Equation" "category-and-value") - ) - "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\\). CATEGORY_HANDLE -identifies the captionable entity in question. OD-VARIABLE is -the OpenDocument sequence counter associated with the entity. -These counters are declared within -\"...\" block of -`org-e-odt-content-template-file'. LABEL-STYLE is a key into -`org-e-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'.") - -(defvar org-e-odt-manifest-file-entries nil) -(defvar hfy-user-sheet-assoc) - -(defvar org-e-odt-zip-dir nil - "Temporary work directory for OpenDocument exporter.") - - - -;;; User Configuration Variables - -(defgroup org-export-e-odt nil - "Options for exporting Org mode files to ODT." - :tag "Org Export ODT" - :group 'org-export) - - -;;;; Debugging - -(defcustom org-e-odt-prettify-xml nil - "Specify whether or not the xml output should be prettified. -When this option is turned on, `indent-region' is run on all -component xml buffers before they are saved. Turn this off for -regular use. Turn this on if you need to examine the xml -visually." - :group 'org-export-e-odt - :version "24.1" - :type 'boolean) - - -;;;; Document schema - -(defcustom org-e-odt-schema-dir - (let* ((schema-dir - (catch 'schema-dir - (message "Debug (org-e-odt): Searching for OpenDocument schema files...") - (mapc - (lambda (schema-dir) - (when schema-dir - (message "Debug (org-e-odt): Trying %s..." schema-dir) - (when (and (file-readable-p - (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" - schema-dir)) - (file-readable-p - (expand-file-name "od-schema-v1.2-cs01.rnc" - schema-dir)) - (file-readable-p - (expand-file-name "schemas.xml" schema-dir))) - (message "Debug (org-e-odt): Using schema files under %s" - schema-dir) - (throw 'schema-dir schema-dir)))) - org-e-odt-schema-dir-list) - (message "Debug (org-e-odt): No OpenDocument schema files installed") - nil))) - schema-dir) - "Directory that contains OpenDocument schema files. - -This directory contains: -1. rnc files for OpenDocument schema -2. a \"schemas.xml\" file that specifies locating rules needed - for auto validation of OpenDocument XML files. - -Use the customize interface to set this variable. This ensures -that `rng-schema-locating-files' is updated and auto-validation -of OpenDocument XML takes place based on the value -`rng-nxml-auto-validate-flag'. - -The default value of this variable varies depending on the -version of org in use and is initialized from -`org-e-odt-schema-dir-list'. The OASIS schema files are available -only in the org's private git repository. It is *not* bundled -with GNU ELPA tar or standard Emacs distribution." - :type '(choice - (const :tag "Not set" nil) - (directory :tag "Schema directory")) - :group 'org-export-e-odt - :version "24.1" - :set - (lambda (var value) - "Set `org-e-odt-schema-dir'. -Also add it to `rng-schema-locating-files'." - (let ((schema-dir value)) - (set var - (if (and - (file-readable-p - (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" schema-dir)) - (file-readable-p - (expand-file-name "od-schema-v1.2-cs01.rnc" schema-dir)) - (file-readable-p - (expand-file-name "schemas.xml" schema-dir))) - schema-dir - (when value - (message "Error (org-e-odt): %s has no OpenDocument schema files" - value)) - nil))) - (when org-e-odt-schema-dir - (eval-after-load 'rng-loc - '(add-to-list 'rng-schema-locating-files - (expand-file-name "schemas.xml" - org-e-odt-schema-dir)))))) - - -;;;; Document styles - -(defcustom org-e-odt-content-template-file nil - "Template file for \"content.xml\". -The exporter embeds the exported content just before -\"\" element. - -If unspecified, the file named \"OrgOdtContentTemplate.xml\" -under `org-e-odt-styles-dir' is used." - :type 'file - :group 'org-export-e-odt - :version "24.1") - -(defcustom org-e-odt-styles-file nil - "Default styles file for use with ODT export. -Valid values are one of: -1. nil -2. path to a styles.xml file -3. path to a *.odt or a *.ott file -4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2 -...)) - -In case of option 1, an in-built styles.xml is used. See -`org-e-odt-styles-dir' for more information. - -In case of option 3, the specified file is unzipped and the -styles.xml embedded therein is used. - -In case of option 4, the specified ODT-OR-OTT-FILE is unzipped -and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the -generated odt file. Use relative path for specifying the -FILE-MEMBERS. styles.xml must be specified as one of the -FILE-MEMBERS. - -Use options 1, 2 or 3 only if styles.xml alone suffices for -achieving the desired formatting. Use option 4, if the styles.xml -references additional files like header and footer images for -achieving the desired formatting. - -Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on -a per-file basis. For example, - -#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or -#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))." - :group 'org-export-e-odt - :version "24.1" - :type - '(choice - (const :tag "Factory settings" nil) - (file :must-match t :tag "styles.xml") - (file :must-match t :tag "ODT or OTT file") - (list :tag "ODT or OTT file + Members" - (file :must-match t :tag "ODF Text or Text Template file") - (cons :tag "Members" - (file :tag " Member" "styles.xml") - (repeat (file :tag "Member")))))) - -(defcustom org-e-odt-display-outline-level 2 - "Outline levels considered for enumerating captioned entities." - :group 'org-export-e-odt - :version "24.2" - :type 'integer) - -;;;; Document conversion - -(defcustom org-e-odt-convert-processes - '(("LibreOffice" - "soffice --headless --convert-to %f%x --outdir %d %i") - ("unoconv" - "unoconv -f %f -o %d %i")) - "Specify a list of document converters and their usage. -The converters in this list are offered as choices while -customizing `org-e-odt-convert-process'. - -This variable is a list where each element is of the -form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name -of the converter. CONVERTER-CMD is the shell command for the -converter and can contain format specifiers. These format -specifiers are interpreted as below: - -%i input file name in full -%I input file name as a URL -%f format of the output file -%o output file name in full -%O output file name as a URL -%d output dir in full -%D output dir as a URL. -%x extra options as set in `org-e-odt-convert-capabilities'." - :group 'org-export-e-odt - :version "24.1" - :type - '(choice - (const :tag "None" nil) - (alist :tag "Converters" - :key-type (string :tag "Converter Name") - :value-type (group (string :tag "Command line"))))) - -(defcustom org-e-odt-convert-process "LibreOffice" - "Use this converter to convert from \"odt\" format to other formats. -During customization, the list of converter names are populated -from `org-e-odt-convert-processes'." - :group 'org-export-e-odt - :version "24.1" - :type '(choice :convert-widget - (lambda (w) - (apply 'widget-convert (widget-type w) - (eval (car (widget-get w :args))))) - `((const :tag "None" nil) - ,@(mapcar (lambda (c) - `(const :tag ,(car c) ,(car c))) - org-e-odt-convert-processes)))) - -(defcustom org-e-odt-convert-capabilities - '(("Text" - ("odt" "ott" "doc" "rtf" "docx") - (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott") - ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html"))) - ("Web" - ("html") - (("pdf" "pdf") ("odt" "odt") ("html" "html"))) - ("Spreadsheet" - ("ods" "ots" "xls" "csv" "xlsx") - (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods") - ("xls" "xls") ("xlsx" "xlsx"))) - ("Presentation" - ("odp" "otp" "ppt" "pptx") - (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt") - ("pptx" "pptx") ("odg" "odg")))) - "Specify input and output formats of `org-e-odt-convert-process'. -More correctly, specify the set of input and output formats that -the user is actually interested in. - -This variable is an alist where each element is of the -form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST). -INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an -alist where each element is of the form (OUTPUT-FMT -OUTPUT-FILE-EXTENSION EXTRA-OPTIONS). - -The variable is interpreted as follows: -`org-e-odt-convert-process' can take any document that is in -INPUT-FMT-LIST and produce any document that is in the -OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have -OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT -serves dual purposes: -- It is used for populating completion candidates during - `org-e-odt-convert' commands. -- It is used as the value of \"%f\" specifier in - `org-e-odt-convert-process'. - -EXTRA-OPTIONS is used as the value of \"%x\" specifier in -`org-e-odt-convert-process'. - -DOCUMENT-CLASS is used to group a set of file formats in -INPUT-FMT-LIST in to a single class. - -Note that this variable inherently captures how LibreOffice based -converters work. LibreOffice maps documents of various formats -to classes like Text, Web, Spreadsheet, Presentation etc and -allow document of a given class (irrespective of it's source -format) to be converted to any of the export formats associated -with that class. - -See default setting of this variable for an typical -configuration." - :group 'org-export-e-odt - :version "24.1" - :type - '(choice - (const :tag "None" nil) - (alist :tag "Capabilities" - :key-type (string :tag "Document Class") - :value-type - (group (repeat :tag "Input formats" (string :tag "Input format")) - (alist :tag "Output formats" - :key-type (string :tag "Output format") - :value-type - (group (string :tag "Output file extension") - (choice - (const :tag "None" nil) - (string :tag "Extra options")))))))) - -(defcustom org-e-odt-preferred-output-format nil - "Automatically post-process to this format after exporting to \"odt\". -Interactive commands `org-export-as-e-odt' and -`org-export-as-e-odt-and-open' export first to \"odt\" format and -then use `org-e-odt-convert-process' to convert the -resulting document to this format. During customization of this -variable, the list of valid values are populated based on -`org-e-odt-convert-capabilities'." - :group 'org-export-e-odt - :version "24.1" - :type '(choice :convert-widget - (lambda (w) - (apply 'widget-convert (widget-type w) - (eval (car (widget-get w :args))))) - `((const :tag "None" nil) - ,@(mapcar (lambda (c) - `(const :tag ,c ,c)) - (org-e-odt-reachable-formats "odt"))))) - - -;;;; Drawers - -(defcustom org-e-odt-format-drawer-function nil - "Function called to format a drawer in HTML code. - -The function must accept two parameters: - NAME the drawer name, like \"LOGBOOK\" - CONTENTS the contents of the drawer. - -The function should return the string to be exported. - -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-e-odt-format-drawer-default \(name contents\) - \"Format a drawer element for HTML export.\" - contents\)" - :group 'org-export-e-odt - :type 'function) - - -;;;; Headline - -(defcustom org-e-odt-format-headline-function nil - "Function to format headline text. - -This function will be called with 5 arguments: -TODO the todo keyword \(string or nil\). -TODO-TYPE the type of todo \(symbol: `todo', `done', nil\) -PRIORITY the priority of the headline \(integer or nil\) -TEXT the main headline text \(string\). -TAGS the tags string, separated with colons \(string or nil\). - -The function result will be used in the section format string. - -As an example, one could set the variable to the following, in -order to reproduce the default set-up: - -\(defun org-e-odt-format-headline \(todo todo-type priority text tags\) - \"Default format function for an headline.\" - \(concat \(when todo - \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo\)\) - \(when priority - \(format \"\\\\framebox{\\\\#%c} \" priority\)\) - text - \(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)" - :group 'org-export-e-odt - :type 'function) - - -;;;; Inlinetasks - -(defcustom org-e-odt-format-inlinetask-function nil - "Function called to format an inlinetask in HTML code. - -The function must accept six parameters: - TODO the todo keyword, as a string - TODO-TYPE the todo type, a symbol among `todo', `done' and nil. - PRIORITY the inlinetask priority, as a string - NAME the inlinetask name, as a string. - TAGS the inlinetask tags, as a string. - CONTENTS the contents of the inlinetask, as a string. - -The function should return the string to be exported. - -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-e-odt-format-inlinetask \(todo type priority name tags contents\) -\"Format an inline task element for HTML export.\" - \(let \(\(full-title - \(concat - \(when todo - \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo\)\) - \(when priority \(format \"\\\\framebox{\\\\#%c} \" priority\)\) - title - \(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" tags\)\)\)\)\) - \(format \(concat \"\\\\begin{center}\\n\" - \"\\\\fbox{\\n\" - \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\" - \"%s\\n\\n\" - \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\" - \"%s\" - \"\\\\end{minipage}}\" - \"\\\\end{center}\"\) - full-title contents\)\)" - :group 'org-export-e-odt - :type 'function) - - -;;;; Links - -(defcustom org-e-odt-inline-image-rules - '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\)\\'")) - "Rules characterizing image files that can be inlined into HTML. - -A rule consists in an association whose key is the type of link -to consider, and value is a regexp that will be matched against -link's path. - -Note that, by default, the image extension *actually* allowed -depend on the way the HTML file is processed. When used with -pdflatex, pdf, jpg and png images are OK. When processing -through dvi to Postscript, only ps and eps are allowed. The -default we use here encompasses both." - :group 'org-export-e-odt - :type '(alist :key-type (string :tag "Type") - :value-type (regexp :tag "Path"))) - -(defcustom org-e-odt-pixels-per-inch display-pixels-per-inch - "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-e-odt - :version "24.1") - - -;;;; Plain text - -(defcustom org-e-odt-quotes - '(("fr" - ("\\(\\s-\\|[[(]\\|^\\)\"" . "« ") - ("\\(\\S-\\)\"" . "» ") - ("\\(\\s-\\|(\\|^\\)'" . "'")) - ("en" - ("\\(\\s-\\|[[(]\\|^\\)\"" . "“") - ("\\(\\S-\\)\"" . "”") - ("\\(\\s-\\|(\\|^\\)'" . "‘") - ("\\(\\S-\\)'" . "’"))) - "Alist for quotes to use when converting english double-quotes. - -The CAR of each item in this alist is the language code. -The CDR of each item in this alist is a list of three CONS: -- the first CONS defines the opening quote; -- the second CONS defines the closing quote; -- the last CONS defines single quotes. - -For each item in a CONS, the first string is a regexp -for allowed characters before/after the quote, the second -string defines the replacement string for this quote." - :group 'org-export-e-odt - :type '(list - (cons :tag "Opening quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")) - (cons :tag "Closing quote" - (string :tag "Regexp for char after ") - (string :tag "Replacement quote ")) - (cons :tag "Single quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")))) - - -;;;; Src Block - -(defcustom org-e-odt-create-custom-styles-for-srcblocks t - "Whether custom styles for colorized source blocks be automatically created. -When this option is turned on, the exporter creates custom styles -for source blocks based on the advice of `htmlfontify'. Creation -of custom styles happen as part of `org-e-odt-hfy-face-to-css'. - -When this option is turned off exporter does not create such -styles. - -Use the latter option if you do not want the custom styles to be -based on your current display settings. It is necessary that the -styles.xml already contains needed styles for colorizing to work. - -This variable is effective only if -`org-e-odt-fontify-srcblocks' is turned on." - :group 'org-export-e-odt - :version "24.1" - :type 'boolean) - -(defcustom org-e-odt-fontify-srcblocks t - "Specify whether or not source blocks need to be fontified. -Turn this option on if you want to colorize the source code -blocks in the exported file. For colorization to work, you need -to make available an enhanced version of `htmlfontify' library." - :type 'boolean - :group 'org-export-e-odt - :version "24.1") - - -;;;; Table - -(defcustom org-e-odt-table-caption-above t - "When non-nil, place caption string at the beginning of the table. -Otherwise, place it near the end." - :group 'org-export-e-odt - :type 'boolean) - -(defcustom org-e-odt-table-styles - '(("OrgEquation" "OrgEquation" - ((use-first-column-styles . t) - (use-last-column-styles . t)))) - "Specify how Table Styles should be derived from a Table Template. -This is a list where each element is of the -form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS). - -TABLE-STYLE-NAME is the style associated with the table through -\"#+ATTR_ODT: :style TABLE-STYLE-NAME\" line. - -TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic -TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined -below) that is included in -`org-e-odt-content-template-file'. - -TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + - \"TableCell\" -PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + - \"TableParagraph\" -TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" | - \"FirstRow\" | \"LastRow\" | - \"EvenRow\" | \"OddRow\" | - \"EvenColumn\" | \"OddColumn\" | \"\" -where \"+\" above denotes string concatenation. - -TABLE-CELL-OPTIONS is an alist where each element is of the -form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF). -TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' | - `use-last-row-styles' | - `use-first-column-styles' | - `use-last-column-styles' | - `use-banding-rows-styles' | - `use-banding-columns-styles' | - `use-first-row-styles' -ON-OR-OFF := `t' | `nil' - -For example, with the following configuration - -\(setq org-e-odt-table-styles - '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\" - \(\(use-first-row-styles . t\) - \(use-first-column-styles . t\)\)\) - \(\"TableWithHeaderColumns\" \"Custom\" - \(\(use-first-column-styles . t\)\)\)\)\) - -1. A table associated with \"TableWithHeaderRowsAndColumns\" - style will use the following table-cell styles - - \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\", - \"CustomTableCell\" and the following paragraph styles - \"CustomFirstRowTableParagraph\", - \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" - as appropriate. - -2. A table associated with \"TableWithHeaderColumns\" style will - use the following table-cell styles - - \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the - following paragraph styles - \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" - as appropriate.. - -Note that TABLE-TEMPLATE-NAME corresponds to the -\"\" elements contained within -\"\". The entries (TABLE-STYLE-NAME -TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to -\"table:template-name\" and \"table:use-first-row-styles\" etc -attributes of \"\" element. Refer ODF-1.2 -specification for more information. Also consult the -implementation filed under `org-e-odt-get-table-cell-styles'. - -The TABLE-STYLE-NAME \"OrgEquation\" is used internally for -formatting of numbered display equations. Do not delete this -style from the list." - :group 'org-export-e-odt - :version "24.1" - :type '(choice - (const :tag "None" nil) - (repeat :tag "Table Styles" - (list :tag "Table Style Specification" - (string :tag "Table Style Name") - (string :tag "Table Template Name") - (alist :options (use-first-row-styles - use-last-row-styles - use-first-column-styles - use-last-column-styles - use-banding-rows-styles - use-banding-columns-styles) - :key-type symbol - :value-type (const :tag "True" t)))))) - - - -;;; Internal functions - -;;;; Date - -(defun org-e-odt--date (&optional org-ts fmt) - (save-match-data - (let* ((time - (and (stringp org-ts) - (string-match org-ts-regexp0 org-ts) - (apply 'encode-time - (org-fix-decoded-time - (org-parse-time-string (match-string 0 org-ts) t))))) - date) - (cond - (fmt (format-time-string fmt time)) - (t (setq date (format-time-string "%Y-%m-%dT%H:%M:%S%z" time)) - (format "%s:%s" (substring date 0 -2) (substring date -2))))))) - -;;;; Frame - -(defun org-e-odt--frame (text width height style &optional extra - anchor-type) - (let ((frame-attrs - (concat - (if width (format " svg:width=\"%0.2fcm\"" width) "") - (if height (format " svg:height=\"%0.2fcm\"" height) "") - extra - (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph"))))) - (format - "\n\n%s\n" - style frame-attrs - (concat text - (let ((title (get-text-property 0 :title text)) - (desc (get-text-property 0 :description text))) - (concat (and title - (format "%s" - (org-e-odt-encode-plain-text title t))) - (and desc - (format "%s" - (org-e-odt-encode-plain-text desc t))))))))) - -;;;; Library wrappers - -(defun org-e-odt--adopt-elements (parent &rest children) - (prog1 parent - (mapc (lambda (child) - (let ((parent-1 (org-element-adopt-element parent child nil))) - (assert (eq parent-1 parent)))) - children))) - -(defun org-e-odt--zip-extract (archive members target) - (when (atom members) (setq members (list members))) - (mapc (lambda (archive member target) - (require 'arc-mode) - (let* ((--quote-file-name - ;; This is shamelessly stolen from `archive-zip-extract'. - (lambda (name) - (if (or (not (memq system-type '(windows-nt ms-dos))) - (and (boundp 'w32-quote-process-args) - (null w32-quote-process-args))) - (shell-quote-argument name) - name))) - (target (funcall --quote-file-name target)) - (archive (expand-file-name archive)) - (archive-zip-extract - (list "unzip" "-qq" "-o" "-d" target)) - exit-code command-output) - (setq command-output - (with-temp-buffer - (setq exit-code (archive-zip-extract archive member)) - (buffer-string))) - (unless (zerop exit-code) - (message command-output) - (error "Extraction failed")))) - members)) - -;;;; Textbox - -(defun org-e-odt--textbox (text width height style &optional - extra anchor-type) - (org-e-odt--frame - (format "\n%s\n" - (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2)) - (and (not width) - (format " fo:min-width=\"%0.2fcm\"" (or width .2)))) - text) - width nil style extra anchor-type)) - - - -;;;; Table of Contents - -(defun org-e-odt-begin-toc (index-title depth) - (concat - (format " - - - %s -" depth index-title) - - (let ((levels (number-sequence 1 10))) - (mapconcat - (lambda (level) - (format - " - - - - - - -" level level)) levels "")) - - (format " - - - - - %s - - " index-title))) - -(defun org-e-odt-end-toc () - (format " - - -")) - - - -(defun* org-e-odt-format-toc-headline - (todo todo-type priority text tags - &key level section-number headline-label &allow-other-keys) - (setq text (concat - (and org-export-with-section-numbers - (concat section-number ". ")) - text - (and tags - (concat - "" - (format "%s" - "OrgTag" tags))))) - (when todo - (setq text (format "%s" - "OrgTodo" text))) - (org-e-odt-format-link text (concat "#" headline-label) t)) - -(defun org-e-odt-toc (depth info) - (assert (wholenump depth)) - (let* ((title (org-export-translate "Table of Contents" :utf-8 info)) - (headlines (org-export-collect-headlines info depth))) - - (when headlines - (concat - (org-e-odt-begin-toc title depth) - - (mapconcat - (lambda (headline) - (let* ((entry (org-e-odt-format-headline--wrap - headline info 'org-e-odt-format-toc-headline)) - (level (org-export-get-relative-level headline info)) - (style (format "Contents_20_%d" level))) - (format "\n%s" - style entry))) - headlines "\n") - - (org-e-odt-end-toc))))) - - -;;;; Document styles - -(defun org-e-odt-add-automatic-style (object-type &optional object-props) - "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS. -OBJECT-PROPS is (typically) a plist created by passing -\"#+ATTR_ODT: \" option of the object in question to -`org-e-odt-parse-block-attributes'. - -Use `org-e-odt-object-counters' to generate an automatic -OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a -new entry in `org-e-odt-automatic-styles'. Return (OBJECT-NAME -. STYLE-NAME)." - (assert (stringp object-type)) - (let* ((object (intern object-type)) - (seqvar object) - (seqno (1+ (or (plist-get org-e-odt-object-counters seqvar) 0))) - (object-name (format "%s%d" object-type seqno)) style-name) - (setq org-e-odt-object-counters - (plist-put org-e-odt-object-counters seqvar seqno)) - (when object-props - (setq style-name (format "Org%s" object-name)) - (setq org-e-odt-automatic-styles - (plist-put org-e-odt-automatic-styles object - (append (list (list style-name object-props)) - (plist-get org-e-odt-automatic-styles object))))) - (cons object-name style-name))) - - -;;;; Caption and Labels - - -(defun org-e-odt--wrap-label (element output) - "Wrap label associated to ELEMENT around OUTPUT, if appropriate. -This function shouldn't be used for floats. See -`org-e-odt--caption/label-string'." - ;; (let ((label (org-element-property :name element))) - ;; (if (or (not output) (not label) (string= output "") (string= label "")) - ;; output - ;; (concat (format "\\label{%s}\n" label) output))) - output) - - -(defun org-e-odt--caption/label-string (caption label info) - "Return caption and label HTML string for floats. - -CAPTION is a cons cell of secondary strings, the car being the -standard caption and the cdr its short form. LABEL is a string -representing the label. INFO is a plist holding contextual -information. - -If there's no caption nor label, return the empty string. - -For non-floats, see `org-e-odt--wrap-label'." - (setq label nil) ;; FIXME - - (let ((label-str (if label (format "\\label{%s}" label) ""))) - (cond - ((and (not caption) (not label)) "") - ((not caption) (format "\\label{%s}\n" label)) - ;; Option caption format with short name. - ((cdr caption) - (format "\\caption[%s]{%s%s}\n" - (org-export-data (cdr caption) info) - label-str - (org-export-data (car caption) info))) - ;; Standard caption format. - ;; (t (format "\\caption{%s%s}\n" - ;; label-str - ;; (org-export-data (car caption) info))) - (t (org-export-data (car caption) info))))) - -;;;; Checkbox - -(defun org-e-odt--checkbox (item) - "Return check-box string associated to ITEM." - (let ((checkbox (org-element-property :checkbox item))) - (if (not checkbox) "" - (format "%s" - "OrgCode" (case checkbox - (on "[✓] ") ; CHECK MARK - (off "[ ] ") - (trans "[-] ")))))) - - - -;;; Template - -(defun org-e-odt-template (contents info) - "Return complete document string after HTML conversion. -CONTENTS is the transcoded contents string. RAW-DATA is the -original parsed data. INFO is a plist holding export options." - ;; Write meta file. - (let ((title (org-export-data (plist-get info :title) info)) - (author (let ((author (plist-get info :author))) - (if (not author) "" (org-export-data author info)))) - (date (org-e-odt--date - (org-export-data (plist-get info :date) info))) - (email (plist-get info :email)) - (keywords (plist-get info :keywords)) - (description (plist-get info :description))) - (write-region - (concat - " - - \n" - (format "%s\n" author) - (format "%s\n" author) - (format "%s\n" date) - (format "%s\n" date) - (format "%s\n" - (let ((creator-info (plist-get info :with-creator))) - (if (or (not creator-info) (eq creator-info 'comment)) "" - (plist-get info :creator)))) - (format "%s\n" keywords) - (format "%s\n" description) - (format "%s\n" title) - "\n" - " \n" "") - nil (concat org-e-odt-zip-dir "meta.xml")) - ;; Add meta.xml in to manifest. - (org-e-odt-create-manifest-file-entry "text/xml" "meta.xml")) - - ;; Update styles file. - ;; Copy styles.xml. Also dump htmlfontify styles, if there is any. - ;; Write styles file. - (let* ((styles-file (plist-get info :odt-styles-file)) - (styles-file (and styles-file (read (org-trim styles-file)))) - ;; Non-availability of styles.xml is not a critical - ;; error. For now throw an error purely for aesthetic - ;; reasons. - (styles-file (or styles-file - org-e-odt-styles-file - (expand-file-name "OrgOdtStyles.xml" - org-e-odt-styles-dir) - (error "org-e-odt: Missing styles file?")))) - (cond - ((listp styles-file) - (let ((archive (nth 0 styles-file)) - (members (nth 1 styles-file))) - (org-e-odt--zip-extract archive members org-e-odt-zip-dir) - (mapc - (lambda (member) - (when (org-file-image-p member) - (let* ((image-type (file-name-extension member)) - (media-type (format "image/%s" image-type))) - (org-e-odt-create-manifest-file-entry media-type member)))) - members))) - ((and (stringp styles-file) (file-exists-p styles-file)) - (let ((styles-file-type (file-name-extension styles-file))) - (cond - ((string= styles-file-type "xml") - (copy-file styles-file (concat org-e-odt-zip-dir "styles.xml") t)) - ((member styles-file-type '("odt" "ott")) - (org-e-odt--zip-extract styles-file "styles.xml" org-e-odt-zip-dir))))) - (t - (error (format "Invalid specification of styles.xml file: %S" - org-e-odt-styles-file)))) - - ;; create a manifest entry for styles.xml - (org-e-odt-create-manifest-file-entry "text/xml" "styles.xml") - - ;; FIXME: Who is opening an empty styles.xml before this point? - (with-current-buffer - (find-file-noselect (concat org-e-odt-zip-dir "styles.xml") t) - (revert-buffer t t) - - ;; Write custom styles for source blocks - ;; Save STYLES used for colorizing of source blocks. - ;; Update styles.xml with styles that were collected as part of - ;; `org-e-odt-hfy-face-to-css' callbacks. - (let ((styles (mapconcat (lambda (style) (format " %s\n" (cddr style))) - hfy-user-sheet-assoc ""))) - (when styles - (goto-char (point-min)) - (when (re-search-forward "" nil t) - (goto-char (match-beginning 0)) - (insert "\n\n" styles "\n")))) - - ;; Update styles.xml - take care of outline numbering - - ;; Don't make automatic backup of styles.xml file. This setting - ;; prevents the backed-up styles.xml file from being zipped in to - ;; odt file. This is more of a hackish fix. Better alternative - ;; would be to fix the zip command so that the output odt file - ;; includes only the needed files and excludes any auto-generated - ;; extra files like backups and auto-saves etc etc. Note that - ;; currently the zip command zips up the entire temp directory so - ;; that any auto-generated files created under the hood ends up in - ;; the resulting odt file. - (set (make-local-variable 'backup-inhibited) t) - - ;; Outline numbering is retained only upto LEVEL. - ;; To disable outline numbering pass a LEVEL of 0. - - (goto-char (point-min)) - (let ((regex - "]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>") - (replacement - "")) - (while (re-search-forward regex nil t) - (unless (let ((sec-num (plist-get info :section-numbers)) - (level (string-to-number (match-string 2)))) - (if (wholenump sec-num) (<= level sec-num) sec-num)) - (replace-match replacement t nil)))) - (save-buffer 0))) - ;; Update content.xml. - (with-temp-buffer - (insert-file-contents - (or org-e-odt-content-template-file - (expand-file-name "OrgOdtContentTemplate.xml" - org-e-odt-styles-dir))) - ;; Write automatic styles. - ;; - Position the cursor. - (goto-char (point-min)) - (re-search-forward " " nil t) - (goto-char (match-beginning 0)) - ;; - Dump automatic table styles - (loop for (style-name props) in - (plist-get org-e-odt-automatic-styles 'Table) do - (when (setq props (or (plist-get props :rel-width) 96)) - (insert (format org-e-odt-table-style-format style-name props)))) - ;; Update display level. - ;; - Remove existing sequence decls. Also position the cursor. - (goto-char (point-min)) - (when (re-search-forward "" nil nil))) - ;; Update sequence decls according to user preference. - (insert - (format - "\n\n%s\n" - (mapconcat - (lambda (x) - (format - "" - org-e-odt-display-outline-level (nth 1 x))) - org-e-odt-category-map-alist "\n"))) - ;; Position the cursor to document body. - (goto-char (point-min)) - (re-search-forward "" nil nil) - (goto-char (match-beginning 0)) - - ;; Preamble - Title, Author, Date etc. - (insert - (let* ((title (org-export-data (plist-get info :title) info)) - (author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth (org-export-data auth info))))) - (date (org-export-data (plist-get info :date) info)) - (iso-date (org-e-odt--date date)) - (date (org-e-odt--date date "%d %b %Y")) - (email (plist-get info :email)) - ;; switch on or off above vars based on user settings - (author (and (plist-get info :with-author) (or author email))) - ;; (date (and (plist-get info :time-stamp-file) date)) - (email (and (plist-get info :with-email) email))) - (concat - ;; title - (when title - (concat - (format "\n%s" - "OrgTitle" (format "\n%s" title)) - ;; separator - "\n")) - (cond - ((and author (not email)) - ;; author only - (concat - (format "\n%s" - "OrgSubtitle" - (format "%s" author)) - ;; separator - "\n")) - ((and author email) - ;; author and email - (concat - (format "\n%s" - "OrgSubtitle" - (org-e-odt-format-link - (format "%s" author) - (concat "mailto:" email))) - ;; separator - "\n"))) - ;; date - (when date - (concat - (format - "\n%s" - "OrgSubtitle" - (format - "\n%s" - - "N75" iso-date date)) - ;; separator - ""))))) - - ;; Table of Contents - (let ((depth (plist-get info :with-toc))) - (when (wholenump depth) (insert (org-e-odt-toc depth info)))) - ;; Contents. - (insert contents) - ;; Return contents. - (buffer-substring-no-properties (point-min) (point-max)))) - - - -;;; Transcode Functions - -;;;; Bold - -(defun org-e-odt-bold (bold contents info) - "Transcode BOLD from Org to ODT. -CONTENTS is the text with bold markup. INFO is a plist holding -contextual information." - (format "%s" - "Bold" contents)) - - -;;;; Center Block - -(defun org-e-odt-center-block (center-block contents info) - "Transcode a CENTER-BLOCK element from Org to ODT. -CONTENTS holds the contents of the center block. INFO is a plist -holding contextual information." - (org-e-odt--wrap-label center-block contents)) - - -;;;; Clock - -(defun org-e-odt-clock (clock contents info) - "Transcode a CLOCK element from Org to ODT. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (format "%s" - "OrgTimestampWrapper" - (concat - (format "%s" - "OrgTimestampKeyword" org-clock-string) - (format "%s" - "OrgTimestamp" - (concat (org-translate-time - (org-element-property :value clock)) - (let ((time (org-element-property :time clock))) - (and time (format " (%s)" time)))))))) - - -;;;; Code - -(defun org-e-odt-code (code contents info) - "Transcode a CODE object from Org to ODT. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (format "%s" - "OrgCode" (org-element-property :value code))) - - -;;;; Comment - -;; Comments are ignored. - - -;;;; Comment Block - -;; Comment Blocks are ignored. - - -;;;; Drawer - -(defun org-e-odt-drawer (drawer contents info) - "Transcode a DRAWER element from Org to ODT. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let* ((name (org-element-property :drawer-name drawer)) - (output (if (functionp org-e-odt-format-drawer-function) - (funcall org-e-odt-format-drawer-function - name contents) - ;; If there's no user defined function: simply - ;; display contents of the drawer. - contents))) - (org-e-odt--wrap-label drawer output))) - - -;;;; Dynamic Block - -(defun org-e-odt-dynamic-block (dynamic-block contents info) - "Transcode a DYNAMIC-BLOCK element from Org to ODT. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information. See `org-export-data'." - (org-e-odt--wrap-label dynamic-block contents)) - - -;;;; Entity - -(defun org-e-odt-entity (entity contents info) - "Transcode an ENTITY object from Org to ODT. -CONTENTS are the definition itself. INFO is a plist holding -contextual information." - ;; (let ((ent (org-element-property :latex entity))) - ;; (if (org-element-property :latex-math-p entity) - ;; (format "$%s$" ent) - ;; ent)) - (org-element-property :utf-8 entity)) - - -;;;; Example Block - -(defun org-e-odt-example-block (example-block contents info) - "Transcode a EXAMPLE-BLOCK element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-odt--wrap-label - example-block (org-e-odt-format-code example-block info))) - - -;;;; Export Snippet - -(defun org-e-odt-export-snippet (export-snippet contents info) - "Transcode a EXPORT-SNIPPET object from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (eq (org-export-snippet-backend export-snippet) 'e-odt) - (org-element-property :value export-snippet))) - - -;;;; Export Block - -(defun org-e-odt-export-block (export-block contents info) - "Transcode a EXPORT-BLOCK element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (string= (org-element-property :type export-block) "ODT") - (org-remove-indentation (org-element-property :value export-block)))) - - -;;;; Fixed Width - -(defun org-e-odt-fixed-width (fixed-width contents info) - "Transcode a FIXED-WIDTH element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-odt--wrap-label - fixed-width (org-e-odt-do-format-code - (org-element-property :value fixed-width)))) - - -;;;; Footnote Definition - -;; Footnote Definitions are ignored. - - -;;;; Footnote Reference - -(defun org-e-odt-footnote-reference (footnote-reference contents info) - "Transcode a FOOTNOTE-REFERENCE element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((--format-footnote-definition - (function - (lambda (n def) - (setq n (format "%d" n)) - (let ((id (concat "fn" n)) - (note-class "footnote") - (par-style "Footnote")) - (format - "%s" - id note-class - (concat - (format "%s" n) - (format "%s" def))))))) - (--format-footnote-reference - (function - (lambda (n) - (setq n (format "%d" n)) - (let ((note-class "footnote") - (ref-format "text") - (ref-name (concat "fn" n))) - (format - "%s" - "OrgSuperscript" - (format "%s" - note-class ref-format ref-name n))))))) - (concat - ;; Insert separator between two footnotes in a row. - (let ((prev (org-export-get-previous-element footnote-reference info))) - (and (eq (org-element-type prev) 'footnote-reference) - (format "%s" - "OrgSuperscript" ","))) - ;; Trancode footnote reference. - (let ((n (org-export-get-footnote-number footnote-reference info))) - (cond - ((not (org-export-footnote-first-reference-p footnote-reference info)) - (funcall --format-footnote-reference n)) - ;; Inline definitions are secondary strings. - ;; Non-inline footnotes definitions are full Org data. - (t - (let* ((raw (org-export-get-footnote-definition footnote-reference - info)) - (def (let ((def (org-trim (org-export-data raw info)))) - (if (eq (org-element-type raw) 'org-data) def - (format "\n%s" - "Footnote" def))))) - (funcall --format-footnote-definition n def)))))))) - - -;;;; Headline - -(defun* org-e-odt-format-headline - (todo todo-type priority text tags - &key level section-number headline-label &allow-other-keys) - (concat - ;; Todo. - (and todo - (concat - (let ((style (if (member todo org-done-keywords) "OrgDone" "OrgTodo"))) - (format "%s" - style todo)) " ")) - ;; Title. - text - ;; Tags. - (and tags - (concat "" - (format "%s" - "OrgTag" (mapconcat 'org-trim tags " : ")))))) - -(defun org-e-odt-format-headline--wrap (headline info - &optional format-function - &rest extra-keys) - "Transcode an HEADLINE element from Org to ODT. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - (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) - (mapconcat 'number-to-string - headline-number "."))) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data todo info))))) - (todo-type (and todo (org-element-property :todo-type headline))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority headline))) - (text (org-export-data (org-element-property :title headline) info)) - (tags (and (plist-get info :with-tags) - (org-export-get-tags headline info))) - (headline-label (concat "sec-" (mapconcat 'number-to-string - headline-number "-"))) - (format-function (cond - ((functionp format-function) format-function) - ((functionp org-e-odt-format-headline-function) - (function* - (lambda (todo todo-type priority text tags - &allow-other-keys) - (funcall org-e-odt-format-headline-function - todo todo-type priority text tags)))) - (t 'org-e-odt-format-headline)))) - (apply format-function - todo todo-type priority text tags - :headline-label headline-label :level level - :section-number section-number extra-keys))) - - -(defun org-e-odt-begin-plain-list (ltype &optional continue-numbering) - (unless (member ltype '(ordered unordered descriptive)) - (error "Unknown list type: %s" ltype)) - (let ((style-name (assoc-default ltype - '((ordered . "OrgNumberedList") - (unordered . "OrgBulletedList") - (descriptive . "OrgDescriptionList"))))) - (format "" - style-name (if continue-numbering "true" "false")))) - -(defun org-e-odt-headline (headline contents info) - "Transcode an HEADLINE element from Org to ODT. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - (let* ((numberedp (org-export-numbered-headline-p headline info)) - ;; Get level relative to current parsed data. - (level (org-export-get-relative-level headline info)) - (text (org-export-data (org-element-property :title headline) info)) - ;; Create the headline text. - (full-text (org-e-odt-format-headline--wrap headline info))) - (cond - ;; Case 1: This is a footnote section: ignore it. - ((org-element-property :footnote-section-p headline) nil) - ;; Case 2. This is a deep sub-tree: export it as a list item. - ;; Also export as items headlines for which no section - ;; format has been found. - ;; FIXME - ;; ((org-export-low-level-p headline info) - ;; ;; Build the real contents of the sub-tree. - ;; (let* ((type (if numberedp 'unordered 'unordered)) ; FIXME - ;; (itemized-body (org-e-odt-format-list-item - ;; contents type nil nil full-text))) - ;; (concat - ;; (and (org-export-first-sibling-p headline info) - ;; (org-e-odt-begin-plain-list type)) - ;; itemized-body - ;; (and (org-export-last-sibling-p headline info) - ;; "")))) - ;; Case 3. Standard headline. Export it as a section. - (t - (let* ((extra-ids (list (org-element-property :custom-id headline) - (org-element-property :id headline))) - (extra-ids nil) ; FIXME - (id (concat "sec-" (mapconcat 'number-to-string - (org-export-get-headline-number - headline info) "-")))) - (concat - (format - "\n%s%s" - (format "Heading_20_%s" level) - level - ;; Extra targets. - (mapconcat (lambda (x) - (when x - (let ((x (if (org-uuidgen-p x) (concat "ID-" x) x))) - (org-e-odt-format-target - "" (org-export-solidify-link-text x))))) - extra-ids "") - ;; Title. - (org-e-odt-format-target full-text id)) - contents)))))) - - -;;;; Horizontal Rule - -(defun org-e-odt-horizontal-rule (horizontal-rule contents info) - "Transcode an HORIZONTAL-RULE object from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-odt--wrap-label - horizontal-rule - (format "\n%s" - "Horizontal_20_Line" ""))) - - -;;;; Inline Babel Call - -;; Inline Babel Calls are ignored. - - -;;;; Inline Src Block - -(defun org-e-odt--find-verb-separator (s) - "Return a character not used in string S. -This is used to choose a separator for constructs like \\verb." - (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) - (loop for c across ll - when (not (string-match (regexp-quote (char-to-string c)) s)) - return (char-to-string c)))) - -(defun org-e-odt-inline-src-block (inline-src-block contents info) - "Transcode an INLINE-SRC-BLOCK element from Org to ODT. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((org-lang (org-element-property :language inline-src-block)) - (code (org-element-property :value inline-src-block)) - (separator (org-e-odt--find-verb-separator code))) - (error "FIXME"))) - - -;;;; Inlinetask - -(defun org-e-odt-inlinetask (inlinetask contents info) - "Transcode an INLINETASK element from Org to ODT. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (cond - ;; If `org-e-odt-format-inlinetask-function' is provided, call it - ;; with appropriate arguments. - ((functionp org-e-odt-format-inlinetask-function) - (let ((format-function - (function* - (lambda (todo todo-type priority text tags - &key contents &allow-other-keys) - (funcall org-e-odt-format-inlinetask-function - todo todo-type priority text tags contents))))) - (org-e-odt-format-headline--wrap - inlinetask info format-function :contents contents))) - ;; Otherwise, use a default template. - (t (org-e-odt--wrap-label - inlinetask - (format "\n%s" - "Text_20_body" - (org-e-odt--textbox - (concat - (format "\n%s" - "OrgInlineTaskHeading" - (org-e-odt-format-headline--wrap - inlinetask info)) - contents) - nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\"")))))) - -;;;; Italic - -(defun org-e-odt-italic (italic contents info) - "Transcode ITALIC from Org to ODT. -CONTENTS is the text with italic markup. INFO is a plist holding -contextual information." - (format "%s" - "Emphasis" contents)) - - -;;;; Item - -(defun org-e-odt-item (item contents info) - "Transcode an ITEM element from Org to ODT. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((plain-list (org-export-get-parent item)) - (type (org-element-property :type plain-list)) - (counter (org-element-property :counter item)) - (tag (let ((tag (org-element-property :tag item))) - (and tag - (concat (org-e-odt--checkbox item) - (org-export-data tag info)))))) - (case type - ((ordered unordered) - (format "\n\n%s\n%s" - contents - (let* ((--element-has-a-table-p - (function - (lambda (element info) - (loop for el in (org-element-contents element) - thereis (eq (org-element-type el) 'table)))))) - (cond - ((funcall --element-has-a-table-p item info) - "") - (t ""))))) - (descriptive - (concat - (let ((term (or tag "(no term)"))) - (concat - (format "\n\n%s\n" - (format "\n%s" - "Text_20_body_20_bold" term)) - (format - "\n\n%s\n" - (format "\n\n%s\n" - "OrgDescriptionList" - "text:continue-numbering=\"false\"" - (format "\n\n%s\n" - contents))))))) - (t (error "Unknown list type: %S" type))))) - - -;;;; Keyword - -(defun org-e-odt-keyword (keyword contents info) - "Transcode a KEYWORD element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((key (org-element-property :key keyword)) - (value (org-element-property :value keyword))) - (cond - ((string= key "LATEX") value) - ((string= key "INDEX") (format "\\index{%s}" value)) - ((string= key "TARGET") nil ; FIXME - ;; (format "\\label{%s}" (org-export-solidify-link-text value)) - ) - ((string= key "toc") - (let ((value (downcase value))) - (cond - ((string-match "\\" value) - (let ((depth (or (and (string-match "[0-9]+" value) - (string-to-number (match-string 0 value))) - (plist-get info :with-toc)))) - (when (wholenump depth) (org-e-odt-toc depth info)))) - ((string= "tables" value) "FIXME") - ((string= "figures" value) "FIXME") - ((string= "listings" value) - (cond - ;; At the moment, src blocks with a caption are wrapped - ;; into a figure environment. - (t "FIXME"))))))))) - - -;;;; Latex Environment - - -(eval-after-load 'org-odt - '(ad-deactivate 'org-format-latex-as-mathml)) - -;; (defadvice org-format-latex-as-mathml ; FIXME -;; (after org-e-odt-protect-latex-fragment activate) -;; "Encode LaTeX fragment as XML. -;; Do this when translation to MathML fails." -;; (when (or (not (> (length ad-return-value) 0)) -;; (get-text-property 0 'org-protected ad-return-value)) -;; (setq ad-return-value -;; (org-propertize (org-e-odt-encode-plain-text (ad-get-arg 0)) -;; 'org-protected t)))) - -(defun org-e-odt-format-latex (latex-frag processing-type info) - (let* ((prefix (case processing-type - (dvipng "ltxpng/") - (mathml "ltxmathml/"))) - (input-file (plist-get info :input-file)) - (cache-subdir - (concat prefix (file-name-sans-extension - (file-name-nondirectory input-file)))) - (cache-dir (file-name-directory input-file)) - (display-msg (case processing-type - (dvipng "Creating LaTeX Image...") - (mathml "Creating MathML snippet...")))) - (with-temp-buffer - (insert latex-frag) - (org-format-latex cache-subdir cache-dir nil display-msg - nil nil processing-type) - (buffer-string)))) - -(defun org-e-odt-latex-environment (latex-environment contents info) - "Transcode a LATEX-ENVIRONMENT element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-odt--wrap-label - latex-environment - (let* ((latex-frag - (org-remove-indentation - (org-element-property :value latex-environment))) - (processing-type (plist-get info :LaTeX-fragments)) - (caption (org-element-property :caption latex-environment)) - (short-caption (and (cdr caption) - (org-export-data (cdr caption) info))) - (caption (and (car caption) (org-export-data (car caption) info))) - (label (org-element-property :name latex-environment)) - (attr nil) ; FIXME - (label (org-element-property :name latex-environment))) - - (when (memq processing-type '(t mathjax)) - (unless (and (fboundp 'org-format-latex-mathml-available-p) - (org-format-latex-mathml-available-p)) - (message "LaTeX to MathML converter not available. Trying dvinpng...") - (setq processing-type 'dvipng))) - - (when (eq processing-type 'dvipng) - (unless (and (org-check-external-command "latex" "" t) - (org-check-external-command "dvipng" "" t)) - (message "LaTeX to PNG converter not available. Using verbatim.") - (setq processing-type 'verbatim))) - - (case processing-type - ((t mathjax) - (org-e-odt-format-formula latex-environment info)) - (dvipng - (format "\n%s" - "Text_20_body" - (org-e-odt-link--inline-image latex-environment info))) - (t (org-e-odt-do-format-code latex-frag)))))) - - -;;;; Latex Fragment - - -;; (when latex-frag ; FIXME -;; (setq href (org-propertize href :title "LaTeX Fragment" -;; :description latex-frag))) -;; handle verbatim -;; provide descriptions - -(defun org-e-odt-latex-fragment (latex-fragment contents info) - "Transcode a LATEX-FRAGMENT object from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (let* ((latex-frag (org-element-property :value latex-fragment)) - (processing-type (plist-get info :LaTeX-fragments))) - (cond - ((member processing-type '(t mathjax)) - (org-e-odt-format-formula latex-fragment info)) - ((eq processing-type 'dvipng) - (org-e-odt-link--inline-image latex-fragment info)) - (t (org-e-odt-encode-plain-text latex-frag t))))) - - -;;;; Line Break - -(defun org-e-odt-line-break (line-break contents info) - "Transcode a LINE-BREAK object from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - "\n") - - -;;;; Link - - - -;;;; Links :: Generic - -(defun org-e-odt-format-link (desc href &optional suppress-xref) - (cond - ((and (= (string-to-char href) ?#) (not suppress-xref)) - (setq href (substring href 1)) - (let ((xref-format "text")) - (when (numberp desc) - (setq desc (format "%d" desc) xref-format "number")) - (when (listp desc) - (setq desc (mapconcat 'number-to-string desc ".") xref-format "chapter")) - (setq href (concat org-e-odt-bookmark-prefix href)) - (format - "%s" - xref-format href desc))) - ;; (org-lparse-link-description-is-image - ;; (format "\n\n%s\n" - ;; href desc)) - (t (format "%s" - href desc)))) - -(defun org-e-odt-format-internal-link (text href) - (org-e-odt-format-link text (concat "#" href))) - -;;;; Links :: Label references - -(defun org-e-odt-enumerate-element (element info &optional predicate n) - (let* ((--numbered-parent-headline-at-<=-n - (function - (lambda (element n info) - (loop for x in (org-export-get-genealogy element) - thereis (and (eq (org-element-type x) 'headline) - (<= (org-export-get-relative-level x info) n) - (org-export-numbered-headline-p x info) - x))))) - (--enumerate - (function - (lambda (element scope info &optional predicate) - (let ((counter 0)) - (org-element-map - (or scope (plist-get info :parse-tree)) - (org-element-type element) - (lambda (el) - (and (or (not predicate) (funcall predicate el info)) - (incf counter) - (eq element el) - counter)) - info 'first-match))))) - (scope (funcall --numbered-parent-headline-at-<=-n - element (or n org-e-odt-display-outline-level) info)) - (ordinal (funcall --enumerate element scope info predicate)) - (tag - (concat - ;; Section number. - (and scope - (mapconcat 'number-to-string - (org-export-get-headline-number scope info) ".")) - ;; Separator. - (and scope ".") - ;; Ordinal. - (number-to-string ordinal)))) - tag)) - -(defun org-e-odt-format-label (element info op) - (let* ((caption-from - (case (org-element-type element) - (link (org-export-get-parent-element element)) - (t element))) - ;; get label and caption. - (label (org-element-property :name caption-from)) - (caption (org-element-property :caption caption-from)) - (short-caption (cdr caption)) - ;; transcode captions. - (caption (and (car caption) (org-export-data (car caption) info))) - (short-caption (and short-caption - (org-export-data short-caption info)))) - (when (or label caption) - (let* ((default-category - (cond - ((eq (org-element-type element) 'table) - "__Table__") - ((org-e-odt-standalone-image-p element info) - "__Figure__") - ((member (org-element-type element) - '(latex-environment latex-fragment)) - (let ((processing-type (plist-get info :LaTeX-fragments))) - (cond - ((eq processing-type 'dvipng) "__DvipngImage__") - ((eq processing-type 'mathjax) "__MathFormula__") - ((eq processing-type 't) "__MathFormula__") - (t (error "Handle LaTeX:verbatim"))))) - ((eq (org-element-type element) 'src-block) - "__Listing__") - (t (error "Handle enumeration of %S" element)))) - (predicate - (cond - ((member (org-element-type element) - '(table latex-environment src-block)) - nil) - ((org-e-odt-standalone-image-p element info) - 'org-e-odt-standalone-image-p) - (t (error "Handle enumeration of %S" element)))) - (seqno (org-e-odt-enumerate-element - element info predicate)) ; FIXME - ;; handle label props. - (label-props (assoc default-category org-e-odt-category-map-alist)) - ;; identify opendocument counter - (counter (nth 1 label-props)) - ;; identify label style - (label-style (nth 2 label-props)) - ;; retrieve localized category sting - (category (org-export-translate (nth 3 label-props) :utf-8 info))) - (case op - (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)) - - (cons - (format-spec - (cadr (assoc-string label-style org-e-odt-label-styles t)) - `((?e . ,category) - (?n . ,(format - "%s" - label counter counter seqno)) - (?c . ,(or caption "")))) - short-caption)) - (reference - (assert label) - (setq label (org-export-solidify-link-text label)) - (let* ((fmt (cddr (assoc-string label-style org-e-odt-label-styles t))) - (fmt1 (car fmt)) - (fmt2 (cadr fmt))) - (format "%s" - fmt1 label (format-spec fmt2 `((?e . ,category) - (?n . ,seqno)))))) - (t (error "Unknow %S on label" op))))))) - -;;;; Links :: Embedded images - -(defun org-e-odt-copy-image-file (path) - "Returns the internal name of the file" - (let* ((image-type (file-name-extension path)) - (media-type (format "image/%s" image-type)) - (target-dir "Images/") - (target-file - (format "%s%04d.%s" target-dir - (incf org-e-odt-embedded-images-count) image-type))) - (message "Embedding %s as %s ..." - (substring-no-properties path) target-file) - - (when (= 1 org-e-odt-embedded-images-count) - (make-directory (concat org-e-odt-zip-dir target-dir)) - (org-e-odt-create-manifest-file-entry "" target-dir)) - - (copy-file path (concat org-e-odt-zip-dir target-file) 'overwrite) - (org-e-odt-create-manifest-file-entry media-type target-file) - target-file)) - -(defun org-e-odt-image-size-from-file (file &optional user-width - user-height scale dpi embed-as) - (let* ((--pixels-to-cms - (function (lambda (pixels dpi) - (let ((cms-per-inch 2.54) - (inches (/ pixels dpi))) - (* cms-per-inch inches))))) - (--size-in-cms - (function - (lambda (size-in-pixels dpi) - (and size-in-pixels - (cons (funcall --pixels-to-cms (car size-in-pixels) dpi) - (funcall --pixels-to-cms (cdr size-in-pixels) dpi)))))) - (dpi (or dpi org-e-odt-pixels-per-inch)) - (anchor-type (or embed-as "paragraph")) - (user-width (and (not scale) user-width)) - (user-height (and (not scale) user-height)) - (size - (and - (not (and user-height user-width)) - (or - ;; Use Imagemagick. - (and (executable-find "identify") - (let ((size-in-pixels - (let ((dim (shell-command-to-string - (format "identify -format \"%%w:%%h\" \"%s\"" - file)))) - (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim) - (cons (string-to-number (match-string 1 dim)) - (string-to-number (match-string 2 dim))))))) - (funcall --size-in-cms size-in-pixels dpi))) - ;; Use Emacs. - (let ((size-in-pixels - (ignore-errors ; Emacs could be in batch mode - (clear-image-cache) - (image-size (create-image file) 'pixels)))) - (funcall --size-in-cms size-in-pixels dpi)) - ;; Use hard-coded values. - (cdr (assoc-string anchor-type - org-e-odt-default-image-sizes-alist)) - ;; Error out. - (error "Cannot determine image size, aborting")))) - (width (car size)) (height (cdr size))) - (cond - (scale - (setq width (* width scale) height (* height scale))) - ((and user-height user-width) - (setq width user-width height user-height)) - (user-height - (setq width (* user-height (/ width height)) height user-height)) - (user-width - (setq height (* user-width (/ height width)) width user-width)) - (t (ignore))) - ;; ensure that an embedded image fits comfortably within a page - (let ((max-width (car org-e-odt-max-image-size)) - (max-height (cdr org-e-odt-max-image-size))) - (when (or (> width max-width) (> height max-height)) - (let* ((scale1 (/ max-width width)) - (scale2 (/ max-height height)) - (scale (min scale1 scale2))) - (setq width (* scale width) height (* scale height))))) - (cons width height))) - -;;;; Links :: Math formula - -(defun org-e-odt-format-formula (element info) - (let* ((src (cond - ((eq (org-element-type element) 'link) ; FIXME - (let* ((type (org-element-property :type element)) - (raw-path (org-element-property :path element))) - (cond - ((file-name-absolute-p raw-path) - (expand-file-name raw-path)) - (t raw-path)))) - ((member (org-element-type element) - '(latex-fragment latex-environment)) - (let* ((latex-frag (org-remove-indentation - (org-element-property :value element))) - (formula-link (org-e-odt-format-latex - latex-frag 'mathml info))) - (and formula-link - (string-match "file:\\([^]]*\\)" formula-link) - (match-string 1 formula-link)))) - (t (error "what is this?")))) - (full-src (if (file-name-absolute-p src) src - (expand-file-name src (file-name-directory - (plist-get info :input-file))))) - (caption-from - (case (org-element-type element) - (link (org-export-get-parent-element element)) - (t element))) - (captions (org-e-odt-format-label caption-from info 'definition)) - (caption (car captions)) - (href - (format "\n" - " xlink:show=\"embed\" xlink:actuate=\"onLoad\"" - (file-name-directory (org-e-odt-copy-formula-file full-src)))) - (embed-as (if caption 'paragraph 'character)) - width height) - (cond - ((eq embed-as 'character) - (org-e-odt-format-entity "InlineFormula" href width height)) - (t - (let* ((equation (org-e-odt-format-entity - "CaptionedDisplayFormula" href width height captions)) - (label - (let* ((org-e-odt-category-map-alist - '(("__Table__" "Table" "value") - ("__Figure__" "Illustration" "value") - ("__MathFormula__" "Text" "math-label") - ("__DvipngImage__" "Equation" "value") - ("__Listing__" "Listing" "value")))) - (car (org-e-odt-format-label caption-from info 'definition)))) - (formula-tree - (org-e-odt--adopt-elements - `(table (:type org :attr_odt (":style \"OrgEquation\""))) - (org-e-odt--adopt-elements - `(table-row (:type standard)) - `(table-cell nil "") `(table-cell nil "")) - (org-e-odt--adopt-elements - `(table-row (:type standard)) - (org-e-odt--adopt-elements - `(table-cell nil) `(export-block - (:type "ODT" :value ,equation))) - (org-e-odt--adopt-elements - `(table-cell nil) `(export-block - (:type "ODT" :value ,label)))))) - (formula-info - (org-export-collect-tree-properties - formula-tree (org-export-get-environment 'e-odt)))) - (org-export-data formula-tree formula-info)))))) - -(defun org-e-odt-copy-formula-file (src-file) - "Returns the internal name of the file" - (let* ((target-dir (format "Formula-%04d/" - (incf org-e-odt-embedded-formulas-count))) - (target-file (concat target-dir "content.xml"))) - ;; Create a directory for holding formula file. Also enter it in - ;; to manifest. - (make-directory (concat org-e-odt-zip-dir target-dir)) - (org-e-odt-create-manifest-file-entry - "application/vnd.oasis.opendocument.formula" target-dir "1.2") - ;; Copy over the formula file from user directory to zip - ;; directory. - (message "Embedding %s as %s ..." src-file target-file) - (let ((case-fold-search nil)) - (cond - ;; Case 1: Mathml. - ((string-match "\\.\\(mathml\\|mml\\)\\'" src-file) - (copy-file src-file (concat org-e-odt-zip-dir target-file) 'overwrite)) - ;; Case 2: OpenDocument formula. - ((string-match "\\.odf\\'" src-file) - (org-e-odt--zip-extract src-file "content.xml" - (concat org-e-odt-zip-dir target-dir))) - (t (error "%s is not a formula file" src-file)))) - ;; Enter the formula file in to manifest. - (org-e-odt-create-manifest-file-entry "text/xml" target-file) - target-file)) - -;;;; Targets - -(defun org-e-odt-format-target (text id) - (let ((name (concat org-e-odt-bookmark-prefix id))) - (concat - (and id (format "\n" name)) - (concat (and id (format "\n" id)) text) - (and id (format "\n" name))))) - -(defun org-e-odt-link--inline-image (element 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." - (let* ((src (cond - ((eq (org-element-type element) 'link) - (let* ((type (org-element-property :type element)) - (raw-path (org-element-property :path element))) - (cond ((member type '("http" "https")) - (concat type ":" raw-path)) - ((file-name-absolute-p raw-path) - (expand-file-name raw-path)) - (t raw-path)))) - ((member (org-element-type element) - '(latex-fragment latex-environment)) - (let* ((latex-frag (org-remove-indentation - (org-element-property :value element))) - (formula-link (org-e-odt-format-latex - latex-frag 'dvipng info))) - (and formula-link - (string-match "file:\\([^]]*\\)" formula-link) - (match-string 1 formula-link)))) - (t (error "what is this?")))) - (src-expanded (if (file-name-absolute-p src) src - (expand-file-name src (file-name-directory - (plist-get info :input-file))))) - (href (format - "\n" - (org-e-odt-copy-image-file src-expanded))) - ;; extract attributes from #+ATTR_ODT line. - (attr-from (case (org-element-type element) - (link (org-export-get-parent-element element)) - (t element))) - ;; convert attributes to a plist. - (attr-plist (org-export-read-attribute :attr_odt attr-from)) - ;; handle `:anchor', `:style' and `:attributes' properties. - (user-frame-anchor - (car (assoc-string (plist-get attr-plist :anchor) - '(("as-char") ("paragraph") ("page")) t))) - (user-frame-style - (and user-frame-anchor (plist-get attr-plist :style))) - (user-frame-attrs - (and user-frame-anchor (plist-get attr-plist :attributes))) - (user-frame-params - (list user-frame-style user-frame-attrs user-frame-anchor)) - ;; (embed-as (or embed-as user-frame-anchor "paragraph")) - ;; extrac - ;; handle `:width', `:height' and `:scale' properties. - (size (org-e-odt-image-size-from-file - src-expanded (plist-get attr-plist :width) - (plist-get attr-plist :height) - (plist-get attr-plist :scale) nil ;; embed-as - "paragraph" ; FIXME - )) - (width (car size)) (height (cdr size)) - (embed-as - (case (org-element-type element) - ((org-e-odt-standalone-image-p element info) "paragraph") - (latex-fragment "as-char") - (latex-environment "paragraph") - (t "paragraph"))) - (captions (org-e-odt-format-label element info 'definition)) - (caption (car captions)) (short-caption (cdr captions)) - (entity (concat (and caption "Captioned") embed-as "Image"))) - (org-e-odt-format-entity entity href width height - captions user-frame-params ))) - -(defun org-e-odt-format-entity (entity href width height &optional - captions user-frame-params) - (let* ((caption (car captions)) (short-caption (cdr captions)) - (entity-style (assoc-string entity org-e-odt-entity-frame-styles t)) - default-frame-params frame-params - (--merge-frame-params - (function - (lambda (default-frame-params user-frame-params) - (if (not user-frame-params) default-frame-params - (assert (= (length default-frame-params) 3)) - (assert (= (length user-frame-params) 3)) - (loop for user-frame-param in user-frame-params - for default-frame-param in default-frame-params - collect (or user-frame-param default-frame-param))))))) - (cond - ((not caption) - (setq default-frame-params (nth 2 entity-style)) - (setq frame-params (funcall --merge-frame-params - default-frame-params user-frame-params)) - (apply 'org-e-odt--frame href width height frame-params)) - (t - (setq default-frame-params (nth 3 entity-style)) - (setq frame-params (funcall --merge-frame-params - default-frame-params user-frame-params)) - (apply 'org-e-odt--textbox - (format "\n%s" - "Illustration" - (concat - (apply 'org-e-odt--frame href width height - (let ((entity-style-1 (copy-sequence - (nth 2 entity-style)))) - (setcar (cdr entity-style-1) - (concat - (cadr entity-style-1) - (and short-caption - (format " draw:name=\"%s\" " - short-caption)))) - entity-style-1)) - caption)) - width height frame-params))))) - -(defun org-e-odt-standalone-image-p (element info) - "Test if ELEMENT is a standalone image for the purpose ODT export. -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 -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 nil, otherwise. - -Bind `org-e-odt-standalone-image-predicate' to constrain -paragraph further. For example, to check for only captioned -standalone images, do the following. - - \(setq org-e-odt-standalone-image-predicate - \(lambda \(paragraph\) - \(org-element-property :caption paragraph\)\)\) -" - (let ((--standalone-image-predicate - (function (lambda (paragraph) - (or (org-element-property :caption paragraph) - (org-element-property :name paragraph))))) - (paragraph (case (org-element-type element) - (paragraph element) - (link (and (org-export-inline-image-p - element org-e-odt-inline-image-rules) - (org-export-get-parent element))) - (t nil)))) - (when paragraph - (assert (eq (org-element-type paragraph) 'paragraph)) - (when (funcall --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-e-odt-inline-image-rules) - (= (incf inline-image-count) 1))) - (t nil)))))))) - -(defun org-e-odt-link (link desc info) - "Transcode a LINK object from Org to ODT. - -DESC is the description part of the link, or the empty string. -INFO is a plist holding contextual information. See -`org-export-data'." - (let* ((type (org-element-property :type link)) - (raw-path (org-element-property :path link)) - ;; Ensure DESC really exists, or set it to nil. - (desc (and (not (string= desc "")) desc)) - (imagep (org-export-inline-image-p - link org-e-odt-inline-image-rules)) - (path (cond - ((member type '("http" "https" "ftp" "mailto")) - (concat type ":" raw-path)) - ((string= type "file") - (when (string-match "\\(.+\\)::.+" raw-path) - (setq raw-path (match-string 1 raw-path))) - (if (file-name-absolute-p raw-path) - (concat "file://" (expand-file-name raw-path)) - (concat "file://" raw-path))) - (t raw-path))) - protocol) - (cond - ;; Image file. - ((and (not desc) (org-export-inline-image-p - link org-e-odt-inline-image-rules)) - (org-e-odt-link--inline-image link info)) - ;; Radio target: Transcode target's contents and use them as - ;; link's description. - ((string= type "radio") - (let ((destination (org-export-resolve-radio-link link info))) - (when destination - (org-e-odt-format-internal-link - (org-export-data (org-element-contents destination) info) - (org-export-solidify-link-text path))))) - ;; Links pointing to an headline: Find destination and build - ;; appropriate referencing command. - ((member type '("custom-id" "fuzzy" "id")) - (let ((destination (if (string= type "fuzzy") - (org-export-resolve-fuzzy-link link info) - (org-export-resolve-id-link link info)))) - (case (org-element-type destination) - ;; Fuzzy link points nowhere. - ('nil - (format "%s" - "Emphasis" (or desc (org-export-data - (org-element-property - :raw-link link) info)))) - ;; Fuzzy link points to an invisible target. - (keyword nil) - ;; LINK points to an headline. Check if LINK should display - ;; section numbers. - (headline - (let* ((headline-no (org-export-get-headline-number destination info)) - (label (format "sec-%s" (mapconcat 'number-to-string - headline-no "-"))) - (desc - ;; Case 1: Headline is numbered and LINK has no - ;; description or LINK's description matches - ;; headline's title. Display section number. - (if (and (org-export-numbered-headline-p destination info) - (or (not desc) - (string= desc (org-element-property - :raw-value destination)))) - headline-no - ;; Case 2: Either the headline is un-numbered or - ;; LINK has a custom description. Display LINK's - ;; description or headline's title. - (or desc (org-export-data (org-element-property - :title destination) info))))) - (org-e-odt-format-internal-link desc label))) - ;; Fuzzy link points to a target. Do as above. - (otherwise - ;; (unless desc - ;; (setq number (cond - ;; ((org-e-odt-standalone-image-p destination info) - ;; (org-export-get-ordinal - ;; (assoc 'link (org-element-contents destination)) - ;; info 'link 'org-e-odt-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 "."))))) - - (let ((label-reference - (org-e-odt-format-label destination info 'reference))) - (assert label-reference) - label-reference))))) - ;; Coderef: replace link with the reference name or the - ;; equivalent line number. - ((string= type "coderef") - (let* ((fmt (org-export-get-coderef-format path desc)) - (res (org-export-resolve-coderef path info)) - (href (concat "#coderef-" path))) - (format fmt (org-e-odt-format-link res href)))) - ;; Link type is handled by a special function. - ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) - (funcall protocol (org-link-unescape path) desc 'odt)) - ;; External link with a description part. - ((and path desc) (org-e-odt-format-link desc path)) - ;; External link without a description part. - (path (org-e-odt-format-link path path)) - ;; No path, only description. Try to do something useful. - (t (format "%s" - "Emphasis" desc))))) - - -;;;; Babel Call - -;; Babel Calls are ignored. - - -;;;; Macro - -(defun org-e-odt-macro (macro contents info) - "Transcode a MACRO element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - ;; Use available tools. - (org-export-expand-macro macro info)) - - -;;;; Paragraph - -(defun org-e-odt-paragraph (paragraph contents info) - "Transcode a PARAGRAPH element from Org to ODT. -CONTENTS is the contents of the paragraph, as a string. INFO is -the plist used as a communication channel." - (let* ((parent (org-export-get-parent paragraph)) - (parent-type (org-element-type parent)) - (style (case parent-type - (quote-block "Quotations") - (center-block "OrgCenter") - (footnote-definition "Footnote") - (t "Text_20_body")))) - ;; If this paragraph is a leading paragraph in a non-descriptive - ;; item and the item has a checkbox, splice the checkbox and - ;; paragraph contents together. - (when (and (eq (org-element-type parent) 'item) - (not (eq (org-element-property :type - (org-export-get-parent parent)) - 'descriptive)) - (eq paragraph (car (org-element-contents parent)))) - (setq contents (concat (org-e-odt--checkbox parent) contents))) - (assert style) - (format "\n%s" style contents))) - - -;;;; Plain List - -(defun org-e-odt-plain-list (plain-list contents info) - "Transcode a PLAIN-LIST element from Org to ODT. -CONTENTS is the contents of the list. INFO is a plist holding -contextual information." - (let* ((type (org-element-property :type plain-list)) - (continue-numbering nil)) - (assert (member type '(ordered unordered descriptive))) - (org-e-odt--wrap-label - plain-list - (format "\n\n%s" - (assoc-default type '((ordered . "OrgNumberedList") - (unordered . "OrgBulletedList") - (descriptive . "OrgDescriptionList"))) - ;; If top-level list, re-start numbering. Otherwise, - ;; continue numbering. - (format "text:continue-numbering=\"%s\"" - (let* ((parent (org-export-get-parent plain-list))) - (if (and parent (eq (org-element-type parent) 'item)) - "true" "false"))) - contents)))) - -;;;; Plain Text - -(defun org-e-odt-fill-tabs-and-spaces (line) - (replace-regexp-in-string - "\\([\t]\\|\\([ ]+\\)\\)" - (lambda (s) - (cond - ((string= s "\t") "") - (t (let ((n (length s))) - (cond - ((= n 1) " ") - ((> n 1) (concat " " (format "" (1- n)))) - (t "")))))) - line)) - -(defun org-e-odt-encode-plain-text (text &optional no-whitespace-filling) - (mapc - (lambda (pair) - (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))) - '(("&" . "&") ("<" . "<") (">" . ">"))) - (if no-whitespace-filling text - (org-e-odt-fill-tabs-and-spaces text))) - -(defun org-e-odt--quotation-marks (text info) - "Export quotation marks depending on language conventions. -TEXT is a string containing quotation marks to be replaced. INFO -is a plist used as a communication channel." - (mapc (lambda(l) - (let ((start 0)) - (while (setq start (string-match (car l) text start)) - (let ((new-quote (concat (match-string 1 text) (cdr l)))) - (setq text (replace-match new-quote t t text)))))) - (cdr (or (assoc (plist-get info :language) org-e-odt-quotes) - ;; Falls back on English. - (assoc "en" org-e-odt-quotes)))) - text) - -(defun org-e-odt-plain-text (text info) - "Transcode a TEXT string from Org to ODT. -TEXT is the string to transcode. INFO is a plist holding -contextual information." - ;; Protect &, < and >. - (setq text (org-e-odt-encode-plain-text text t)) - ;; Handle quotation marks - (setq text (org-e-odt--quotation-marks text info)) - ;; Convert special strings. - (when (plist-get info :with-special-strings) - (mapc - (lambda (pair) - (setq text (replace-regexp-in-string (car pair) (cdr pair) text t nil))) - org-e-odt-special-string-regexps)) - ;; Handle break preservation if required. - (when (plist-get info :preserve-breaks) - (setq text (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" "\n" text t))) - ;; Return value. - text) - - -;;;; Planning - -(defun org-e-odt-planning (planning contents info) - "Transcode a PLANNING element from Org to ODT. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (format "%s" - "OrgTimestampWrapper" - (concat - (let ((closed (org-element-property :closed planning))) - (when closed - (concat - (format "%s" - "OrgTimestampKeyword" org-closed-string) - (format "%s" - "OrgTimestamp" (org-translate-time closed))))) - (let ((deadline (org-element-property :deadline planning))) - (when deadline - (concat - (format "%s" - "OrgTimestampKeyword" org-deadline-string) - (format "%s" - "OrgTimestamp" (org-translate-time deadline))))) - (let ((scheduled (org-element-property :scheduled planning))) - (when scheduled - (concat - (format "%s" - "OrgTimestampKeyword" org-scheduled-string) - (format "%s" - "OrgTimestamp" (org-translate-time scheduled)))))))) - - -;;;; Property Drawer - -(defun org-e-odt-property-drawer (property-drawer contents info) - "Transcode a PROPERTY-DRAWER element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual -information." - ;; The property drawer isn't exported but we want separating blank - ;; lines nonetheless. - "") - - -;;;; Quote Block - -(defun org-e-odt-quote-block (quote-block contents info) - "Transcode a QUOTE-BLOCK element from Org to ODT. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (org-e-odt--wrap-label quote-block contents)) - - -;;;; Quote Section - -(defun org-e-odt-quote-section (quote-section contents info) - "Transcode a QUOTE-SECTION element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((value (org-remove-indentation - (org-element-property :value quote-section)))) - (when value (org-e-odt-do-format-code value)))) - - -;;;; Section - - -(defun org-e-odt-format-section (text style &optional name) - (let ((default-name (car (org-e-odt-add-automatic-style "Section")))) - (format "\n\n%s" - style - (format "text:name=\"%s\"" (or name default-name)) - text))) - - -(defun org-e-odt-section (section contents info) ; FIXME - "Transcode a SECTION element from Org to ODT. -CONTENTS holds the contents of the section. INFO is a plist -holding contextual information." - contents) - -;;;; Radio Target - -(defun org-e-odt-radio-target (radio-target text info) - "Transcode a RADIO-TARGET object from Org to ODT. -TEXT is the text of the target. INFO is a plist holding -contextual information." - (org-e-odt-format-target - text (org-export-solidify-link-text - (org-element-property :value radio-target)))) - - -;;;; Special Block - -(defun org-e-odt-special-block (special-block contents info) - "Transcode a SPECIAL-BLOCK element from Org to ODT. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let ((type (downcase (org-element-property :type special-block))) - (attributes (org-export-read-attribute :attr_odt special-block))) - (org-e-odt--wrap-label - special-block - (cond - ;; Annotation. - ((string= type "annotation") - (let ((author (or (plist-get attributes :author) - (let ((author (plist-get info :author))) - (and author (org-export-data author info))))) - (date (or (plist-get attributes :date) - (plist-get info :date)))) - - (format "\n%s" - "Text_20_body" - (format "\n%s\n" - (concat - (and author - (format "%s" author)) - (and date - (format "%s" - (org-e-odt--date date))) - contents))))) - ;; Textbox. - ((string= type "textbox") - (let ((width (plist-get attributes :width)) - (height (plist-get attributes :height)) - (style (plist-get attributes :style)) - (extra (plist-get attributes :extra)) - (anchor (plist-get attributes :anchor))) - (format "\n%s" - "Text_20_body" (org-e-odt--textbox contents width height - style extra anchor)))) - (t contents))))) - - -;;;; Src Block - - -(defun org-e-odt-hfy-face-to-css (fn) - "Create custom style for face FN. -When FN is the default face, use it's foreground and background -properties to create \"OrgSrcBlock\" paragraph style. Otherwise -use it's color attribute to create a character style whose name -is obtained from FN. Currently all attributes of FN other than -color are ignored. - -The style name for a face FN is derived using the following -operations on the face name in that order - de-dash, CamelCase -and prefix with \"OrgSrc\". For example, -`font-lock-function-name-face' is associated with -\"OrgSrcFontLockFunctionNameFace\"." - (let* ((css-list (hfy-face-to-style fn)) - (style-name ((lambda (fn) - (concat "OrgSrc" - (mapconcat - 'capitalize (split-string - (hfy-face-or-def-to-name fn) "-") - ""))) fn)) - (color-val (cdr (assoc "color" css-list))) - (background-color-val (cdr (assoc "background" css-list))) - (style (and org-e-odt-create-custom-styles-for-srcblocks - (cond - ((eq fn 'default) - (format org-e-odt-src-block-paragraph-format - background-color-val color-val)) - (t - (format - " - - - " style-name color-val)))))) - (cons style-name style))) - -(defun org-e-odt-htmlfontify-string (line) - (let* ((hfy-html-quote-regex "\\([<\"&> ]\\)") - (hfy-html-quote-map '(("\"" """) - ("<" "<") - ("&" "&") - (">" ">") - (" " "") - (" " ""))) - (hfy-face-to-css 'org-e-odt-hfy-face-to-css) - (hfy-optimisations-1 (copy-seq hfy-optimisations)) - (hfy-optimisations (add-to-list 'hfy-optimisations-1 - 'body-text-only)) - (hfy-begin-span-handler - (lambda (style text-block text-id text-begins-block-p) - (insert (format "" style)))) - (hfy-end-span-handler (lambda nil (insert "")))) - (org-no-warnings (htmlfontify-string line)))) - -(defun org-e-odt-do-format-code - (code &optional lang refs retain-labels num-start) - (let* ((lang (or (assoc-default lang org-src-lang-modes) lang)) - (lang-mode (and lang (intern (format "%s-mode" lang)))) - (code-lines (org-split-string code "\n")) - (code-length (length code-lines)) - (use-htmlfontify-p (and (functionp lang-mode) - org-e-odt-fontify-srcblocks - (require 'htmlfontify nil t) - (fboundp 'htmlfontify-string))) - (code (if (not use-htmlfontify-p) code - (with-temp-buffer - (insert code) - (funcall lang-mode) - (font-lock-fontify-buffer) - (buffer-string)))) - (fontifier (if use-htmlfontify-p 'org-e-odt-htmlfontify-string - 'org-e-odt-encode-plain-text)) - (par-style (if use-htmlfontify-p "OrgSrcBlock" - "OrgFixedWidthBlock")) - (i 0)) - (assert (= code-length (length (org-split-string code "\n")))) - (setq code - (org-export-format-code - code - (lambda (loc line-num ref) - (setq par-style - (concat par-style (and (= (incf i) code-length) "LastLine"))) - - (setq loc (concat loc (and ref retain-labels (format " (%s)" ref)))) - (setq loc (funcall fontifier loc)) - (when ref - (setq loc (org-e-odt-format-target loc (concat "coderef-" ref)))) - (assert par-style) - (setq loc (format "\n%s" - par-style loc)) - (if (not line-num) loc - (format "\n%s\n" loc))) - num-start refs)) - (cond - ((not num-start) code) - ((= num-start 0) - (format - "\n%s" - " text:continue-numbering=\"false\"" code)) - (t - (format - "\n%s" - " text:continue-numbering=\"true\"" code))))) - -(defun org-e-odt-format-code (element info) - (let* ((lang (org-element-property :language element)) - ;; Extract code and references. - (code-info (org-export-unravel-code element)) - (code (car code-info)) - (refs (cdr code-info)) - ;; Does the src block contain labels? - (retain-labels (org-element-property :retain-labels element)) - ;; Does it have line numbers? - (num-start (case (org-element-property :number-lines element) - (continued (org-export-get-loc element info)) - (new 0)))) - (org-e-odt-do-format-code code lang refs retain-labels num-start))) - -(defun org-e-odt-src-block (src-block contents info) - "Transcode a SRC-BLOCK element from Org to ODT. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((lang (org-element-property :language src-block)) - (caption (org-element-property :caption src-block)) - (short-caption (and (cdr caption) - (org-export-data (cdr caption) info))) - (caption (and (car caption) (org-export-data (car caption) info))) - (label (org-element-property :name src-block)) - (attributes (org-export-read-attribute :attr_odt src-block))) - ;; FIXME: Handle caption - ;; caption-str (when caption) - ;; (main (org-export-data (car caption) info)) - ;; (secondary (org-export-data (cdr caption) info)) - ;; (caption-str (org-e-odt--caption/label-string caption label info)) - (let* ((captions (org-e-odt-format-label src-block info 'definition)) - (caption (car captions)) (short-caption (cdr captions))) - (concat - (and caption - (format "\n%s" - "Listing" caption)) - (let ((--src-block (org-e-odt-format-code src-block info))) - (if (not (plist-get attributes :textbox)) --src-block - (format "\n%s" - "Text_20_body" - (org-e-odt--textbox --src-block nil nil nil)))))))) - - -;;;; Statistics Cookie - -(defun org-e-odt-statistics-cookie (statistics-cookie contents info) - "Transcode a STATISTICS-COOKIE object from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((cookie-value (org-element-property :value statistics-cookie))) - (format "%s" - "OrgCode" cookie-value))) - - -;;;; Strike-Through - -(defun org-e-odt-strike-through (strike-through contents info) - "Transcode STRIKE-THROUGH from Org to ODT. -CONTENTS is the text with strike-through markup. INFO is a plist -holding contextual information." - (format "%s" - "Strikethrough" contents)) - - -;;;; Subscript - -(defun org-e-odt-subscript (subscript contents info) - "Transcode a SUBSCRIPT object from Org to ODT. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (format "%s" - "OrgSubscript" contents)) - - -;;;; Superscript - -(defun org-e-odt-superscript (superscript contents info) - "Transcode a SUPERSCRIPT object from Org to ODT. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (format "%s" - "OrgSuperscript" contents)) - - -;;;; Table Cell - -(defun org-e-odt-table-style-spec (element info) - (let* ((table (org-export-get-parent-table element)) - (table-attributes (org-export-read-attribute :attr_odt table)) - (table-style (plist-get table-attributes :style))) - (assoc table-style org-e-odt-table-styles))) - -(defun org-e-odt-get-table-cell-styles (table-cell info) - "Retrieve styles applicable to a table cell. -R and C are (zero-based) row and column numbers of the table -cell. STYLE-SPEC is an entry in `org-e-odt-table-styles' -applicable to the current table. It is `nil' if the table is not -associated with any style attributes. - -Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME). - -When STYLE-SPEC is nil, style the table cell the conventional way -- choose cell borders based on row and column groupings and -choose paragraph alignment based on `org-col-cookies' text -property. See also -`org-e-odt-get-paragraph-style-cookie-for-table-cell'. - -When STYLE-SPEC is non-nil, ignore the above cookie and return -styles congruent with the ODF-1.2 specification." - (let* ((table-cell-address (org-export-table-cell-address table-cell info)) - (r (car table-cell-address)) (c (cdr table-cell-address)) - (style-spec (org-e-odt-table-style-spec table-cell info)) - (table-dimensions (org-export-table-dimensions - (org-export-get-parent-table table-cell) - info))) - (when style-spec - ;; LibreOffice - particularly the Writer - honors neither table - ;; templates nor custom table-cell styles. Inorder to retain - ;; inter-operability with LibreOffice, only automatic styles are - ;; used for styling of table-cells. The current implementation is - ;; congruent with ODF-1.2 specification and hence is - ;; future-compatible. - - ;; Additional Note: LibreOffice's AutoFormat facility for tables - - ;; which recognizes as many as 16 different cell types - is much - ;; richer. Unfortunately it is NOT amenable to easy configuration - ;; by hand. - (let* ((template-name (nth 1 style-spec)) - (cell-style-selectors (nth 2 style-spec)) - (cell-type - (cond - ((and (cdr (assoc 'use-first-column-styles cell-style-selectors)) - (= c 0)) "FirstColumn") - ((and (cdr (assoc 'use-last-column-styles cell-style-selectors)) - (= (1+ c) (cdr table-dimensions))) - "LastColumn") - ((and (cdr (assoc 'use-first-row-styles cell-style-selectors)) - (= r 0)) "FirstRow") - ((and (cdr (assoc 'use-last-row-styles cell-style-selectors)) - (= (1+ r) (car table-dimensions))) - "LastRow") - ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) - (= (% r 2) 1)) "EvenRow") - ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) - (= (% r 2) 0)) "OddRow") - ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) - (= (% c 2) 1)) "EvenColumn") - ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) - (= (% c 2) 0)) "OddColumn") - (t "")))) - (concat template-name cell-type))))) - -(defun org-e-odt-table-cell (table-cell contents info) - "Transcode a TABLE-CELL element from Org to ODT. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (let* ((table-cell-address (org-export-table-cell-address table-cell info)) - (r (car table-cell-address)) - (c (cdr table-cell-address)) - (horiz-span (or (org-export-table-cell-width table-cell info) 0)) - (table-row (org-export-get-parent table-cell)) - (custom-style-prefix (org-e-odt-get-table-cell-styles - table-cell info)) - (paragraph-style - (or - (and custom-style-prefix - (format "%sTableParagraph" custom-style-prefix)) - (concat - (cond - ((and (= 1 (org-export-table-row-group table-row info)) - (org-export-table-has-header-p - (org-export-get-parent-table table-row) info)) - "OrgTableHeading") - ((let* ((table (org-export-get-parent-table table-cell)) - (table-attrs (org-export-read-attribute :attr_odt table)) - (table-header-columns (plist-get table-attrs - :header-columns))) - (<= c (cond ((wholenump table-header-columns) - (- table-header-columns 1)) - (table-header-columns 0) - (t -1)))) - "OrgTableHeading") - (t "OrgTableContents")) - (capitalize (symbol-name (org-export-table-cell-alignment - table-cell info)))))) - (cell-style-name - (or - (and custom-style-prefix (format "%sTableCell" - custom-style-prefix)) - (concat - "OrgTblCell" - (when (or (org-export-table-row-starts-rowgroup-p table-row info) - (zerop r)) "T") - (when (org-export-table-row-ends-rowgroup-p table-row info) "B") - (when (and (org-export-table-cell-starts-colgroup-p table-cell info) - (not (zerop c)) ) "L")))) - (cell-attributes - (concat - (format " table:style-name=\"%s\"" cell-style-name) - (and (> horiz-span 0) - (format " table:number-columns-spanned=\"%d\"" - (1+ horiz-span)))))) - (unless contents (setq contents "")) - (concat - (assert paragraph-style) - (format "\n\n%s\n" - cell-attributes - (format "\n%s" - paragraph-style contents)) - (let (s) - (dotimes (i horiz-span s) - (setq s (concat s "\n")))) - "\n"))) - - -;;;; Table Row - -(defun org-e-odt-table-row (table-row contents info) - "Transcode a TABLE-ROW element from Org to ODT. -CONTENTS is the contents of the row. INFO is a plist used as a -communication channel." - ;; Rules are ignored since table separators are deduced from - ;; borders of the current row. - (when (eq (org-element-property :type table-row) 'standard) - (let* ((rowgroup-tags - (if (and (= 1 (org-export-table-row-group table-row info)) - (org-export-table-has-header-p - (org-export-get-parent-table table-row) info)) - ;; If the row belongs to the first rowgroup and the - ;; table has more than one row groups, then this row - ;; belongs to the header row group. - '("\n" . "\n") - ;; Otherwise, it belongs to non-header row group. - '("\n" . "\n")))) - (concat - ;; Does this row begin a rowgroup? - (when (org-export-table-row-starts-rowgroup-p table-row info) - (car rowgroup-tags)) - ;; Actual table row - (format "\n\n%s\n" contents) - ;; Does this row end a rowgroup? - (when (org-export-table-row-ends-rowgroup-p table-row info) - (cdr rowgroup-tags)))))) - - -;;;; Table - -(defun org-e-odt-table-first-row-data-cells (table info) - (let ((table-row - (org-element-map - table 'table-row - (lambda (row) - (unless (eq (org-element-property :type row) 'rule) row)) - info 'first-match)) - (special-column-p (org-export-table-has-special-column-p table))) - (if (not special-column-p) (org-element-contents table-row) - (cdr (org-element-contents table-row))))) - -(defun org-e-odt--table (table contents info) - "Transcode a TABLE element from Org to ODT. -CONTENTS is the contents of the table. INFO is a plist holding -contextual information." - (case (org-element-property :type table) - ;; Case 1: table.el doesn't support export to OD format. Strip - ;; such tables from export. - (table.el - (prog1 nil - (message - (concat - "(org-e-odt): Found table.el-type table in the source Org file." - " table.el doesn't support export to ODT format." - " Stripping the table from export.")))) - ;; Case 2: Native Org tables. - (otherwise - (let* ((captions (org-e-odt-format-label table info 'definition)) - (caption (car captions)) (short-caption (cdr captions)) - (attributes (org-export-read-attribute :attr_odt table)) - (custom-table-style (nth 1 (org-e-odt-table-style-spec table info))) - (table-column-specs - (function - (lambda (table info) - (let* ((table-style (or custom-table-style "OrgTable")) - (column-style (format "%sColumn" table-style))) - (mapconcat - (lambda (table-cell) - (let ((width (1+ (or (org-export-table-cell-width - table-cell info) 0))) - (s (format - "\n" - column-style)) - out) - (dotimes (i width out) (setq out (concat s out))))) - (org-e-odt-table-first-row-data-cells table info) "\n")))))) - (concat - ;; caption. - (when caption - (format "\n%s" - "Table" caption)) - ;; begin table. - (let* ((automatic-name - (org-e-odt-add-automatic-style "Table" attributes))) - (format - "\n" - (or short-caption (car automatic-name)) - (or custom-table-style (cdr automatic-name) "OrgTable"))) - ;; column specification. - (funcall table-column-specs table info) - ;; actual contents. - "\n" contents - ;; end table. - ""))))) - -(defun org-e-odt-table (table contents info) - "Transcode a TABLE element from Org to ODT. -CONTENTS is the contents of the table. INFO is a plist holding -contextual information." - (let* ((--get-previous-elements - (function - (lambda (blob info) - (let ((parent (org-export-get-parent blob))) - (cdr (member blob (reverse (org-element-contents parent)))))))) - (--element-preceded-by-table-p - (function - (lambda (element info) - (loop for el in (funcall --get-previous-elements element info) - thereis (eq (org-element-type el) 'table))))) - (--walk-list-genealogy-and-collect-tags - (function - (lambda (table info) - (let* ((genealogy (org-export-get-genealogy table)) - (list-genealogy - (when (eq (org-element-type (car genealogy)) 'item) - (loop for el in genealogy - when (member (org-element-type el) - '(item plain-list)) - collect el)))) - (loop for el in list-genealogy - with parent-list collect - (case (org-element-type el) - (plain-list - (setq parent-list el) - `("" - . ,(let ((type (org-element-property :type el))) - (format - "" - (assoc-default - type '((ordered . "OrgNumberedList") - (unordered . "OrgBulletedList") - (descriptive . "OrgDescriptionList"))) - "text:continue-numbering=\"true\"")))) - (item - (cond - ((not parent-list) - (if (funcall --element-preceded-by-table-p table info) - '("" . "") - '("" . ""))) - ((funcall --element-preceded-by-table-p - parent-list info) - '("" . "")) - (t '("" . "")))))))))) - (close-open-tags (funcall --walk-list-genealogy-and-collect-tags - table info))) - ;; OpenDocument schema does not permit table to occur within a - ;; list item. So, to typeset an indented table, we make use of - ;; list continuations. - (concat "\n" - ;; Discontinue the list. - (mapconcat 'car close-open-tags "\n") - ;; Put the table in an indented section. - (let* ((table (org-e-odt--table table contents info)) - (level (/ (length (mapcar 'car close-open-tags)) 2)) - (style (format "OrgIndentedSection-Level-%d" level))) - (when table (org-e-odt-format-section table style))) - ;; Continue the list. - (mapconcat 'cdr (nreverse close-open-tags) "\n")))) - - -;;;; Target - -(defun org-e-odt-target (target contents info) - "Transcode a TARGET object from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual -information." - (org-e-odt-format-target - "" (org-export-solidify-link-text (org-element-property :value target)))) - - -;;;; Timestamp - -(defun org-e-odt-timestamp (timestamp contents info) - "Transcode a TIMESTAMP object from Org to ODT. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (let ((timestamp-1 (org-element-property :value timestamp)) - (timestamp-2 (org-element-property :range-end timestamp))) - (format "%s" - "OrgTimestampWrapper" - (concat - (format "%s" - "OrgTimestamp" (org-translate-time timestamp-1)) - (and timestamp-2 - "–" - (format "%s" - "OrgTimestamp" (org-translate-time timestamp-2))))))) - - -;;;; Underline - -(defun org-e-odt-underline (underline contents info) - "Transcode UNDERLINE from Org to ODT. -CONTENTS is the text with underline markup. INFO is a plist -holding contextual information." - (format "%s" - "Underline" contents)) - - -;;;; Verbatim - -(defun org-e-odt-verbatim (verbatim contents info) - "Transcode a VERBATIM object from Org to ODT. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (format "%s" - "OrgCode" (org-element-property :value verbatim))) - - -;;;; Verse Block - -(defun org-e-odt-verse-block (verse-block contents info) - "Transcode a VERSE-BLOCK element from Org to ODT. -CONTENTS is verse block contents. INFO is a plist holding -contextual information." - ;; Add line breaks to each line of verse. - (setq contents (replace-regexp-in-string - "\\(\\)?[ \t]*\n" - "" contents)) - ;; Replace tabs and spaces. - (setq contents (org-e-odt-fill-tabs-and-spaces contents)) - ;; Surround it in a verse environment. - (org-e-odt--wrap-label - verse-block - (format "\n%s" - "OrgVerse" contents))) - - - - - -;;; Interactive functions - -(defun org-e-odt-create-manifest-file-entry (&rest args) - (push args org-e-odt-manifest-file-entries)) - -(defun org-e-odt-write-manifest-file () - (make-directory (concat org-e-odt-zip-dir "META-INF")) - (let ((manifest-file (concat org-e-odt-zip-dir "META-INF/manifest.xml"))) - (with-current-buffer - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect manifest-file t)) - (insert - " - \n") - (mapc - (lambda (file-entry) - (let* ((version (nth 2 file-entry)) - (extra (if (not version) "" - (format " manifest:version=\"%s\"" version)))) - (insert - (format org-e-odt-manifest-file-entry-tag - (nth 0 file-entry) (nth 1 file-entry) extra)))) - org-e-odt-manifest-file-entries) - (insert "\n")))) - -(defmacro org-e-odt--export-wrap (out-file &rest body) - `(let* ((--out-file ,out-file) - (out-file-type (file-name-extension --out-file)) - (org-e-odt-xml-files '("META-INF/manifest.xml" "content.xml" - "meta.xml" "styles.xml")) - ;; Initialize workarea. All files that end up in the - ;; exported get created here. - (org-e-odt-zip-dir (file-name-as-directory - (make-temp-file (format "%s-" out-file-type) t))) - (org-e-odt-manifest-file-entries nil) - (--cleanup-xml-buffers - (function - (lambda nil - ;; Kill all XML buffers. - (mapc (lambda (file) - (let ((buf (get-file-buffer - (concat org-e-odt-zip-dir file)))) - (when buf - (set-buffer-modified-p nil) - (kill-buffer buf)))) - org-e-odt-xml-files) - ;; Delete temporary directory and also other embedded - ;; files that get copied there. - (delete-directory org-e-odt-zip-dir t))))) - (condition-case - err - (progn - (unless (executable-find "zip") - ;; Not at all OSes ship with zip by default - (error "Executable \"zip\" needed for creating OpenDocument files")) - ;; Do export. This creates a bunch of xml files ready to be - ;; saved and zipped. - (progn ,@body) - ;; Create a manifest entry for content.xml. - (org-e-odt-create-manifest-file-entry "text/xml" "content.xml") - - ;; Write mimetype file - (let* ((mimetypes - '(("odt" . "application/vnd.oasis.opendocument.text") - ("odf" . "application/vnd.oasis.opendocument.formula"))) - (mimetype (cdr (assoc-string out-file-type mimetypes t)))) - (unless mimetype - (error "Unknown OpenDocument backend %S" out-file-type)) - (write-region mimetype nil (concat org-e-odt-zip-dir "mimetype")) - (org-e-odt-create-manifest-file-entry mimetype "/" "1.2")) - ;; Write out the manifest entries before zipping - (org-e-odt-write-manifest-file) - ;; Save all XML files. - (mapc (lambda (file) - (let ((buf (get-file-buffer (concat org-e-odt-zip-dir file)))) - (when buf - (with-current-buffer buf - ;; Prettify output if needed. - (when org-e-odt-prettify-xml - (indent-region (point-min) (point-max))) - (save-buffer 0))))) - org-e-odt-xml-files) - ;; Run zip. - (let* ((target --out-file) - (target-name (file-name-nondirectory target)) - (target-dir (file-name-directory target)) - (cmds `(("zip" "-mX0" ,target-name "mimetype") - ("zip" "-rmTq" ,target-name ".")))) - ;; If a file with same name as the desired output file - ;; exists, remove it. - (when (file-exists-p target) - (delete-file target)) - ;; Zip up the xml files. - (let ((coding-system-for-write 'no-conversion) exitcode err-string) - (message "Creating ODT file...") - ;; Switch temporarily to content.xml. This way Zip - ;; process will inherit `org-e-odt-zip-dir' as the current - ;; directory. - (with-current-buffer - (find-file-noselect (concat org-e-odt-zip-dir "content.xml") t) - (mapc - (lambda (cmd) - (message "Running %s" (mapconcat 'identity cmd " ")) - (setq err-string - (with-output-to-string - (setq exitcode - (apply 'call-process (car cmd) - nil standard-output nil (cdr cmd))))) - (or (zerop exitcode) - (error (concat "Unable to create OpenDocument file." - (format " Zip failed with error (%s)" - err-string))))) - cmds) - ;; Zip file is now in the rightful place. - (rename-file target-name target))) - (message "Created %s" target) - ;; Cleanup work directory and work files. - (funcall --cleanup-xml-buffers) - ;; Open the OpenDocument file in archive-mode for - ;; examination. - (find-file-noselect target t) - ;; Return exported file. - (cond - ;; Case 1: Conversion desired on exported file. Run the - ;; converter on the OpenDocument file. Return the - ;; converted file. - (org-e-odt-preferred-output-format - (or (org-e-odt-convert target org-e-odt-preferred-output-format) - target)) - ;; Case 2: No further conversion. Return exported - ;; OpenDocument file. - (t target)))) - ((quit error) - ;; Cleanup work directory and work files. - (funcall --cleanup-xml-buffers) - (message "OpenDocument export failed: %s" - (error-message-string err)))))) - - - -;;;###autoload -(defun org-e-odt-export-as-odf (latex-frag &optional odf-file) - "Export LATEX-FRAG as OpenDocument formula file ODF-FILE. -Use `org-create-math-formula' to convert LATEX-FRAG first to -MathML. When invoked as an interactive command, use -`org-latex-regexps' to infer LATEX-FRAG from currently active -region. If no LaTeX fragments are found, prompt for it. Push -MathML source to kill ring, if `org-export-copy-to-kill-ring' is -non-nil." - (interactive - `(,(let (frag) - (setq frag (and (setq frag (and (region-active-p) - (buffer-substring (region-beginning) - (region-end)))) - (loop for e in org-latex-regexps - thereis (when (string-match (nth 1 e) frag) - (match-string (nth 2 e) frag))))) - (read-string "LaTeX Fragment: " frag nil frag)) - ,(let ((odf-filename (expand-file-name - (concat - (file-name-sans-extension - (or (file-name-nondirectory buffer-file-name))) - "." "odf") - (file-name-directory buffer-file-name)))) - (read-file-name "ODF filename: " nil odf-filename nil - (file-name-nondirectory odf-filename))))) - (let ((filename (or odf-file - (expand-file-name - (concat - (file-name-sans-extension - (or (file-name-nondirectory buffer-file-name))) - "." "odf") - (file-name-directory buffer-file-name))))) - (org-e-odt--export-wrap - filename - (let* ((buffer (progn - (require 'nxml-mode) - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect (concat org-e-odt-zip-dir - "content.xml") t)))) - (coding-system-for-write 'utf-8) - (save-buffer-coding-system 'utf-8)) - (set-buffer buffer) - (set-buffer-file-coding-system coding-system-for-write) - (let ((mathml (org-create-math-formula latex-frag))) - (unless mathml (error "No Math formula created")) - (insert mathml) - ;; Add MathML to kill ring, if needed. - (when org-export-copy-to-kill-ring - (org-kill-new (buffer-string)))))))) - -;;;###autoload -(defun org-e-odt-export-as-odf-and-open () - "Export LaTeX fragment as OpenDocument formula and immediately open it. -Use `org-e-odt-export-as-odf' to read LaTeX fragment and OpenDocument -formula file." - (interactive) - (org-open-file (call-interactively 'org-e-odt-export-as-odf))) - -;;;###autoload -(defun org-e-odt-export-to-odt - (&optional subtreep visible-only body-only ext-plist pub-dir) - "Export current buffer to a HTML file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -When optional argument PUB-DIR is set, use it as the publishing -directory. - -Return output file's name." - (interactive) - (org-e-odt--export-wrap - (org-export-output-file-name ".odt" subtreep pub-dir) - (let* ((org-e-odt-embedded-images-count 0) - (org-e-odt-embedded-formulas-count 0) - (org-e-odt-automatic-styles nil) - (org-e-odt-object-counters nil) - ;; Let `htmlfontify' know that we are interested in collecting - ;; styles. - (hfy-user-sheet-assoc nil)) - ;; Initialize content.xml and kick-off the export process. - (let ((out-buf (progn - (require 'nxml-mode) - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect - (concat org-e-odt-zip-dir "content.xml") t))))) - (org-export-to-buffer 'e-odt out-buf subtreep visible-only body-only))))) - - - - -(defun org-e-odt-reachable-p (in-fmt out-fmt) - "Return non-nil if IN-FMT can be converted to OUT-FMT." - (catch 'done - (let ((reachable-formats (org-e-odt-do-reachable-formats in-fmt))) - (dolist (e reachable-formats) - (let ((out-fmt-spec (assoc out-fmt (cdr e)))) - (when out-fmt-spec - (throw 'done (cons (car e) out-fmt-spec)))))))) - -(defun org-e-odt-do-convert (in-file out-fmt &optional prefix-arg) - "Workhorse routine for `org-e-odt-convert'." - (require 'browse-url) - (let* ((in-file (expand-file-name (or in-file buffer-file-name))) - (dummy (or (file-readable-p in-file) - (error "Cannot read %s" in-file))) - (in-fmt (file-name-extension in-file)) - (out-fmt (or out-fmt (error "Output format unspecified"))) - (how (or (org-e-odt-reachable-p in-fmt out-fmt) - (error "Cannot convert from %s format to %s format?" - in-fmt out-fmt))) - (convert-process (car how)) - (out-file (concat (file-name-sans-extension in-file) "." - (nth 1 (or (cdr how) out-fmt)))) - (extra-options (or (nth 2 (cdr how)) "")) - (out-dir (file-name-directory in-file)) - (cmd (format-spec convert-process - `((?i . ,(shell-quote-argument in-file)) - (?I . ,(browse-url-file-url in-file)) - (?f . ,out-fmt) - (?o . ,out-file) - (?O . ,(browse-url-file-url out-file)) - (?d . , (shell-quote-argument out-dir)) - (?D . ,(browse-url-file-url out-dir)) - (?x . ,extra-options))))) - (when (file-exists-p out-file) - (delete-file out-file)) - - (message "Executing %s" cmd) - (let ((cmd-output (shell-command-to-string cmd))) - (message "%s" cmd-output)) - - (cond - ((file-exists-p out-file) - (message "Exported to %s" out-file) - (when prefix-arg - (message "Opening %s..." out-file) - (org-open-file out-file)) - out-file) - (t - (message "Export to %s failed" out-file) - nil)))) - -(defun org-e-odt-do-reachable-formats (in-fmt) - "Return verbose info about formats to which IN-FMT can be converted. -Return a list where each element is of the -form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See -`org-e-odt-convert-processes' for CONVERTER-PROCESS and see -`org-e-odt-convert-capabilities' for OUTPUT-FMT-ALIST." - (let* ((converter - (and org-e-odt-convert-process - (cadr (assoc-string org-e-odt-convert-process - org-e-odt-convert-processes t)))) - (capabilities - (and org-e-odt-convert-process - (cadr (assoc-string org-e-odt-convert-process - org-e-odt-convert-processes t)) - org-e-odt-convert-capabilities)) - reachable-formats) - (when converter - (dolist (c capabilities) - (when (member in-fmt (nth 1 c)) - (push (cons converter (nth 2 c)) reachable-formats)))) - reachable-formats)) - -(defun org-e-odt-reachable-formats (in-fmt) - "Return list of formats to which IN-FMT can be converted. -The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)." - (let (l) - (mapc (lambda (e) (add-to-list 'l e)) - (apply 'append (mapcar - (lambda (e) (mapcar 'car (cdr e))) - (org-e-odt-do-reachable-formats in-fmt)))) - l)) - -(defun org-e-odt-convert-read-params () - "Return IN-FILE and OUT-FMT params for `org-e-odt-do-convert'. -This is a helper routine for interactive use." - (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read)) - (in-file (read-file-name "File to be converted: " - nil buffer-file-name t)) - (in-fmt (file-name-extension in-file)) - (out-fmt-choices (org-e-odt-reachable-formats in-fmt)) - (out-fmt - (or (and out-fmt-choices - (funcall input "Output format: " - out-fmt-choices nil nil nil)) - (error - "No known converter or no known output formats for %s files" - in-fmt)))) - (list in-file out-fmt))) - -;;;###autoload -(defun org-e-odt-convert (&optional in-file out-fmt prefix-arg) - "Convert IN-FILE to format OUT-FMT using a command line converter. -IN-FILE is the file to be converted. If unspecified, it defaults -to variable `buffer-file-name'. OUT-FMT is the desired output -format. Use `org-e-odt-convert-process' as the converter. -If PREFIX-ARG is non-nil then the newly converted file is opened -using `org-open-file'." - (interactive - (append (org-e-odt-convert-read-params) current-prefix-arg)) - (org-e-odt-do-convert in-file out-fmt prefix-arg)) - -;;; Library Initializations - -(mapc - (lambda (desc) - ;; Let Org open all OpenDocument files using system-registered app - (add-to-list 'org-file-apps - (cons (concat "\\." (car desc) "\\'") 'system)) - ;; Let Emacs open all OpenDocument files in archive mode - (add-to-list 'auto-mode-alist - (cons (concat "\\." (car desc) "\\'") 'archive-mode))) - org-e-odt-file-extensions) - -(provide 'org-e-odt) - -;;; org-e-odt.el ends here diff --git a/contrib/lisp/org-elisp-symbol.el b/contrib/lisp/org-elisp-symbol.el index afa60a84f..e0bc28446 100644 --- a/contrib/lisp/org-elisp-symbol.el +++ b/contrib/lisp/org-elisp-symbol.el @@ -2,7 +2,7 @@ ;; ;; Copyright 2007-2013 Free Software Foundation, Inc. ;; -;; Author: bzg AT gnu DOT org +;; Author: Bastien Guerry ;; Version: 0.2 ;; Keywords: org, remember, lisp ;; URL: http://www.cognition.ens.fr/~guerry/u/org-elisp-symbol.el @@ -20,8 +20,7 @@ ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs. If not, see . ;; ;;; Commentary: ;; diff --git a/contrib/lisp/org-eval-light.el b/contrib/lisp/org-eval-light.el index d3de19b1c..34a2e99e2 100644 --- a/contrib/lisp/org-eval-light.el +++ b/contrib/lisp/org-eval-light.el @@ -11,20 +11,18 @@ ;; This file is not yet part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/contrib/lisp/org-eval.el b/contrib/lisp/org-eval.el index dd3f9f57c..6cd7f783d 100644 --- a/contrib/lisp/org-eval.el +++ b/contrib/lisp/org-eval.el @@ -8,20 +8,18 @@ ;; ;; This file is not yet part of GNU Emacs. ;; -;; GNU Emacs is free software; you can redistribute it and/or modify +;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: @@ -88,8 +86,7 @@ (:foreground "yellow")))) "Face for command output that is included into an Org-mode buffer." :group 'org-eval - :group 'org-faces - :version "22.1") + :group 'org-faces) (defvar org-eval-regexp nil) diff --git a/contrib/lisp/org-exp-bibtex.el b/contrib/lisp/org-exp-bibtex.el deleted file mode 100644 index 2105230f4..000000000 --- a/contrib/lisp/org-exp-bibtex.el +++ /dev/null @@ -1,148 +0,0 @@ -;;; org-exp-bibtex.el --- Export bibtex fragments - -;; Copyright (C) 2009-2013 Taru Karttunen - -;; Author: Taru Karttunen - -;; This file is not currently part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program ; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: -;; -;; This is an utility to handle BibTeX export to both LaTeX and html -;; exports. It uses the bibtex2html software from -;; http://www.lri.fr/~filliatr/bibtex2html/ -;; -;; The usage is as follows: -;; #+BIBLIOGRAPHY: bibfilebasename stylename optional-options -;; e.g. given foo.bib and using style plain: -;; #+BIBLIOGRAPHY: foo plain option:-d -;; -;; Optional options are of the form: -;; -;; option:-foobar pass '-foobar' to bibtex2html -;; e.g. -;; option:-d sort by date. -;; option:-a sort as BibTeX (usually by author) *default* -;; option:-u unsorted i.e. same order as in .bib file -;; option:-r reverse the sort. -;; see the bibtex2html man page for more. Multiple options can be combined like: -;; option:-d option:-r -;; -;; Limiting to only the entries cited in the document: -;; limit:t - -;; For LaTeX export this simply inserts the lines -;; \bibliographystyle{plain} -;; \bibliography{foo} -;; into the tex-file when exporting. - -;; For Html export it: -;; 1) converts all \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 - -(require 'org) -(require 'org-exp) - -(defvar org-export-current-backend) ; dynamically bound in org-exp.el -(defun org-export-bibtex-preprocess () - "Export all BibTeX." - (interactive) - (save-window-excursion - (setq oebp-cite-plist '()) - - ;; Convert #+BIBLIOGRAPHY: name style - (goto-char (point-min)) - (while (re-search-forward "^#\\+BIBLIOGRAPHY:[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\([^\r\n]*\\)" nil t) - (let ((file (match-string 1)) - (style (match-string 2)) - (opt (org-exp-bibtex-options-to-plist (match-string 3)))) - (replace-match - (cond - ((eq org-export-current-backend 'html) ;; We are exporting to HTML - (let (extra-args cite-list end-hook tmp-files) - (dolist (elt opt) - (when (equal "option" (car elt)) - (setq extra-args (cons (cdr elt) extra-args)))) - - (when (assoc "limit" opt) ;; Limit is true - collect references - (org-exp-bibtex-docites (lambda () - (dolist (c (org-split-string (match-string 1) ",")) - (add-to-list 'cite-list c)))) -;; (message "cites: %s" cite-list) - (let ((tmp (make-temp-file "org-exp-bibtex"))) - (with-temp-file tmp (dolist (i cite-list) (insert (concat i "\n")))) - (setq tmp-files (cons tmp tmp-files)) - (setq extra-args (append extra-args `("-citefile" ,tmp))))) - - (when (not (eq 0 (apply 'call-process (append '("bibtex2html" nil nil nil) - `("-a" "--nodoc" "--style" ,style "--no-header") - extra-args - (list (concat file ".bib")))))) - (error "Executing bibtex2html failed")) - - (dolist (f tmp-files) (delete-file f))) - - (with-temp-buffer - (save-match-data - (insert-file-contents (concat file ".html")) - (goto-char (point-min)) - (while (re-search-forward (org-re "a name=\"\\([-_[:word:]]+\\)\">\\([[:word:]]+\\)") nil t) - (setq oebp-cite-plist (cons (cons (match-string 1) (match-string 2)) oebp-cite-plist))) - (goto-char (point-min)) - (while (re-search-forward "
" nil t) - (replace-match "
" t t)) - (concat "\n#+BEGIN_HTML\n
\n

References

\n" (buffer-string) "\n
\n#+END_HTML\n")))) - ((eq org-export-current-backend 'latex) ;; Latex export - (concat "\n#+LATEX: \\bibliographystyle{" style "}" - "\n#+LATEX: \\bibliography{" file "}\n"))) t t))) - - ;; Convert cites to links in html - (when (eq org-export-current-backend 'html) - ;; Split citation commands with multiple keys - (org-exp-bibtex-docites - (lambda () - (let ((keys (save-match-data (org-split-string (match-string 1) ",")))) - (when (> (length keys) 1) - (replace-match (mapconcat (lambda (k) (format "\\cite{%s}" k)) keys "") - t t))))) - ;; Replace the citation commands with links - (org-exp-bibtex-docites - (lambda () (let* ((cn (match-string 1)) - (cv (assoc cn oebp-cite-plist))) -;; (message "L: %s" (concat "\[_{}[[" cn "][" (if cv (cdr cv) cn) "]]\]")) - (replace-match (concat "\[_{}[[#" cn "][" (if cv (cdr cv) cn) "]]\]")) t t)))))) - -(defun org-exp-bibtex-docites (fun) - (save-excursion - (save-match-data - (goto-char (point-min)) - (when (eq org-export-current-backend 'html) - (while (re-search-forward "\\\\cite{\\([^}\n]+\\)}" nil t) - (apply fun nil)))))) - -(defun org-exp-bibtex-options-to-plist (options) - (save-match-data - (flet ((f (o) (let ((s (split-string o ":"))) (cons (nth 0 s) (nth 1 s))))) - (mapcar 'f (split-string options nil t))))) - -(add-hook 'org-export-preprocess-hook 'org-export-bibtex-preprocess) - -(provide 'org-exp-bibtex) - -;;; org-exp-bibtex.el ends here diff --git a/contrib/lisp/org-expiry.el b/contrib/lisp/org-expiry.el index 3df8065bc..363bebed8 100644 --- a/contrib/lisp/org-expiry.el +++ b/contrib/lisp/org-expiry.el @@ -2,7 +2,7 @@ ;; ;; Copyright 2007-2013 Free Software Foundation, Inc. ;; -;; Author: bzg AT gnu DOT org +;; Author: Bastien Guerry ;; Version: 0.2 ;; Keywords: org expiry @@ -19,8 +19,7 @@ ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs. If not, see . ;; ;;; Commentary: ;; @@ -83,7 +82,7 @@ :group 'org) (defcustom org-expiry-inactive-timestamps nil - "Insert inactive timestamps for the created and expired time properties" + "Insert inactive timestamps for created/expired properties." :type 'boolean :group 'org-expiry) diff --git a/contrib/lisp/org-export-generic.el b/contrib/lisp/org-export-generic.el deleted file mode 100644 index 104019887..000000000 --- a/contrib/lisp/org-export-generic.el +++ /dev/null @@ -1,1480 +0,0 @@ -;; org-export-generic.el --- Export frameworg with custom backends - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Wes Hardaker -;; Keywords: outlines, hypermedia, calendar, wp, export -;; Homepage: http://orgmode.org -;; Version: 6.25trans -;; Acks: Much of this code was stolen form the ascii export from Carsten -;; -;; This file is not part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;; -;; ---------------------------------------------------------------------- -;; -;; OVERVIEW -;; -;; IMPORTANT: IF YOU WANT TO WRITE A NEW EXPORTER FOR ORG, PLEASE -;; CHECK contrib/lisp/org-export.el -- ORG-EXPORT-GENERIC.EL, WHILE -;; STILL USEFUL, SHOULD NOT BE USED FOR NEW EXPORTERS. -;; -;; org-export-generic is basically a simple translation system that -;; knows how to parse at least most of a .org buffer and then add -;; various formatting prefixes before and after each section type. It -;; does this by examining a property list stored in org-generic-alist. -;; You can dynamically add propety lists of your own using the -;; org-set-generic-type function: -;; -;; (org-set-generic-type -;; "really-basic-text" -;; '(:file-suffix ".txt" -;; :key-binding ?R -;; -;; :title-format "=== %s ===\n" -;; :body-header-section-numbers t -;; :body-header-section-number-format "%s) " -;; :body-section-header-prefix "\n" -;; :body-section-header-suffix "\n" -;; :body-line-format " %s\n" -;; :body-line-wrap 75 -;; )) -;; -;; Note: Upper case key-bindings are reserved for your use. Lower -;; case key bindings may conflict with future export-generic -;; publications. -;; -;; Then run org-export (ctrl-c ctrl-e) and select generic or run -;; org-export-generic. You'll then be prompted with a list of export -;; types to choose from which will include your new type assigned to -;; the key "r". -;; -;; ---------------------------------------------------------------------- -;; -;; TODO (non-ordered) -;; * handle function references -;; * handle other types of multi-complex-listy-things to do -;; ideas: (t ?- "%s" ?-) -;; * handle indent specifiers better -;; ideas: (4 ?\ "%s") -;; * need flag to remove indents from body text -;; * handle links -;; * handle internationalization strings better -;; * date/author/etc needs improvment (internationalization too) -;; * allow specifying of section ordering -;; ideas: :ordering ("header" "toc" "body" "footer") -;; ^ matches current hard coded ordering -;; * err, actually *do* a footer -;; * deal with usage of org globals -;; *** should we even consider them, or let the per-section specifiers do it -;; *** answer: remove; mostly removed now -;; * deal with interactive support for picking a export specifier label -;; * char specifiers that need extra length because of formatting -;; idea: (?- 4) for 4-longer -;; * centering specifier -;; idea: ('center " -- %s -- ") -;; * remove more of the unneeded export-to-ascii copy code -;; * tags -;; *** supported now, but need separate format per tag -;; *** allow different open/closing prefixes -;; * properties -;; * drawers -;; * Escape camel-case for wiki exporters. -;; * Adjust to depth limits on headers --- need to roll-over from headers -;; to lists, as per other exporters -;; * optmization (many plist extracts should be in let vars) -;; * define defcustom spec for the specifier list -;; * fonts: at least monospace is not handled at all here. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -(require 'org-exp) -(require 'assoc) -(eval-when-compile (require 'cl)) - -(defgroup org-export-generic nil - "Options specific for ASCII export of Org-mode files." - :tag "Org Export ASCII" - :group 'org-export) - -(defcustom org-export-generic-links-to-notes t - "Non-nil means convert links to notes before the next headline. -When nil, the link will be exported in place. If the line becomes long -in this way, it will be wrapped." - :group 'org-export-generic - :type 'boolean) - - -(defvar org-generic-current-indentation nil) ; For communication - -(defvar org-generic-alist - '( - ;; - ;; generic DEMO exporter - ;; - ;; (this tries to use every specifier for demo purposes) - ;; - ("demo" - :file-suffix ".txt" - :key-binding ?d - - :header-prefix "
\n" - :header-suffix "
\n" - - :author-export t - :tags-export t - - :drawers-export t - - - :title-prefix ?= - :title-format "

%s

\n" - :title-suffix ?= - - :date-export t - :date-prefix "" - :date-format "
Date: %s
" - :date-suffix "
\n\n" - - :toc-export t - :toc-header-prefix "\n" - :toc-header-format "__%s__\n" - :toc-header-suffix "\n" - - :toc-prefix "\n" - :toc-suffix "\n" - - :toc-section-numbers t - :toc-section-number-format "\#(%s) " - :toc-format "--%s--" - :toc-format-with-todo "!!%s!!\n" - :toc-indent-char ?\ - :toc-indent-depth 4 - - :toc-tags-export t - :toc-tags-prefix " " - :toc-tags-format "*%s*" - :toc-tags-suffix "\n" - :toc-tags-none-string "\n" - - :body-header-section-numbers 3 ; t = all, nil = none - - ; lists indicate different things per level - ; list contents or straight value can either be a - ; ?x char reference for printing strings that match the header len - ; "" string to print directly - :body-section-header-prefix ("

" "

" "

" - "

" "

" "
") - :body-section-header-format "%s" - :body-section-header-suffix ("
\n" "\n" "\n" - "\n" "\n" "\n") - - :timestamps-export t - :priorities-export t - :todo-keywords-export t - - :body-tags-export t - :body-tags-prefix " " - :body-tags-suffix "\n" - - ; section prefixes/suffixes can be direct strings or lists as well - :body-section-prefix "\n" - :body-section-suffix "\n" - ; :body-section-prefix ("\n" "\n" "\n") - ; :body-section-suffix ("\n" "\n" "\n") - - - ; if preformated text should be included (eg, : prefixed) - :body-line-export-preformated t - :body-line-fixed-prefix "
\n"
-     :body-line-fixed-suffix       "\n
\n" - :body-line-fixed-format "%s\n" - - - :body-list-prefix "\n" - :body-list-suffix "\n" - :body-list-format "
  • %s
  • \n" - - :body-number-list-prefix "
      \n" - :body-number-list-suffix "
    \n" - :body-number-list-format "
  • %s
  • \n" - :body-number-list-leave-number t - - :body-list-checkbox-todo "" - :body-list-checkbox-todo-end "" - :body-list-checkbox-done "" - :body-list-checkbox-done-end "" - :body-list-checkbox-half "" - :body-list-checkbox-half-end "" - - - - - ; other body lines - :body-line-format "%s" - :body-line-wrap 60 ; wrap at 60 chars - - ; print above and below all body parts - :body-text-prefix "

    \n" - :body-text-suffix "

    \n") - ;; - ;; ascii exporter - ;; - ;; (close to the original ascii specifier) - ;; - ("ascii" - :file-suffix ".txt" - :key-binding ?a - - :header-prefix "" - :header-suffix "" - - :title-prefix ?= - :title-format "%s\n" - :title-suffix ?= - - :date-export t - :date-prefix "" - :date-format "Date: %s\n" - :date-suffix "" - - :toc-header-prefix "" - :toc-header-format "%s\n" - :toc-header-suffix ?= - - :toc-export t - :toc-section-numbers t - :toc-section-number-format "%s " - :toc-format "%s\n" - :toc-format-with-todo "%s (*)\n" - :toc-indent-char ?\ - :toc-indent-depth 4 - - :body-header-section-numbers 3 - :body-section-prefix "\n" - - ; :body-section-header-prefix "\n" - ; :body-section-header-format "%s\n" - ; :body-section-header-suffix (?\$ ?\# ?^ ?\~ ?\= ?\-) - - :body-section-header-prefix ("" "" "" "* " " + " " - ") - :body-section-header-format "%s\n" - :body-section-header-suffix (?~ ?= ?- "\n" "\n" "\n") - - ; :body-section-marker-prefix "" - ; :body-section-marker-chars (?\$ ?\# ?^ ?\~ ?\= ?\-) - ; :body-section-marker-suffix "\n" - - :body-line-export-preformated t - :body-line-format "%s\n" - :body-line-wrap 75 - - ; :body-text-prefix "\n" - ; :body-text-suffix "\n" - - - :body-bullet-list-prefix (?* ?+ ?-)) - ; :body-bullet-list-suffix (?* ?+ ?-) - - ;; - ;; wikipedia - ;; - ("wikipedia" - :file-suffix ".txt" - :key-binding ?w - - :header-prefix "" - :header-suffix "" - - :title-format "= %s =\n" - - :date-export nil - - :toc-export nil - - :body-header-section-numbers nil - :body-section-prefix "\n" - - :body-section-header-prefix ("= " "== " "=== " - "==== " "===== " "====== ") - :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n" - " ====\n\n" " =====\n\n" " ======\n\n") - - :body-line-export-preformated t ;; yes/no/maybe??? - :body-line-format "%s\n" - :body-line-wrap 75 - - :body-line-fixed-format " %s\n" - - :body-list-format "* %s\n" - :body-number-list-format "# %s\n" - - :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")) - ;; - ;; mediawiki - ;; - ("mediawiki" - :file-suffix ".txt" - :key-binding ?m - - :header-prefix "" - :header-suffix "" - - :title-format "= %s =\n" - - :date-export nil - - :toc-export nil - - :body-header-section-numbers nil - :body-section-prefix "\n" - - :body-section-header-prefix ("= " "== " "=== " - "==== " "===== " "====== ") - :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n" - " ====\n\n" " =====\n\n" " ======\n\n") - - :body-line-export-preformated t ;; yes/no/maybe??? - :body-line-format "%s\n" - :body-line-wrap 75 - - :body-line-fixed-format " %s\n" - - :body-list-format "* %s\n" - :body-number-list-format "# %s\n" - - :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ") - :body-list-checkbox-todo "☐ " - :body-list-checkbox-done "☒ " - :body-table-start "{|" - :body-table-end "|}" - :body-table-cell-start "|" - :body-table-cell-end "\n" - :body-table-last-cell-end "|-" - :body-table-hline-start "") - ;; - ;; internet-draft .xml for xml2rfc exporter - ;; - ("ietfid" - ;; this tries to use every specifier for demo purposes - :file-suffix ".xml" - :key-binding ?i - - :title-prefix " - - - - - - - - - -" - :title-format "\n%s\n\n" - :title-suffix " - Comany, Inc.. -
    - - - - - - - - - -
    -
    - - Operations and Management - FIXME -\n" - :date-export nil - - :toc-export nil - - :body-header-section-numbers nil - - :body-section-header-format "
    \n" - :body-section-suffix "
    \n" - - ; if preformated text should be included (eg, : prefixed) - :body-line-export-preformated t - :body-line-fixed-prefix "
    \n\n" - :body-line-fixed-suffix "\n\n
    \n" - - ; other body lines - :body-line-format "%s" - :body-line-wrap 75 - - ; print above and below all body parts - :body-text-prefix "\n" - :body-text-suffix "\n" - - :body-list-prefix "\n" - :body-list-suffix "\n" - :body-list-format "%s\n") - ("trac-wiki" - :file-suffix ".txt" - :key-binding ?T - - ;; lifted from wikipedia exporter - :header-prefix "" - :header-suffix "" - - :title-format "= %s =\n" - - :date-export nil - - :toc-export nil - - :body-header-section-numbers nil - :body-section-prefix "\n" - - :body-section-header-prefix (" == " " === " " ==== " - " ===== " ) - :body-section-header-suffix (" ==\n\n" " ===\n\n" " ====\n\n" - " =====\n\n" " ======\n\n" " =======\n\n") - - :body-line-export-preformated t ;; yes/no/maybe??? - :body-line-format "%s\n" - :body-line-wrap 75 - - :body-line-fixed-format " %s\n" - - :body-list-format " * %s\n" - :body-number-list-format " # %s\n" - ;; :body-list-prefix "LISTSTART" - ;; :body-list-suffix "LISTEND" - - ;; this is ignored! [2010/02/02:rpg] - :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ")) - ("tikiwiki" - :file-suffix ".txt" - :key-binding ?U - - ;; lifted from wikipedia exporter - :header-prefix "" - :header-suffix "" - - :title-format "-= %s =-\n" - - :date-export nil - - :toc-export nil - - :body-header-section-numbers nil - :body-section-prefix "\n" - - :body-section-header-prefix ("! " "!! " "!!! " "!!!! " - "!!!!! " "!!!!!! " "!!!!!!! ") - :body-section-header-suffix (" \n" " \n" " \n" - " \n" " \n" " \n") - - - :body-line-export-preformated t ;; yes/no/maybe??? - :body-line-format "%s " - :body-line-wrap nil - - :body-line-fixed-format " %s\n" - - :body-list-format "* %s\n" - :body-number-list-format "# %s\n" - ;; :body-list-prefix "LISTSTART" - ;; :body-list-suffix "LISTEND" - :blockquote-start "\n^\n" - :blockquote-end "^\n\n" - :body-newline-paragraph "\n" - :bold-format "__%s__" - :italic-format "''%s''" - :underline-format "===%s===" - :strikethrough-format "--%s--" - :code-format "-+%s+-" - :verbatim-format "~pp~%s~/pp~")) - "A assoc list of property lists to specify export definitions") - -(setq org-generic-export-type "demo") - -(defvar org-export-generic-section-type "") -(defvar org-export-generic-section-suffix "") - -;;;###autoload -(defun org-set-generic-type (type definition) - "Adds a TYPE and DEFINITION to the existing list of defined generic -export definitions." - (aput 'org-generic-alist type definition)) - -;;; helper functions for org-set-generic-type -(defvar org-export-generic-keywords nil) -(defmacro* def-org-export-generic-keyword (keyword - &key documentation - type) - "Define KEYWORD as a legitimate element for inclusion in -the body of an org-set-generic-type definition." - ;; TODO: push the documentation and type information - ;; somewhere where it will do us some good. - `(progn - (pushnew ,keyword org-export-generic-keywords))) - -(def-org-export-generic-keyword :body-newline-paragraph - :documentation "Bound either to NIL or to a pattern to be -inserted in the output for every blank line in the input. - The intention is to handle formats where text is flowed, and -newlines are interpreted as significant \(e.g., as indicating -preformatted text\). A common non-nil value for this keyword -is \"\\n\". Should typically be combined with a value for -:body-line-format that does NOT end with a newline." - :type string) - -;;; fontification keywords -(def-org-export-generic-keyword :bold-format) -(def-org-export-generic-keyword :italic-format) -(def-org-export-generic-keyword :underline-format) -(def-org-export-generic-keyword :strikethrough-format) -(def-org-export-generic-keyword :code-format) -(def-org-export-generic-keyword :verbatim-format) - -(defun org-export-generic-remember-section (type suffix &optional prefix) - (setq org-export-generic-section-type type) - (setq org-export-generic-section-suffix suffix) - (if prefix - (insert prefix))) - -(defun org-export-generic-check-section (type &optional prefix suffix) - "checks to see if type is already in use, or we're switching parts -If we're switching, then insert a potentially previously remembered -suffix, and insert the current prefix immediately and then save the -suffix a later change time." - - (when (not (equal type org-export-generic-section-type)) - (if org-export-generic-section-suffix - (insert org-export-generic-section-suffix)) - (setq org-export-generic-section-type type) - (setq org-export-generic-section-suffix suffix) - (if prefix - (insert prefix)))) - -;;;###autoload -(defun org-export-generic (arg) - "Export the outline as generic output. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -underlined headlines. The default is 3." - (interactive "P") - (setq-default org-todo-line-regexp org-todo-line-regexp) - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend))))) - (level-offset (if subtree-p - (save-excursion - (goto-char rbeg) - (+ (funcall outline-level) - (if org-odd-levels-only 1 0))) - 0)) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - - helpstart - (bogus (mapc (lambda (x) - (setq helpstart - (concat helpstart "\[" - (char-to-string - (plist-get (cdr x) :key-binding)) - "] " (car x) "\n"))) - org-generic-alist)) - - (help (concat helpstart " - -\[ ] the current setting of the org-generic-export-type variable -")) - - (cmds - - (append - (mapcar (lambda (x) - (list - (plist-get (cdr x) :key-binding) - (car x))) - org-generic-alist) - (list (list ? "default")))) - - r1 r2 ass - - ;; read in the type to use - (export-plist - (progn - (save-excursion - (save-window-excursion - (delete-other-windows) - (with-output-to-temp-buffer "*Org Export/Generic Styles Help*" - (princ help)) - (org-fit-window-to-buffer (get-buffer-window - "*Org Export/Generic Styles Help*")) - (message "Select command: ") - (setq r1 (read-char-exclusive)))) - (setq r2 (if (< r1 27) (+ r1 96) r1)) - (unless (setq ass (cadr (assq r2 cmds))) - (error "No command associated with key %c" r1)) - - (cdr (assoc - (if (equal ass "default") org-generic-export-type ass) - org-generic-alist)))) - - (custom-times org-display-custom-times) - (org-generic-current-indentation '(0 . 0)) - (level 0) (old-level 0) line txt lastwastext - (umax nil) - (umax-toc nil) - (case-fold-search nil) - (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) - (filesuffix (or (plist-get export-plist :file-suffix) ".foo")) - (filename (concat (file-name-as-directory - (org-export-directory :ascii opt-plist)) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory bfname))) - filesuffix)) - (filename (if (equal (file-truename filename) - (file-truename bfname)) - (concat filename filesuffix) - filename)) - (buffer (find-file-noselect filename)) - (org-levels-open (make-vector org-level-max nil)) - (odd org-odd-levels-only) - (date (plist-get opt-plist :date)) - (author (plist-get opt-plist :author)) - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (file-name-sans-extension - (file-name-nondirectory bfname)))) - (email (plist-get opt-plist :email)) - (language (plist-get opt-plist :language)) - (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) - ; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) - (todo nil) - (lang-words nil) - (region - (buffer-substring - (if (org-region-active-p) (region-beginning) (point-min)) - (if (org-region-active-p) (region-end) (point-max)))) - (org-export-current-backend 'org-export-generic) - (lines (org-split-string - (org-export-preprocess-string - region - :for-backend 'ascii - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get export-plist :drawers-export) - :tags (plist-get export-plist :tags-export) - :priority (plist-get export-plist :priority-export) - :footnotes (plist-get export-plist :footnotes-export) - :timestamps (plist-get export-plist :timestamps-export) - :todo-keywords (plist-get export-plist :todo-keywords-export) - :verbatim-multiline t - :select-tags (plist-get export-plist :select-tags-export) - :exclude-tags (plist-get export-plist :exclude-tags-export) - :emph-multiline t - :archived-trees - (plist-get export-plist :archived-trees-export) - :add-text (plist-get opt-plist :text)) - "\n")) - ;; export-generic plist variables - (withtags (plist-get export-plist :tags-export)) - (tagsintoc (plist-get export-plist :toc-tags-export)) - (tocnotagsstr (or (plist-get export-plist :toc-tags-none-string) "")) - (tocdepth (plist-get export-plist :toc-indent-depth)) - (tocindentchar (plist-get export-plist :toc-indent-char)) - (tocsecnums (plist-get export-plist :toc-section-numbers)) - (tocsecnumform (plist-get export-plist :toc-section-number-format)) - (tocformat (plist-get export-plist :toc-format)) - (tocformtodo (plist-get export-plist :toc-format-with-todo)) - (tocprefix (plist-get export-plist :toc-prefix)) - (tocsuffix (plist-get export-plist :toc-suffix)) - (bodyfixedpre (plist-get export-plist :body-line-fixed-prefix)) - (bodyfixedsuf (plist-get export-plist :body-line-fixed-suffix)) - (bodyfixedform (or (plist-get export-plist :body-line-fixed-format) - "%s")) - (listprefix (plist-get export-plist :body-list-prefix)) - (listsuffix (plist-get export-plist :body-list-suffix)) - (listformat (or (plist-get export-plist :body-list-format) "%s\n")) - (numlistleavenum - (plist-get export-plist :body-number-list-leave-number)) - (numlistprefix (plist-get export-plist :body-number-list-prefix)) - (numlistsuffix (plist-get export-plist :body-number-list-suffix)) - (numlistformat - (or (plist-get export-plist :body-number-list-format) "%s\n")) - (listchecktodo - (or (plist-get export-plist :body-list-checkbox-todo) "\\1")) - (listcheckdone - (or (plist-get export-plist :body-list-checkbox-done) "\\1")) - (listcheckhalf - (or (plist-get export-plist :body-list-checkbox-half) "\\1")) - (listchecktodoend - (or (plist-get export-plist :body-list-checkbox-todo-end) "")) - (listcheckdoneend - (or (plist-get export-plist :body-list-checkbox-done-end) "")) - (listcheckhalfend - (or (plist-get export-plist :body-list-checkbox-half-end) "")) - (bodytablestart - (or (plist-get export-plist :body-table-start) "")) - (bodytableend - (or (plist-get export-plist :body-table-end) "")) - (bodytablerowstart - (or (plist-get export-plist :body-table-row-start) "")) - (bodytablerowend - (or (plist-get export-plist :body-table-row-end) "")) - (bodytablecellstart - (or (plist-get export-plist :body-table-cell-start) "")) - (bodytablecellend - (or (plist-get export-plist :body-table-cell-end) "")) - (bodytablefirstcellstart - (or (plist-get export-plist :body-table-first-cell-start) "")) - (bodytableinteriorcellstart - (or (plist-get export-plist :body-table-interior-cell-start) "")) - (bodytableinteriorcellend - (or (plist-get export-plist :body-table-interior-cell-end) "")) - (bodytablelastcellend - (or (plist-get export-plist :body-table-last-cell-end) "")) - (bodytablehlinestart - (or (plist-get export-plist :body-table-hline-start) " \\1")) - (bodytablehlineend - (or (plist-get export-plist :body-table-hline-end) "")) - - - - (bodynewline-paragraph (plist-get export-plist :body-newline-paragraph)) - (bodytextpre (plist-get export-plist :body-text-prefix)) - (bodytextsuf (plist-get export-plist :body-text-suffix)) - (bodylinewrap (plist-get export-plist :body-line-wrap)) - (bodylineform (or (plist-get export-plist :body-line-format) "%s")) - (blockquotestart (or (plist-get export-plist :blockquote-start) "\n\n\t")) - (blockquoteend (or (plist-get export-plist :blockquote-end) "\n\n")) - - ;; dynamic variables used heinously in fontification - ;; not referenced locally... - (format-boldify (plist-get export-plist :bold-format)) - (format-italicize (plist-get export-plist :italic-format)) - (format-underline (plist-get export-plist :underline-format)) - (format-strikethrough (plist-get export-plist :strikethrough-format)) - (format-code (plist-get export-plist :code-format)) - (format-verbatim (plist-get export-plist :verbatim-format)) - - - - thetoc toctags have-headings first-heading-pos - table-open table-buffer link-buffer link desc desc0 rpl wrap) - - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (setq org-min-level (org-get-min-level lines level-offset)) - (setq org-last-level org-min-level) - (org-init-section-numbers) - - (find-file-noselect filename) - - (setq lang-words (or (assoc language org-export-language-setup) - (assoc "en" org-export-language-setup))) - (switch-to-buffer-other-window buffer) - (erase-buffer) - (fundamental-mode) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (org-set-local 'org-odd-levels-only odd) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc umax) - - ;; File header - (if title - (insert - (org-export-generic-header title export-plist - :title-prefix - :title-format - :title-suffix))) - - (if (and (or author email) - (plist-get export-plist :author-export)) - (insert (concat (nth 1 lang-words) ": " (or author "") - (if email (concat " <" email ">") "") - "\n"))) - - (cond - ((and date (string-match "%" date)) - (setq date (format-time-string date))) - (date) - (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) - - (if (and date (plist-get export-plist :date-export)) - (insert - (org-export-generic-header date export-plist - :date-prefix - :date-format - :date-suffix))) - - ;; export the table of contents first - (if (plist-get export-plist :toc-export) - (progn - (push - (org-export-generic-header (nth 3 lang-words) export-plist - :toc-header-prefix - :toc-header-format - :toc-header-suffix) - thetoc) - - (if tocprefix - (push tocprefix thetoc)) - - (mapc #'(lambda (line) - (if (string-match org-todo-line-regexp line) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (match-string 3 line) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) - ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (setq txt (org-html-expand-for-generic txt)) - - (while (string-match org-bracket-link-regexp txt) - (setq txt - (replace-match - (match-string (if (match-end 2) 3 1) txt) - t t txt))) - - (if (and (not tagsintoc) - (string-match - (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") - txt)) - (setq txt (replace-match "" t t txt)) - ; include tags but formated - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") - txt) - (progn - (setq - toctags - (org-export-generic-header - (match-string 1 txt) - export-plist :toc-tags-prefix - :toc-tags-format :toc-tags-suffix)) - (string-match - (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") - txt) - (setq txt (replace-match "" t t txt))) - (setq toctags tocnotagsstr))) - - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - - (if (<= level umax-toc) - (progn - (push - (concat - - (make-string - (* (max 0 (- level org-min-level)) tocdepth) - tocindentchar) - - (if tocsecnums - (format tocsecnumform - (org-section-number level)) - "") - - (format - (if todo tocformtodo tocformat) - txt) - - toctags) - - thetoc) - (setq org-last-level level)))))) - lines) - (if tocsuffix - (push tocsuffix thetoc)) - (setq thetoc (if have-headings (nreverse thetoc) nil)))) - - (org-init-section-numbers) - (org-export-generic-check-section "top") - (while (setq line (pop lines)) - (when (and link-buffer (string-match org-outline-regexp-bol line)) - (org-export-generic-push-links (nreverse link-buffer)) - (setq link-buffer nil)) - (setq wrap nil) - ;; Remove the quoted HTML tags. - ;; XXX - (setq line (org-html-expand-for-generic line)) - ;; Replace links with the description when possible - ;; XXX - (while (string-match org-bracket-link-regexp line) - (setq link (match-string 1 line) - desc0 (match-string 3 line) - desc (or desc0 (match-string 1 line))) - (if (and (> (length link) 8) - (equal (substring link 0 8) "coderef:")) - (setq line (replace-match - (format (org-export-get-coderef-format (substring link 8) desc) - (cdr (assoc - (substring link 8) - org-export-code-refs))) - t t line)) - (setq rpl (concat "[" - (or (match-string 3 line) (match-string 1 line)) - "]")) - (when (and desc0 (not (equal desc0 link))) - (if org-export-generic-links-to-notes - (push (cons desc0 link) link-buffer) - (setq rpl (concat rpl " (" link ")") - wrap (+ (length line) (- (length (match-string 0 line))) - (length desc))))) - (setq line (replace-match rpl t t line)))) - (when custom-times - (setq line (org-translate-time line))) - (cond - ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) - ;; - ;; a Headline - ;; - (org-export-generic-check-section "headline") - - (setq first-heading-pos (or first-heading-pos (point))) - (setq level (org-tr-level (- (match-end 1) (match-beginning 1) - level-offset)) - txt (match-string 2 line)) - (org-generic-level-start level old-level txt umax export-plist lines) - (setq old-level level)) - - ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) - ;; - ;; a Table - ;; - (org-export-generic-check-section "table") - - (if (not table-open) - ;; New table starts - (setq table-open t table-buffer nil)) - ;; Accumulate table lines - (setq table-buffer (cons line table-buffer)) - (when (or (not lines) - (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" - (car lines)))) - (setq table-open nil - table-buffer (nreverse table-buffer)) - (insert (mapconcat - (lambda (x) - (org-fix-indentation x org-generic-current-indentation)) - (org-format-table-generic table-buffer) - "\n") "\n"))) - - ((string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line) - ;; - ;; pre-formatted text - ;; - (setq line (replace-match "\\1" nil nil line)) - - (org-export-generic-check-section "preformat" bodyfixedpre bodyfixedsuf) - - (insert (format bodyfixedform line))) - - ((or (string-match "^\\([ \t]*\\)\\([\-\+][ \t]*\\)" line) - ;; if the bullet list item is an asterisk, the leading space is /mandatory/ - ;; [2010/02/02:rpg] - (string-match "^\\([ \t]+\\)\\(\\*[ \t]*\\)" line)) - ;; - ;; plain list item - ;; TODO: nested lists - ;; - ;; first add a line break between any previous paragraph or line item and this - ;; one - (when bodynewline-paragraph - (insert bodynewline-paragraph)) - - ;; I believe this gets rid of leading whitespace. - (setq line (replace-match "" nil nil line)) - - ;; won't this insert the suffix /before/ the last line of the list? - ;; also isn't it spoofed by bulleted lists that have a line skip between the list items - ;; unless 'org-empty-line-terminates-plain-lists' is true? - (org-export-generic-check-section "liststart" listprefix listsuffix) - - ;; deal with checkboxes - (cond - ((string-match "^\\(\\[ \\]\\)[ \t]*" line) - (setq line (concat (replace-match listchecktodo nil nil line) - listchecktodoend))) - ((string-match "^\\(\\[X\\]\\)[ \t]*" line) - (setq line (concat (replace-match listcheckdone nil nil line) - listcheckdoneend))) - ((string-match "^\\(\\[/\\]\\)[ \t]*" line) - (setq line (concat (replace-match listcheckhalf nil nil line) - listcheckhalfend)))) - - (insert (format listformat (org-export-generic-fontify line)))) - ((string-match "^\\([ \t]+\\)\\([0-9]+\\.[ \t]*\\)" line) - ;; - ;; numbered list item - ;; - ;; TODO: nested lists - ;; - (setq line (replace-match (if numlistleavenum "\\2" "") nil nil line)) - - (org-export-generic-check-section "numliststart" - numlistprefix numlistsuffix) - - ;; deal with checkboxes - ;; TODO: whoops; leaving the numbers is a problem for ^ matching - (cond - ((string-match "\\(\\[ \\]\\)[ \t]*" line) - (setq line (concat (replace-match listchecktodo nil nil line) - listchecktodoend))) - ((string-match "\\(\\[X\\]\\)[ \t]*" line) - (setq line (concat (replace-match listcheckdone nil nil line) - listcheckdoneend))) - ((string-match "\\(\\[/\\]\\)[ \t]*" line) - (setq line (concat (replace-match listcheckhalf nil nil line) - listcheckhalfend)))) - - (insert (format numlistformat (org-export-generic-fontify line)))) - - ((equal line "ORG-BLOCKQUOTE-START") - (setq line blockquotestart)) - ((equal line "ORG-BLOCKQUOTE-END") - (setq line blockquoteend)) - ((string-match "^\\s-*$" line) - ;; blank line - (if bodynewline-paragraph - (insert bodynewline-paragraph))) - (t - ;; - ;; body - ;; - (org-export-generic-check-section "body" bodytextpre bodytextsuf) - - (setq line - (org-export-generic-fontify line)) - - ;; XXX: properties? list? - (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line) - (setq line (replace-match "\\1\\3:" t nil line))) - - (setq line (org-fix-indentation line org-generic-current-indentation)) - - ;; Remove forced line breaks - (if (string-match "\\\\\\\\[ \t]*$" line) - (setq line (replace-match "" t t line))) - - (if bodylinewrap - ;; XXX: was dependent on wrap var which was calculated by??? - (if (> (length line) bodylinewrap) - (setq line - (org-export-generic-wrap line bodylinewrap)) - (setq line line))) - (insert (format bodylineform line))))) - - ;; if we're at a level > 0; insert the closing body level stuff - (let ((counter 0)) - (while (> (- level counter) 0) - (insert - (org-export-generic-format export-plist :body-section-suffix 0 - (- level counter))) - (setq counter (1+ counter)))) - - (org-export-generic-check-section "bottom") - - (org-export-generic-push-links (nreverse link-buffer)) - - (normal-mode) - - ;; insert the table of contents - (when thetoc - (goto-char (point-min)) - (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t) - (progn - (goto-char (match-beginning 0)) - (replace-match "")) - (goto-char first-heading-pos)) - (mapc 'insert thetoc) - (or (looking-at "[ \t]*\n[ \t]*\n") - (insert "\n\n"))) - - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (make-string (- end beg) ?\ )))) - - (save-buffer) - - ;; remove display and invisible chars - (let (beg end) - (goto-char (point-min)) - (while (setq beg (next-single-property-change (point) 'display)) - (setq end (next-single-property-change beg 'display)) - (delete-region beg end) - (goto-char beg) - (insert "=>")) - (goto-char (point-min)) - (while (setq beg (next-single-property-change (point) 'org-cwidth)) - (setq end (next-single-property-change beg 'org-cwidth)) - (delete-region beg end) - (goto-char beg))) - (goto-char (point-min)))) - - -(defun org-export-generic-format (export-plist prop &optional len n reverse) - "converts a property specification to a string given types of properties - -The EXPORT-PLIST should be defined as the lookup plist. -The PROP should be the property name to search for in it. -LEN is set to the length of multi-characters strings to generate (or 0) -N is the tree depth -REVERSE means to reverse the list if the plist match is a list - " - (let* ((prefixtype (plist-get export-plist prop)) - subtype) - (cond - ((null prefixtype) "") - ((and len (char-or-string-p prefixtype) (not (stringp prefixtype))) - ;; sequence of chars - (concat (make-string len prefixtype) "\n")) - ((stringp prefixtype) - prefixtype) - ((and n (listp prefixtype)) - (if reverse - (setq prefixtype (reverse prefixtype))) - (setq subtype (if (> n (length prefixtype)) - (car (last prefixtype)) - (nth (1- n) prefixtype))) - (if (stringp subtype) - subtype - (concat (make-string len subtype) "\n"))) - (t "")))) - -(defun org-export-generic-header (header export-plist - prefixprop formatprop postfixprop - &optional n reverse) - "convert a header to an output string given formatting property names" - (let* ((formatspec (plist-get export-plist formatprop)) - (len (length header))) - (concat - (org-export-generic-format export-plist prefixprop len n reverse) - (format (or formatspec "%s") header) - (org-export-generic-format export-plist postfixprop len n reverse)))) - -(defun org-export-generic-preprocess (parameters) - "Do extra work for ASCII export" - ;; Put quotes around verbatim text - (goto-char (point-min)) - (while (re-search-forward org-verbatim-re nil t) - (goto-char (match-end 2)) - (delete-backward-char 1) (insert "'") - (goto-char (match-beginning 2)) - (delete-char 1) (insert "`") - (goto-char (match-end 2))) - ;; Remove target markers - (goto-char (point-min)) - (while (re-search-forward "<<]*\\)>>>?\\([ \t]*\\)" nil t) - (replace-match "\\1\\2"))) - -(defun org-html-expand-for-generic (line) - "Handle quoted HTML for ASCII export." - (if org-export-html-expand - (while (string-match "@<[^<>\n]*>" line) - ;; We just remove the tags for now. - (setq line (replace-match "" nil nil line)))) - line) - -(defun org-export-generic-wrap (line where) - "Wrap LINE at or before WHERE." - (let* ((ind (org-get-indentation line)) - (indstr (make-string ind ?\ )) - (len (length line)) - (result "") - pos didfirst) - (while (> len where) - (catch 'found - (loop for i from where downto (/ where 2) do - (and (equal (aref line i) ?\ ) - (setq pos i) - (throw 'found t)))) - (if pos - (progn - (setq result - (concat result - (if didfirst indstr "") - (substring line 0 pos) - "\n")) - (setq didfirst t) - (setq line (substring line (1+ pos))) - (setq len (length line))) - (setq result (concat result line)) - (setq len 0))) - (concat result indstr line))) - -(defun org-export-generic-push-links (link-buffer) - "Push out links in the buffer." - (when link-buffer - ;; We still have links to push out. - (insert "\n") - (let ((ind "")) - (save-match-data - (if (save-excursion - (re-search-backward - "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t)) - (setq ind (or (match-string 2) - (make-string (length (match-string 3)) ?\ ))))) - (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n")) - link-buffer)) - (insert "\n"))) - -(defun org-generic-level-start (level old-level title umax export-plist - &optional lines) - "Insert a new level in a generic export." - (let ((n (- level umax 1)) - (ind 0) - (diff (- level old-level)) (counter 0) - (secnums (plist-get export-plist :body-header-section-numbers)) - (secnumformat - (plist-get export-plist :body-header-section-number-format)) - char tagstring) - (unless org-export-with-tags - (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) - (setq title (replace-match "" t t title)))) - - (cond - ;; going deeper - ((> level old-level) - (while (< (+ old-level counter) (1- level)) - (insert - (org-export-generic-format export-plist :body-section-prefix 0 - (+ old-level counter))) - (setq counter (1+ counter)))) - ;; going up - ((< level old-level) - (while (> (- old-level counter) (1- level)) - (insert - (org-export-generic-format export-plist :body-section-suffix 0 - (- old-level counter))) - (setq counter (1+ counter)))) - ;; same level - ((= level old-level) - (insert - (org-export-generic-format export-plist :body-section-suffix 0 level)))) - (insert - (org-export-generic-format export-plist :body-section-prefix 0 level)) - - (if (and org-export-with-section-numbers - secnums - (or (not (numberp secnums)) - (< level secnums))) - (setq title - (concat (format (or secnumformat "%s ") - (org-section-number level)) title))) - - ;; handle tags and formatting - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") title) - (progn - (if (plist-get export-plist :body-tags-export) - (setq tagstring (org-export-generic-header (match-string 1 title) - export-plist - :body-tags-prefix - :body-tags-format - :body-tags-suffix))) - (string-match (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") title) - (setq title (replace-match "" t t title))) - (setq tagstring (plist-get export-plist :body-tags-none-string))) - - (insert - (org-export-generic-header title export-plist - :body-section-header-prefix - :body-section-header-format - :body-section-header-suffix - level)) - (if tagstring - (insert tagstring)) - - (setq org-generic-current-indentation '(0 . 0)))) - -(defun org-insert-centered (s &optional underline) - "Insert the string S centered and underline it with character UNDERLINE." - (let ((ind (max (/ (- fill-column (string-width s)) 2) 0))) - (insert (make-string ind ?\ ) s "\n") - (if underline - (insert (make-string ind ?\ ) - (make-string (string-width s) underline) - "\n")))) - -(defvar org-table-colgroup-info nil) -(defun org-format-table-generic (lines) - "Format a table for ascii export." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (not (string-match "^[ \t]*|" (car lines))) - ;; Table made by table.el - test for spanning - lines - - ;; A normal org table - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; column and the special lines - (setq lines (org-table-clean-before-export lines))) - ;; Get rid of the vertical lines except for grouping - (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info)) - (rtn (list bodytablestart)) line vl1 start) - (while (setq line (pop lines)) - (setq line (concat bodytablerowstart line)) - (if (string-match org-table-hline-regexp line) - (and (string-match "|\\(.*\\)|" line) - (setq line (replace-match (concat bodytablehlinestart bodytablehlineend) t nil line))) - (setq start 0 vl1 vl) - (if (string-match "|\\(.*\\)|" line) - (setq line (replace-match (concat bodytablefirstcellstart bodytablecellstart " \\1 " bodytablecellend bodytablelastcellend) t nil line))) - (while (string-match "|" line start) - (setq start (+ (match-end 0) (length (concat bodytablecellend bodytableinteriorcellend bodytableinteriorcellstart bodytablecellstart)))) - (or (pop vl1) (setq line (replace-match (concat bodytablecellend bodytableinteriorcellend bodytableinteriorcellstart bodytablecellstart) t t line))))) - (setq line (concat line bodytablerowend)) - (push line rtn)) - (setq rtn (cons bodytableend rtn)) - (nreverse rtn)))) - -(defun org-colgroup-info-to-vline-list (info) - (let (vl new last) - (while info - (setq last new new (pop info)) - (if (or (memq last '(:end :startend)) - (memq new '(:start :startend))) - (push t vl) - (push nil vl))) - (setq vl (nreverse vl)) - (and vl (setcar vl nil)) - vl)) - - -;;; FIXME: this should probably turn into a defconstant later [2010/05/20:rpg] -(defvar org-export-generic-emphasis-alist - '(("*" format-boldify nil) - ("/" format-italicize nil) - ("_" format-underline nil) - ("+" format-strikethrough nil) - ("=" format-code t) - ("~" format-verbatim t)) - "Alist of org format -> formatting variables for fontification. -Each element of the list is a list of three elements. -The first element is the character used as a marker for fontification. -The second element is a variable name, set in org-export-generic. That -variable will be dereferenced to obtain a formatting string to wrap -fontified text with. -The third element decides whether to protect converted text from other -conversions.") - -;;; Cargo-culted from the latex translation. I couldn't figure out how -;;; to keep the structure since the generic export operates on lines, rather -;;; than on a buffer as in the latex export, meaning that none of the -;;; search forward code could be kept. This led me to rewrite the -;;; whole thing recursively. A huge lose for efficiency (potentially), -;;; but I couldn't figure out how to make the looping work. -;;; Worse, it's /doubly/ recursive, because this function calls -;;; org-export-generic-emph-format, which can call it recursively... -;;; [2010/05/20:rpg] -(defun org-export-generic-fontify (string) - "Convert fontification according to generic rules." - (if (string-match org-emph-re string) - ;; The match goes one char after the *string*, except at the end of a line - (let ((emph (assoc (match-string 3 string) - org-export-generic-emphasis-alist)) - (beg (match-beginning 0)) - (end (match-end 0))) - (unless emph - (message "`org-export-generic-emphasis-alist' has no entry for formatting triggered by \"%s\"" - (match-string 3 string))) - ;; now we need to determine whether we have strikethrough or - ;; a list, which is a bit nasty - (if (and (equal (match-string 3 string) "+") - (save-match-data - (string-match "\\`-+\\'" (match-string 4 string)))) - ;; a list --- skip this match and recurse on the point after the - ;; first emph char... - (concat (substring string 0 (1+ (match-beginning 3))) - (org-export-generic-fontify (substring string (match-beginning 3)))) - (concat (substring string 0 beg) ;; part before the match - (match-string 1 string) - (org-export-generic-emph-format (second emph) - (match-string 4 string) - (third emph)) - (or (match-string 5 string) "") - (org-export-generic-fontify (substring string end))))) - string)) - -(defun org-export-generic-emph-format (format-varname string protect) - "Return a string that results from applying the markup indicated by -FORMAT-VARNAME to STRING." - (let ((format (symbol-value format-varname))) - (let ((string-to-emphasize - (if protect - string - (org-export-generic-fontify string)))) - (if format - (format format string-to-emphasize) - string-to-emphasize)))) - -(provide 'org-generic) -(provide 'org-export-generic) - -;;; org-export-generic.el ends here diff --git a/contrib/lisp/org-favtable.el b/contrib/lisp/org-favtable.el new file mode 100755 index 000000000..51f75a5a4 --- /dev/null +++ b/contrib/lisp/org-favtable.el @@ -0,0 +1,1701 @@ +;;; org-favtable.el --- Lookup table of favorite references and links + +;; Copyright (C) 2011-2013 Free Software Foundation, Inc. + +;; Author: Marc-Oliver Ihm +;; Keywords: hypermedia, matching +;; Requires: org +;; Download: http://orgmode.org/worg/code/elisp/org-favtable.el +;; Version: 2.2.0 + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Purpose: +;; +;; Mark and find your favorite things and locations in org easily: Create +;; and update a lookup table of your references and links. Often used +;; entries bubble to the top and entering some keywords displays only the +;; matching entries. That way the right entry one can be picked easily. +;; +;; References are essentially small numbers (e.g. "R237" or "-455-"), +;; which are created by this package; they are well suited to be used +;; outside of org. Links are just normal org-mode links. +;; +;; +;; Setup: +;; +;; - Add these lines to your .emacs: +;; +;; (require 'org-favtable) +;; ;; Good enough to start, but later you should probably +;; ;; change this id, as will be explained below +;; (setq org-favtable-id "00e26bef-1929-4110-b8b4-7eb9c9ab1fd4") +;; ;; Optionally assign a key. Pick your own favorite. +;; (global-set-key (kbd "C-+") 'org-favtable) +;; +;; - Just invoke `org-favtable', which will explain how to complete your +;; setup by creating the necessary table of favorites. +;; +;; +;; Further reading: +;; +;; Invoke `org-favtable' and pick one of its help options. You may also +;; read the documentation of `org-favtable-id' for setup instructions, of +;; `org-favtable' for regular usage and of `org-favtable--commands' for a +;; list of available commands. +;; + +;;; Change Log: + +;; [2013-02-28 Th] Version 2.2.0: +;; - Allowed shortcuts like "h237" for command "head" with argument "237" +;; - Integrated with org-mark-ring-goto +;; +;; [2013-01-25 Fr] Version 2.1.0: +;; - Added full support for links +;; - New commands "missing" and "statistics" +;; - Renamed the package from "org-reftable" to "org-favtable" +;; - Additional columns are required (e.g. "link"). Error messages will +;; guide you +;; +;; [2012-12-07 Fr] Version 2.0.0: +;; - The format of the table of favorites has changed ! You need to bring +;; your existing table into the new format by hand (which however is +;; easy and explained below) +;; - Reference table can be sorted after usage count or date of last access +;; - Ask user explicitly, which command to invoke +;; - Renamed the package from "org-refer-by-number" to "org-reftable" + +;; [2012-09-22 Sa] Version 1.5.0: +;; - New command "sort" to sort a buffer or region by reference number +;; - New commands "highlight" and "unhighlight" to mark references + +;; [2012-07-13 Fr] Version 1.4.0: +;; - New command "head" to find a headline with a reference number + +;; [2012-04-28 Sa] Version 1.3.0: +;; - New commands occur and multi-occur +;; - All commands can now be invoked explicitly +;; - New documentation +;; - Many bugfixes + +;; [2011-12-10 Sa] Version 1.2.0: +;; - Fixed a bug, which lead to a loss of newly created reference numbers +;; - Introduced single and double prefix arguments +;; - Started this Change Log + +;;; Code: + +(require 'org-table) +(require 'cl) + +(defvar org-favtable--version "2.2.0") +(defvar org-favtable--preferred-command nil) + +(defvar org-favtable--commands '(occur head ref link enter leave goto + help reorder fill sort update highlight unhighlight missing statistics) + "List of commands known to org-favtable: + +Commands known: + + occur: If you supply a keyword (text): Apply emacs standard + occur operation on the table of favorites; ask for a + string (keyword) to select lines. Occur will only show you + lines which contain the given keyword, so you can easily find + the right one. You may supply a list of words seperated by + comma (\",\"), to select lines that contain any or all of the + given words. + + If you supply a reference number: Apply emacs standard + multi-occur operation all org-mode buffers to search for a + specific reference. + + You may also read the note at the end of this help on saving + the keystroke RET to accept this frequent default command. + + head: If invoked outside the table of favorites, ask for a + reference number and search for a heading containing it. If + invoked within favtable dont ask; rather use the reference or + link from the current line. + + ref: Create a new reference, copy any previously selected text. + If already within reftable, fill in ref-column. + + link: Create a new line in reftable with a link to the current node. + Do not populate the ref column; this can later be populated by + calling the \"fill\" command from within the reftable. + + leave: Leave the table of favorites. If the last command has + been \"ref\", the new reference is copied and ready to yank. + This \"org-mark-ring-goto\" and can be called several times + in succession. + + enter: Just enter the node with the table of favorites. + + goto: Search for a specific reference within the table of + favorites. + + help: Show this list of commands. + + +: Show all commands including the less frequently used ones + given below. If \"+\" is followd by enough letters of such a + command (e.g. \"+fi\"), then this command is invoked + directly. + + reorder: Temporarily reorder the table of favorites, e.g. by + count, reference or last access. + + fill: If either ref or link is missing, fill it. + + sort: Sort a set of lines (either the active region or the + whole buffer) by the references found in each line. + + update: For the given reference, update the line in the + favtable. + + highlight: Highlight references in region or buffer. + + unhighlight: Remove highlights. + + missing : Search for missing reference numbers (which do not + appear in the reference table). If requested, add additional + lines for them, so that the command \"new\" is able to reuse + them. + + statistics : Show some statistics (e.g. minimum and maximum + reference) about favtable. + + + +Two ways to save keystrokes: + +When prompting for a command, org-favtable puts the most likely +one (e.g. \"occur\" or \"ref\") at the front of the list, so that +you may just type RET. + +If this command needs additional input (like e.g. \"occur\"), you +may supply this input right away, although you are still beeing +prompted for the command. So do an occur for the string \"foo\", +you can just enter \"foo\" without even entering \"occur\". + + +Another way to save keystrokes applies if you want to choose a +command, that requrires a reference number (and would normally +prompt for it): In that case you may just enter enough characters +from your command, so that it appears first in the list of +matches; then immediately enter the number of the reference you +are searching for. So the input \"h237\" would execute the +command \"head\" for reference \"237\" right away. + +") + +(defvar org-favtable--commands-some '(occur head ref link leave enter goto + help)) + +(defvar org-favtable--columns nil) + +(defvar org-favtable-id nil + "Id of the Org-mode node, which contains the favorite table. + +Read below, on how to set up things. See the help options +\"usage\" and \"commands\" for normal usage after setup. + +Setup requires two steps: + + - Adjust your .emacs initialization file + + - Create a suitable org-mode node + + +Here are the lines, you need to add to your .emacs: + + (require 'org-favtable) + ;; Good enough to start, but later you should probably + ;; change this id, as will be explained below + (setq org-favtable-id \"00e26bef-1929-4110-b8b4-7eb9c9ab1fd4\") + ;; Optionally assign a key. Pick your own favorite. + (global-set-key (kbd \"C-+\") 'org-favtable) + +Do not forget to restart emacs to make these lines effective. + + +As a second step you need to create the org-mode node, where your +reference numbers and links will be stored. It may look like +this: + + * org-favtable + :PROPERTIES: + :ID: 00e26bef-1929-4110-b8b4-7eb9c9ab1fd4 + :END: + + + | | | Comment, description, details | | | | + | ref | link | ;c | count;s | created | last-accessed | + | | <4> | <30> | | | | + |-----+------+--------------------------------+---------+---------+---------------| + | R1 | | My first reference | | | | + + +You may just copy this node into one of your org-files. Many +things however can or should be adjusted: + + - The node needs not be a top level node. + + - Its name is completely at you choice. The node is found + through its ID. + + - There are three lines of headings above the first hline. The + first one is ignored by org-favtable, and you can use them to + give meaningful names to columns; the second line contains + configuration information for org-favtable; please read + further below for its format. The third line is optional and + may contain width-informations (e.g. <30>) only. + + - The sequence of columns does not matter. You may reorder them + any way you like; e.g. make the comment-column the last + columns within the table. Columns ar found by their name, + which appears in the second heading-line. + + - You can add further columns or even remove the + \"Comment\"-column. All other columns from the + example (e.g. \"ref\", \"link\", \"count\", \"created\" and + \"last-accessed\") are required. + + - Your references need not start at \"R1\"; However, having an + initial row is required (it serves as a template for subsequent + references). + + - Your reference need not have the form \"R1\"; you may just as + well choose any text, that contains a single number, + e.g. \"reference-{1}\" or \"#7\" or \"++17++\" or \"-344-\". The + function `org-favtable' will inspect your first reference and + create all subsequent references in the same way. + + - You may want to change the ID-Property of the node above and + create a new one, which is unique (and not just a copy of + mine). You need to change it in the lines copied to your .emacs + too. However, this is not strictly required to make things + work, so you may do this later, after trying out this package. + + +Optionally you may tweak the second header line to adjust +`org-favtable' a bit. In the example above it looks like this + (with spaces collapsed): + + + | ref | link | ;c | count;s | created | last-accessed | + + +The different fields have different meanings: + + - ref : This denotes the column which contains you references + + - link : Column for org-mode links, which can be used to access + locations within your files. + + - ;c : The flag \"c\" (\"c\" for \"copy\") denotes this column + as the one beeing copied on command \"leave\". In the example + above, it is also the comment-column. + + - count;s : this is the column which counts, how many time this + line has been accessed (which is the key-feature of this + package). The flag \"s\" stands for \"sort\", so the table is + sorted after this column. You may also sort after columns + \"ref\" or \"last-accessed\". + + - created : Date when this line was created. + + - last-accessed : Date and time, when this line was last accessed. + + +After this two-step setup process you may invoke `org-favtable' +to create a new favorite. Read the help option \"usage\" for +instructions on normal usage, read the help option \"commands\" +for help on single commands. + +") + + +(defvar org-favtable--text-to-yank nil) +(defvar org-favtable--last-action nil) +(defvar org-favtable--occur-buffer nil) +(defvar org-favtable--ref-regex nil) +(defvar org-favtable--ref-format nil) + + + +(defun org-favtable (&optional what search search-is-link) + "Mark and find your favorite items and org-locations easily: +Create and update a lookup table of your favorite references and +links. Often used entries automatically bubble to the top of the +table; entering some keywords narrows it to just the matching +entries; that way the right one can be picked easily. + +References are essentially small numbers (e.g. \"R237\" or +\"-455-\"), as created by this package; links are normal org-mode +links. Within org-favtable, both are denoted as favorites. + + +Read below for a detailed description of this function. See the +help option \"setup\" or read the documentation of +`org-favtable-id' for setup instructions. + +The function `org-favtable' operates on a dedicated table (called +the table or favorites or favtable, for short) within a special +Org-mode node. The node has to be created as part of your initial +setup. Each line of the favorite table contains: + + - A reference (optional) + + - A link (optional) + + - A number; counting, how often each reference has been + used. This number is updated automatically and the table can + be sorted according to it, so that most frequently used + references appear at the top of the table and can be spotted + easily. + + - Its respective creation date + + - Date and time of last access. This column can alternatively be + used to sort the table. + +To be useful, your table of favorites should probably contain a +column with comments too, which allows lines to be selected by +keywords. + +The table of favorites is found through the id of the containing +node; this id should be stored within `org-favtable-id' (see there +for details). + + +The function `org-favtable' is the only interactive function of +this package and its sole entry point; it offers several commands +to create, find and look up these favorites (references and +links). All of them are explained within org-favtable's help. + + +Finally, org-favtable can also be invoked from elisp; the two +optional arguments accepted are: + + search : string to search for + what : symbol of the command to invoke + search-is-link : t, if argument search is actually a link + +An example would be: + + (org-favtable \"237\" 'head) ;; find heading with ref 237 + +" + + (interactive "P") + + (let (within-node ; True, if we are within node with favtable + result-is-visible ; True, if node or occur is visible in any window + ref-node-buffer-and-point ; cons with buffer and point of favorites node + below-cursor ; word below cursor + active-region ; active region (if any) + link-id ; link of starting node, if required + guarded-search ; with guard against additional digits + search-is-ref ; true, if search is a reference + commands ; currently active set of selectable commands + what-adjusted ; True, if we had to adjust what + what-input ; Input on what question (need not necessary be "what") + reorder-once ; Column to use for single time sorting + parts ; Parts of a typical reference number (which + ; need not be a plain number); these are: + head ; Any header before number (e.g. "R") + maxref ; Maximum number from reference table (e.g. "153") + tail ; Tail after number (e.g. "}" or "") + ref-regex ; Regular expression to match a reference + has-reuse ; True, if table contains a line for reuse + numcols ; Number of columns in favtable + kill-new-text ; Text that will be appended to kill ring + message-text ; Text that will be issued as an explanation, + ; what we have done + initial-ref-or-link ; Initial position in reftable + ) + + ;; + ;; Examine current buffer and location, before turning to favtable + ;; + + ;; Get the content of the active region or the word under cursor + (if (and transient-mark-mode + mark-active) + (setq active-region (buffer-substring (region-beginning) (region-end)))) + (setq below-cursor (thing-at-point 'symbol)) + + + ;; Find out, if we are within favable or not + (setq within-node (string= (org-id-get) org-favtable-id)) + + ;; Find out, if point in any window is within node with favtable + (mapc (lambda (x) (with-current-buffer (window-buffer x) + (when (or + (string= (org-id-get) org-favtable-id) + (eq (window-buffer x) + org-favtable--occur-buffer)) + (setq result-is-visible t)))) + (window-list)) + + + + ;; + ;; Get decoration of references and highest reference from favtable + ;; + + + ;; Save initial ref or link + (if (and within-node + (org-at-table-p)) + (setq initial-ref-or-link + (or (org-favtable--get-field 'ref) + (org-favtable--get-field 'link)))) + + ;; Find node + (setq ref-node-buffer-and-point (org-favtable--id-find)) + (unless ref-node-buffer-and-point + (org-favtable--report-setup-error + (format "Cannot find node with id \"%s\"" org-favtable-id))) + + ;; Get configuration of reftable; catch errors + (let ((error-message + (catch 'content-error + + (with-current-buffer (car ref-node-buffer-and-point) + (save-excursion + (unless (string= (org-id-get) org-favtable-id) + (goto-char (cdr ref-node-buffer-and-point))) + + ;; parse table while still within buffer + (setq parts (org-favtable--parse-and-adjust-table))) + + nil)))) + (when error-message + (org-pop-to-buffer-same-window (car ref-node-buffer-and-point)) + (org-reveal) + (error error-message))) + + ;; Give names to parts of configuration + (setq head (nth 0 parts)) + (setq maxref (nth 1 parts)) + (setq tail (nth 2 parts)) + (setq numcols (nth 3 parts)) + (setq ref-regex (nth 4 parts)) + (setq has-reuse (nth 5 parts)) + (setq org-favtable--ref-regex ref-regex) + (setq org-favtable--ref-format (concat head "%d" tail)) + + ;; + ;; Find out, what we are supposed to do + ;; + + (if (equal what '(4)) (setq what 'leave)) + + ;; Set preferred action, that will be the default choice + (setq org-favtable--preferred-command + (if within-node + (if (memq org-favtable--last-action '(ref link)) + 'leave + 'occur) + (if active-region + 'ref + (if (and below-cursor (string-match ref-regex below-cursor)) + 'occur + nil)))) + + ;; Ask user, what to do + (unless what + (setq commands (copy-list org-favtable--commands-some)) + (while (progn + (setq what-input + (org-icompleting-read + "Please choose: " + (mapcar 'symbol-name + ;; Construct unique list of commands with + ;; preferred one at front + (delq nil (delete-dups + (append + (list org-favtable--preferred-command) + commands)))) + nil nil)) + + + ;; if input starts with "+", any command (not only some) may follow + ;; this allows input like "+sort" to be accepted + (when (string= (substring what-input 0 1) "+") + ;; make all commands available for selection + (setq commands (copy-list org-favtable--commands)) + (unless (string= what-input "+") + ;; not just "+", use following string + (setq what-input (substring what-input 1)) + + (let ((completions + ;; get list of possible completions for what-input + (all-completions what-input (mapcar 'symbol-name commands)))) + ;; use it, if unambigously + (if (= (length completions) 1) + (setq what-input (car completions)))))) + + + ;; if input ends in digits, save them away and do completions on head of input + ;; this allows input like "h224" to be accepted + (when (string-match "^\\([^0-9+]\\)\\([0-9]+\\)\\s *$" what-input) + ;; use first match as input, even if ambigously + (setq org-favtable--preferred-command + (intern (first (all-completions (match-string 1 what-input) + (mapcar 'symbol-name commands))))) + ;; use digits as argument to commands + (setq what-input (format org-favtable--ref-format + (string-to-number (match-string 2 what-input))))) + + (setq what (intern what-input)) + + ;; user is not required to input one of the commands; if + ;; not, take the first one and use the original input for + ;; next question + (if (memq what commands) + ;; input matched one element of list, dont need original + ;; input any more + (setq what-input nil) + ;; what-input will be used for next question, use first + ;; command for what + (setq what (or org-favtable--preferred-command + (first commands))) + ;; remove any trailing dot, that user might have added to + ;; disambiguate his input + (if (equal (substring what-input -1) ".") + ;; but do this only, if dot was really necessary to + ;; disambiguate + (let ((shortened-what-input (substring what-input 0 -1))) + (unless (test-completion shortened-what-input + (mapcar 'symbol-name + commands)) + (setq what-input shortened-what-input))))) + + ;; ask for reorder in loop, because we have to ask for + ;; what right again + (if (eq what 'reorder) + (setq reorder-once + (intern + (org-icompleting-read + "Please choose column to reorder reftable once: " + (mapcar 'symbol-name '(ref count last-accessed)) + nil t)))) + + ;; maybe ask initial question again + (memq what '(reorder +))))) + + + ;; + ;; Get search, if required + ;; + + ;; These actions need a search string: + (when (memq what '(goto occur head update)) + + ;; Maybe we've got a search string from the arguments + (unless search + (let (search-from-table + search-from-cursor) + + ;; Search string can come from several sources: + ;; From ref column of table + (when within-node + (setq search-from-table (org-favtable--get-field 'ref))) + ;; From string below cursor + (when (and (not within-node) + below-cursor + (string-match (concat "\\(" ref-regex "\\)") + below-cursor)) + (setq search-from-cursor (match-string 1 below-cursor))) + + ;; Depending on requested action, get search from one of the sources above + (cond ((eq what 'goto) + (setq search (or what-input search-from-cursor))) + ((memq what '(head occur)) + (setq search (or what-input search-from-table search-from-cursor)))))) + + + ;; If we still do not have a search string, ask user explicitly + (unless search + + (if what-input + (setq search what-input) + (setq search (read-from-minibuffer + (cond ((memq what '(occur head)) + "Text or reference number to search for: ") + ((eq what 'goto) + "Reference number to search for, or enter \".\" for id of current node: ") + ((eq what 'update) + "Reference number to update: "))))) + + (if (string-match "^\\s *[0-9]+\\s *$" search) + (setq search (format "%s%s%s" head (org-trim search) tail)))) + + ;; Clean up and examine search string + (if search (setq search (org-trim search))) + (if (string= search "") (setq search nil)) + (setq search-is-ref (string-match ref-regex search)) + + ;; Check for special case + (when (and (memq what '(head goto)) + (string= search ".")) + (setq search (org-id-get)) + (setq search-is-link t)) + + (when search-is-ref + (setq guarded-search (org-favtable--make-guarded-search search))) + + ;; + ;; Do some sanity checking before really starting + ;; + + ;; Correct requested action, if nothing to search + (when (and (not search) + (memq what '(search occur head))) + (setq what 'enter) + (setq what-adjusted t)) + + ;; For a proper reference as input, we do multi-occur + (if (and (string-match ref-regex search) + (eq what 'occur)) + (setq what 'multi-occur)) + + ;; Check for invalid combinations of arguments; try to be helpful + (when (and (memq what '(head goto)) + (not search-is-link) + (not search-is-ref)) + (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search))) + + + ;; + ;; Prepare + ;; + + ;; Get link if required before moving in + (if (eq what 'link) + (setq link-id (org-id-get-create))) + + ;; Move into table, if outside + (when (memq what '(enter ref link goto occur multi-occur missing statistics)) + + ;; Support orgmode-standard of going back (buffer and position) + (org-mark-ring-push) + + ;; Switch to favtable + (org-pop-to-buffer-same-window (car ref-node-buffer-and-point)) + (goto-char (cdr ref-node-buffer-and-point)) + (show-subtree) + (org-show-context) + + ;; sort favtable + (org-favtable--sort-table reorder-once)) + + ;; Goto back to initial ref, because reformatting of table above might + ;; have moved point + (when initial-ref-or-link + (while (and (org-at-table-p) + (not (or + (string= initial-ref-or-link (org-favtable--get-field 'ref)) + (string= initial-ref-or-link (org-favtable--get-field 'link))))) + (forward-line)) + ;; did not find ref, go back to top + (if (not (org-at-table-p)) (goto-char top))) + + + ;; + ;; Actually do, what is requested + ;; + + (cond + + + ((eq what 'help) + + (let ((help-what + ;; which sort of help ? + (intern + (concat + "help-" + (org-icompleting-read + "Help on: " + (mapcar 'symbol-name '(commands usage setup version example)) + nil t))))) + + ;; help is taken from docstring of functions or variables + (cond ((eq help-what 'help-commands) + (org-favtable--show-help 'org-favtable--commands)) + ((eq help-what 'help-usage) + (org-favtable--show-help 'org-favtable)) + ((eq help-what 'help-setup) + (org-favtable--show-help 'org-favtable-id)) + ((eq help-what 'help-version) + (org-favtable-version))))) + + + ((eq what 'multi-occur) + + ;; Conveniently position cursor on number to search for + (org-favtable--goto-top) + (let (found (initial (point))) + (while (and (not found) + (forward-line) + (org-at-table-p)) + (save-excursion + (setq found (string= search + (org-favtable--get-field 'ref))))) + (if found + (org-favtable--update-line nil) + (goto-char initial))) + + ;; Construct list of all org-buffers + (let (buff org-buffers) + (dolist (buff (buffer-list)) + (set-buffer buff) + (if (string= major-mode "org-mode") + (setq org-buffers (cons buff org-buffers)))) + + ;; Do multi-occur + (multi-occur org-buffers guarded-search) + (if (get-buffer "*Occur*") + (progn + (setq message-text (format "multi-occur for '%s'" search)) + (setq org-favtable--occur-buffer (get-buffer "*Occur*")) + (other-window 1) + (toggle-truncate-lines 1)) + (setq message-text (format "Did not find '%s'" search))))) + + + ((eq what 'head) + + (let (link) + ;; link either from table or passed in as argument + + ;; try to get link + (if search-is-link + (setq link (org-trim search)) + (if (and within-node + (org-at-table-p)) + (setq link (org-favtable--get-field 'link)))) + + ;; use link if available + (if (and link + (not (string= link ""))) + (progn + (org-id-goto link) + (org-favtable--update-line search) + (setq message-text "Followed link")) + + (message (format "Scanning headlines for '%s' ..." search)) + (let (buffer point) + (if (catch 'found + (progn + ;; loop over all headlines, stop on first match + (org-map-entries + (lambda () + (when (looking-at (concat ".*" guarded-search)) + ;; remember location and bail out + (setq buffer (current-buffer)) + (setq point (point)) + (throw 'found t))) + nil 'agenda) + nil)) + + (progn + (org-favtable--update-line search) + (setq message-text (format "Found '%s'" search)) + (org-pop-to-buffer-same-window buffer) + (goto-char point) + (org-reveal)) + (setq message-text (format "Did not find '%s'" search))))))) + + + ((eq what 'leave) + + (when result-is-visible + + ;; If we are within the occur-buffer, switch over to get current line + (if (and (string= (buffer-name) "*Occur*") + (eq org-favtable--last-action 'occur)) + (occur-mode-goto-occurrence))) + + (setq kill-new-text org-favtable--text-to-yank) + (setq org-favtable--text-to-yank nil) + + ;; If "leave" has been called two times in succession, make + ;; org-mark-ring-goto believe it has been called two times too + (if (eq org-favtable--last-action 'leave) + (let ((this-command nil) (last-command nil)) + (org-mark-ring-goto 1)) + (org-mark-ring-goto 0))) + + + ((eq what 'goto) + + ;; Go downward in table to requested reference + (let (found (initial (point))) + (org-favtable--goto-top) + (while (and (not found) + (forward-line) + (org-at-table-p)) + (save-excursion + (setq found + (string= search + (org-favtable--get-field + (if search-is-link 'link 'ref)))))) + (if found + (progn + (setq message-text (format "Found '%s'" search)) + (org-favtable--update-line nil) + (org-table-goto-column (org-favtable--column-num 'ref)) + (if (looking-back " ") (backward-char)) + ;; remember string to copy + (setq org-favtable--text-to-yank + (org-trim (org-table-get-field (org-favtable--column-num 'copy))))) + (setq message-text (format "Did not find '%s'" search)) + (goto-char initial) + (forward-line) + (setq what 'missed)))) + + + ((eq what 'occur) + + ;; search for string: occur + (let (search-regexp + all-or-any + (search-words (split-string search "," t))) + + (if (< (length search-words) 2) + ;; only one word to search; use it as is + (setq search-regexp search) + ;; construct regexp to match any of the words (maybe throw out some matches later) + (setq search-regexp + (mapconcat (lambda (x) (concat "\\(" x "\\)")) search-words "\\|")) + (setq all-or-any + (intern + (org-icompleting-read + "Two or more words have been specified; show lines, that match: " '("all" "any"))))) + + (save-restriction + (org-narrow-to-subtree) + (occur search-regexp) + (widen) + (if (get-buffer "*Occur*") + (with-current-buffer "*Occur*" + + ;; install helpful keyboard-shortcuts within occur-buffer + (let ((keymap (make-sparse-keymap))) + (set-keymap-parent keymap occur-mode-map) + + (define-key keymap (kbd "RET") + (lambda () (interactive) + (org-favtable--occur-helper 'head))) + + (define-key keymap (kbd "") + (lambda () (interactive) + (org-favtable--occur-helper 'multi-occur))) + + (define-key keymap (kbd "") + (lambda () (interactive) + (org-favtable--occur-helper 'goto))) + + (define-key keymap (kbd "") + (lambda () (interactive) + (org-favtable--occur-helper 'update))) + + (use-local-map keymap)) + + ;; Brush up occur buffer + (other-window 1) + (toggle-truncate-lines 1) + (let ((inhibit-read-only t)) + ;; insert some help text + (insert (substitute-command-keys + "Type RET to find heading, C-RET for multi-occur, M-RET to go to occurence and C-M-RET to update line in reftable.\n\n")) + (forward-line 1) + + ;; when matching all of multiple words, remove all lines that do not match one of the words + (when (eq all-or-any 'all) + (mapc (lambda (x) (keep-lines x)) search-words)) + + ;; replace description from occur + (when all-or-any + (forward-line -1) + (kill-line) + (let ((count (- (count-lines (point) (point-max)) 1))) + (insert (format "%d %s for %s of %s" + count + (if (= count 1) "match" "matches") + all-or-any + search))) + (forward-line) + (beginning-of-line)) + + ;; Record link or reference for each line in + ;; occur-buffer, that is linked into reftable. Because if + ;; we later realign the reftable and then reuse the occur + ;; buffer, the original links might point nowehere. + (save-excursion + (while (not (eq (point) (point-max))) + (let ((beg (line-beginning-position)) + (end (line-end-position)) + pos ref link) + + ;; occur has saved the position into a special property + (setq pos (get-text-property (point) 'occur-target)) + (when pos + ;; but this property might soon point nowhere; so retrieve ref-or-link instead + (with-current-buffer (marker-buffer pos) + (goto-char pos) + (setq ref (org-favtable--get-field 'ref)) + (setq link (org-favtable--get-field 'link)))) + ;; save as text property + (put-text-property beg end 'org-favtable--ref ref) + (put-text-property beg end 'org-favtable--link link)) + (forward-line)))) + + (setq message-text + (format "Occur for '%s'" search))) + (setq message-text + (format "Did not find any matches for '%s'" search)))))) + + + ((memq what '(ref link)) + + ;; add a new row (or reuse existing one) + (let (new) + + (when (eq what 'ref) + ;; go through table to find first entry to be reused + (when has-reuse + (org-favtable--goto-top) + ;; go through table + (while (and (org-at-table-p) + (not new)) + (when (string= + (org-favtable--get-field 'count) + ":reuse:") + (setq new (org-favtable--get-field 'ref)) + (if new (org-table-kill-row))) + (forward-line))) + + ;; no ref to reuse; construct new reference + (unless new + (setq new (format "%s%d%s" head (1+ maxref) tail))) + + ;; remember for org-mark-ring-goto + (setq org-favtable--text-to-yank new)) + + ;; insert ref or link as very first row + (org-favtable--goto-top) + (org-table-insert-row) + + ;; fill special columns with standard values + (when (eq what 'ref) + (org-table-goto-column (org-favtable--column-num 'ref)) + (insert new)) + (when (eq what 'link) + (org-table-goto-column (org-favtable--column-num 'link)) + (insert link-id)) + (org-table-goto-column (org-favtable--column-num 'created)) + (org-insert-time-stamp nil nil t) + + ;; goto first empty field + (unless (catch 'empty + (dotimes (col numcols) + (org-table-goto-column (+ col 1)) + (if (string= (org-trim (org-table-get-field)) "") + (throw 'empty t)))) + ;; none found, goto first + (org-table-goto-column 1)) + + (org-table-align) + (if active-region (setq kill-new-text active-region)) + (if (eq what 'ref) + (setq message-text (format "Adding a new row with ref '%s'" new)) + (setq message-text (format "Adding a new row linked to '%s'" link-id))))) + + + ((eq what 'enter) + + ;; simply go into table + (org-favtable--goto-top) + (show-subtree) + (recenter) + (if what-adjusted + (setq message-text "Nothing to search for; at favtable") + (setq message-text "At favtable"))) + + + ((eq what 'fill) + + ;; check, if within reftable + (unless (and within-node + (org-at-table-p)) + (error "Not within table of favorites")) + + ;; applies to missing refs and missing links alike + (let ((ref (org-favtable--get-field 'ref)) + (link (org-favtable--get-field 'link))) + + (if (and (not ref) + (not link)) + ;; have already checked this during parse, check here anyway + (error "Columns ref and link are both empty in this line")) + + ;; fill in new ref + (if (not ref) + (progn + (setq kill-new-text (format "%s%d%s" head (1+ maxref) tail)) + (org-favtable--get-field 'ref kill-new-text) + ;; remember for org-mark-ring-goto + (setq org-favtable--text-to-yank kill-new-text) + (org-id-goto link) + (setq message-text "Filled reftable field with new reference")) + + ;; fill in new link + (if (not link) + (progn + (setq guarded-search (org-favtable--make-guarded-search ref)) + (message (format "Scanning headlines for '%s' ..." ref)) + (let (link) + (if (catch 'found + (org-map-entries + (lambda () + (when (looking-at (concat ".*" guarded-search)) + (setq link (org-id-get-create)) + (throw 'found t))) + nil 'agenda) + nil) + + (progn + (org-favtable--get-field 'link link) + (setq message-text "Inserted link")) + + (setq message-text (format "Did not find reference '%s'" ref))))) + + ;; nothing is missing + (setq message-text "Columns 'ref' and 'link' are already filled; nothing to do"))))) + + + ((eq what 'sort) + + ;; sort lines according to contained reference + (let (begin end where) + (catch 'aborted + ;; either active region or whole buffer + (if (and transient-mark-mode + mark-active) + ;; sort only region + (progn + (setq begin (region-beginning)) + (setq end (region-end)) + (setq where "region")) + ;; sort whole buffer + (setq begin (point-min)) + (setq end (point-max)) + (setq where "whole buffer") + ;; make sure + (unless (y-or-n-p "Sort whole buffer ") + (setq message-text "Sort aborted") + (throw 'aborted nil))) + + (save-excursion + (save-restriction + (goto-char (point-min)) + (narrow-to-region begin end) + (sort-subr nil 'forward-line 'end-of-line + (lambda () + (if (looking-at (concat ".*" + (org-favtable--make-guarded-search ref-regex 'dont-quote))) + (string-to-number (match-string 1)) + 0)))) + (highlight-regexp ref-regex) + (setq message-text (format "Sorted %s from character %d to %d, %d lines" + where begin end + (count-lines begin end))))))) + + + ((eq what 'update) + + ;; simply update line in reftable + (save-excursion + (let ((ref-or-link (if search-is-link "link" "reference"))) + (beginning-of-line) + (if (org-favtable--update-line search) + (setq message-text (format "Updated %s '%s'" ref-or-link search)) + (setq message-text (format "Did not find %s '%s'" ref-or-link search)))))) + + + ((eq what 'parse) + + ;; Just parse the reftable, which is already done, so nothing to do + ) + + + ((memq what '(highlight unhighlight)) + + (let ((where "buffer")) + (save-excursion + (save-restriction + (when (and transient-mark-mode + mark-active) + (narrow-to-region (region-beginning) (region-end)) + (setq where "region")) + + (if (eq what 'highlight) + (progn + (highlight-regexp ref-regex) + (setq message-text (format "Highlighted references in %s" where))) + (unhighlight-regexp ref-regex) + (setq message-text (format "Removed highlights for references in %s" where))))))) + + + ((memq what '(missing statistics)) + + (org-favtable--goto-top) + (let (missing + ref-field + ref + min + max + (total 0)) + + ;; start with list of all references + (setq missing (mapcar (lambda (x) (format "%s%d%s" head x tail)) + (number-sequence 1 maxref))) + + ;; go through table and remove all refs, that we see + (while (and (forward-line) + (org-at-table-p)) + + ;; get ref-field and number + (setq ref-field (org-favtable--get-field 'ref)) + (if (and ref-field + (string-match ref-regex ref-field)) + (setq ref (string-to-number (match-string 1 ref-field)))) + + ;; remove existing refs from list + (if ref-field (setq missing (delete ref-field missing))) + + ;; record min and max + (if (or (not min) (< ref min)) (setq min ref)) + (if (or (not max) (> ref max)) (setq max ref)) + + ;; count + (setq total (1+ total))) + + ;; insert them, if requested + (forward-line -1) + (if (eq what 'statistics) + + (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. " + total + (format org-favtable--format min) + (format org-favtable--format max) + (length missing))) + + (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the table of favorites" + (length missing))) + (let (type) + (setq type (org-icompleting-read + "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing"))) + (mapc (lambda (x) + (let (org-table-may-need-update) (org-table-insert-row t)) + (org-favtable--get-field 'ref x) + (org-favtable--get-field 'count (format ":%s:" type))) + missing) + (org-table-align) + (setq message-text (format "Inserted %d new lines for missing refernces" (length missing)))) + (setq message-text (format "%d missing references." (length missing))))))) + + + (t (error "This is a bug: unmatched case '%s'" what))) + + + ;; remember what we have done for next time + (setq org-favtable--last-action what) + + ;; tell, what we have done and what can be yanked + (if kill-new-text (setq kill-new-text + (substring-no-properties kill-new-text))) + (if (string= kill-new-text "") (setq kill-new-text nil)) + (let ((m (concat + message-text + (if (and message-text kill-new-text) + " and r" + (if kill-new-text "R" "")) + (if kill-new-text (format "eady to yank '%s'" kill-new-text) "")))) + (unless (string= m "") (message m))) + (if kill-new-text (kill-new kill-new-text)))) + + + +(defun org-favtable--parse-and-adjust-table () + + (let ((maxref 0) + top + bottom + ref-field + link-field + parts + numcols + head + tail + ref-regex + has-reuse + initial-point) + + (setq initial-point (point)) + (org-favtable--goto-top) + (setq top (point)) + + (goto-char top) + + ;; count columns + (org-table-goto-column 100) + (setq numcols (- (org-table-current-column) 1)) + + ;; get contents of columns + (forward-line -2) + (unless (org-at-table-p) + (org-favtable--report-setup-error + "Table of favorites starts with a hline" t)) + + ;; check for optional line consisting solely of width specifications + (beginning-of-line) + (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$") + (forward-line -1)) + (org-table-goto-column 1) + + (setq org-favtable--columns (org-favtable--parse-headings numcols)) + + ;; Go beyond end of table + (while (org-at-table-p) (forward-line 1)) + + ;; Kill all empty rows at bottom + (while (progn + (forward-line -1) + (org-table-goto-column 1) + (and + (not (org-favtable--get-field 'ref)) + (not (org-favtable--get-field 'link)))) + (org-table-kill-row)) + (forward-line) + (setq bottom (point)) + (forward-line -1) + + ;; Retrieve any decorations around the number within the first nonempty ref-field + (goto-char top) + (while (and (org-at-table-p) + (not (setq ref-field (org-favtable--get-field 'ref)))) + (forward-line)) + + ;; Some Checking + (unless ref-field + (org-favtable--report-setup-error + "No line of reference column contains a number" t)) + + (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field) + (org-favtable--report-setup-error + (format "First reference in table table of favorites ('%s') does not contain a number" ref-field) t)) + + + ;; These are the decorations used within the first ref of favtable + (setq head (match-string 1 ref-field)) + (setq tail (match-string 3 ref-field)) + (setq ref-regex (concat (regexp-quote head) + "\\([0-9]+\\)" + (regexp-quote tail))) + + ;; Go through table to find maximum number and do some checking + (let ((ref 0)) + + (while (org-at-table-p) + + (setq ref-field (org-favtable--get-field 'ref)) + (setq link-field (org-favtable--get-field 'link)) + + (if (and (not ref-field) + (not link-field)) + (throw 'content-error "Columns ref and link are both empty in this line")) + + (if ref-field + (if (string-match ref-regex ref-field) + ;; grab number + (setq ref (string-to-number (match-string 1 ref-field))) + (throw 'content-error "Column ref does not contain a number"))) + + ;; check, if higher ref + (if (> ref maxref) (setq maxref ref)) + + ;; check if ref is ment for reuse + (if (string= (org-favtable--get-field 'count) ":reuse:") + (setq has-reuse 1)) + + (forward-line 1))) + + ;; sort used to be here + + (setq parts (list head maxref tail numcols ref-regex has-reuse)) + + ;; go back to top of table + (goto-char top) + + parts)) + + + +(defun org-favtable--sort-table (sort-column) + + (unless sort-column (setq sort-column (org-favtable--column-num 'sort))) + + (let (top + bottom + ref-field + count-field + count-special) + + + ;; get boundaries of table + (org-favtable--goto-top) + (forward-line 0) + (setq top (point)) + (while (org-at-table-p) (forward-line)) + (setq bottom (point)) + + (save-restriction + (narrow-to-region top bottom) + (goto-char top) + (sort-subr t + 'forward-line + 'end-of-line + (lambda () + (let (ref + (ref-field (or (org-favtable--get-field 'ref) "")) + (count-field (or (org-favtable--get-field 'count) "")) + (count-special 0)) + + ;; get reference with leading zeroes, so it can be + ;; sorted as text + (string-match org-favtable--ref-regex ref-field) + (setq ref (format + "%06d" + (string-to-number + (or (match-string 1 ref-field) + "0")))) + + ;; find out, if special token in count-column + (setq count-special (format "%d" + (- 2 + (length (member count-field '(":missing:" ":reuse:")))))) + + ;; Construct different sort-keys according to + ;; requested sort column; prepend count-special to + ;; sort special entries at bottom of table, append ref + ;; as a secondary sort key + (cond + + ((eq sort-column 'count) + (concat count-special + (format + "%08d" + (string-to-number (or (org-favtable--get-field 'count) + ""))) + ref)) + + ((eq sort-column 'last-accessed) + (concat count-special + (org-favtable--get-field 'last-accessed) + " " + ref)) + + ((eq sort-column 'ref) + (concat count-special + ref)) + + (t (error "This is a bug: unmatched case '%s'" sort-column))))) + + nil 'string<))) + + ;; align table + (org-table-align)) + + +(defun org-favtable--goto-top () + + ;; go to heading of node + (while (not (org-at-heading-p)) (forward-line -1)) + (forward-line 1) + ;; go to table within node, but make sure we do not get into another node + (while (and (not (org-at-heading-p)) + (not (org-at-table-p)) + (not (eq (point) (point-max)))) + (forward-line 1)) + + ;; check, if there really is a table + (unless (org-at-table-p) + (org-favtable--report-setup-error + (format "Cannot find favtable within node %s" org-favtable-id) t)) + + ;; go to first hline + (while (and (not (org-at-table-hline-p)) + (org-at-table-p)) + (forward-line 1)) + + ;; and check + (unless (org-at-table-hline-p) + (org-favtable--report-setup-error + "Cannot find hline within table of favorites" t)) + + (forward-line 1) + (org-table-goto-column 1)) + + + +(defun org-favtable--id-find () + "Find org-favtable-id" + (let ((marker (org-id-find org-favtable-id 'marker)) + marker-and-buffer) + + (if marker + (progn + (setq marker-and-buffer (cons (marker-buffer marker) (marker-position marker))) + (move-marker marker nil) + marker-and-buffer) + nil))) + + + +(defun org-favtable--parse-headings (numcols) + + (let (columns) + + ;; Associate names of special columns with column-numbers + (setq columns (copy-tree '((ref . 0) (link . 0) (created . 0) (last-accessed . 0) + (count . 0) (sort . nil) (copy . nil)))) + + ;; For each column + (dotimes (col numcols) + (let* (field-flags ;; raw heading, consisting of file name and maybe + ;; flags (seperated by ";") + field ;; field name only + field-symbol ;; and as a symbol + flags ;; flags from field-flags + found) + + ;; parse field-flags into field and flags + (setq field-flags (org-trim (org-table-get-field (+ col 1)))) + (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags) + (progn + (setq field (downcase (or (match-string 1 field-flags) ""))) + ;; get flags as list of characters + (setq flags (mapcar 'string-to-char + (split-string + (downcase (match-string 2 field-flags)) + "" t)))) + ;; no flags + (setq field field-flags)) + + (unless (string= field "") (setq field-symbol (intern (downcase field)))) + + ;; Check, that no flags appear twice + (mapc (lambda (x) + (when (memq (car x) flags) + (if (cdr (assoc (cdr x) columns)) + (org-favtable--report-setup-error + (format "More than one heading is marked with flag '%c'" (car x)) t)))) + '((?s . sort) + (?c . copy))) + + ;; Process flags + (if (memq ?s flags) + (setcdr (assoc 'sort columns) field-symbol)) + (if (memq ?c flags) + (setcdr (assoc 'copy columns) (+ col 1))) + + ;; Store columns in alist + (setq found (assoc field-symbol columns)) + (when found + (if (> (cdr found) 0) + (org-favtable--report-setup-error + (format "'%s' appears two times as column heading" (downcase field)) t)) + (setcdr found (+ col 1))))) + + ;; check if all necessary informations have been specified + (mapc (lambda (col) + (unless (> (cdr (assoc col columns)) 0) + (org-favtable--report-setup-error + (format "column '%s' has not been set" col) t))) + '(ref link count created last-accessed)) + + ;; use ref as a default sort-column + (unless (cdr (assoc 'sort columns)) + (setcdr (assoc 'sort columns) 'ref)) + columns)) + + + +(defun org-favtable--report-setup-error (text &optional switch-to-node) + + (when switch-to-node + (org-id-goto org-favtable-id) + (delete-other-windows)) + + (when (y-or-n-p (concat + text + ";\n" + "the correct setup is explained in the documentation of 'org-favtable-id'.\n" + "Do you want to read it ? ")) + (org-favtable--show-help 'org-favtable-id)) + + (error "") + (setq org-favtable--last-action 'leave)) + + + +(defun org-favtable--show-help (function-or-variable) + + (let ((isfun (functionp function-or-variable))) + ;; bring up help-buffer for function or variable + (if isfun + (describe-function function-or-variable) + (describe-variable function-or-variable)) + + + ;; clean up help-buffer + (pop-to-buffer "*Help*") + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (while (progn + (kill-line 1) + (not (looking-at + (if isfun + "(" + "Documentation:"))))) + (kill-line (if isfun 2 3)) + (goto-char (point-max)) + (kill-line -2) + (goto-char (point-min))))) + + + +(defun org-favtable--update-line (ref-or-link) + + (let (initial + found + count-field + (ref-node-buffer-and-point (org-favtable--id-find))) + + (with-current-buffer (car ref-node-buffer-and-point) + + ;; search reference or link, if given (or assume, that we are already positioned right) + (when ref-or-link + (setq initial (point)) + (goto-char (cdr ref-node-buffer-and-point)) + (org-favtable--goto-top) + (while (and (org-at-table-p) + (not (or (string= ref-or-link (org-favtable--get-field 'ref)) + (string= ref-or-link (org-favtable--get-field 'link))))) + (forward-line))) + + (if (not (org-at-table-p)) + (error "Did not find reference or link '%s'" ref-or-link) + (setq count-field (org-favtable--get-field 'count)) + + ;; update count field only if number or empty; leave :missing: and :reuse: as is + (if (or (not count-field) + (string-match "^[0-9]+$" count-field)) + (org-favtable--get-field 'count + (number-to-string + (+ 1 (string-to-number (or count-field "0")))))) + + ;; update timestamp + (org-table-goto-column (org-favtable--column-num 'last-accessed)) + (org-table-blank-field) + (org-insert-time-stamp nil t t) + + (setq found t)) + + (if initial (goto-char initial)) + + found))) + + + +(defun org-favtable--occur-helper (action) + (let ((line-beg (line-beginning-position)) + key search link ref) + + ;; extract reference or link from text property (as put there before) + (setq ref (get-text-property line-beg 'org-favtable--ref)) + (if (string= ref "") (setq ref nil)) + (setq link (get-text-property line-beg 'org-favtable--link)) + (if (string= link "") (setq link nil)) + + (org-favtable action + (or link ref) ;; prefer link + (if link t nil)))) + + +(defun org-favtable--get-field (key &optional value) + (let (field) + (setq field (org-trim (org-table-get-field (cdr (assoc key org-favtable--columns)) value))) + (if (string= field "") (setq field nil)) + + field)) + + +(defun org-favtable--column-num (key) + (cdr (assoc key org-favtable--columns))) + + +(defun org-favtable-version () + "Show version of org-favtable" (interactive) + (message "org-favtable %s" org-favtable--version)) + + +(defun org-favtable--make-guarded-search (ref &optional dont-quote) + (concat "\\b" (if dont-quote ref (regexp-quote ref)) "\\b")) + + +(defun org-favtable-get-ref-regex-format () + "return cons-cell with regular expression and format for references" + (unless org-favtable--ref-regex + (org-favtable 'parse)) + (cons (org-favtable--make-guarded-search org-favtable--ref-regex 'dont-quote) org-favtable--ref-format)) + + +(defadvice org-mark-ring-goto (after org-favtable--advice-text-to-yank activate) + "Make text from the favtable available for yank." + (when org-favtable--text-to-yank + (kill-new org-favtable--text-to-yank) + (message (format "Ready to yank '%s'" org-favtable--text-to-yank)) + (setq org-favtable--text-to-yank nil))) + + +(provide 'org-favtable) + +;; Local Variables: +;; fill-column: 75 +;; comment-column: 50 +;; End: + +;;; org-favtable.el ends here diff --git a/contrib/lisp/org-git-link.el b/contrib/lisp/org-git-link.el index 2f5990fae..b9e6a4e42 100644 --- a/contrib/lisp/org-git-link.el +++ b/contrib/lisp/org-git-link.el @@ -5,6 +5,8 @@ ;; Author: Reimar Finken ;; Keywords: files, calendar, hypermedia +;; This file is not part of GNU Emacs. + ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or @@ -130,10 +132,11 @@ (list (expand-file-name ".git" dir) relpath)))) -(if (featurep 'xemacs) - (defalias 'org-git-gitrepos-p 'org-git-find-gitdir) - (defalias 'org-git-gitrepos-p 'org-git-find-gitdir - "Return non-nil if path is in git repository")) +(eval-and-compile + (if (featurep 'xemacs) + (defalias 'org-git-gitrepos-p 'org-git-find-gitdir) + (defalias 'org-git-gitrepos-p 'org-git-find-gitdir + "Return non-nil if path is in git repository"))) ;; splitting the link string @@ -194,8 +197,7 @@ (unless (zerop (call-process org-git-program nil buffer nil "--no-pager" (concat "--git-dir=" gitdir) "show" object)) - (error "git error: %s " (save-excursion (set-buffer buffer) - (buffer-string))))) + (error "git error: %s " (with-current-buffer buffer (buffer-string))))) (defun org-git-blob-sha (gitdir object) "Return sha of the referenced object" diff --git a/contrib/lisp/org-interactive-query.el b/contrib/lisp/org-interactive-query.el index 6caf78826..57665e219 100644 --- a/contrib/lisp/org-interactive-query.el +++ b/contrib/lisp/org-interactive-query.el @@ -19,8 +19,7 @@ ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs. If not, see . ;; ;;; Commentary: ;; diff --git a/contrib/lisp/org-invoice.el b/contrib/lisp/org-invoice.el index 6bebe7d23..88ff48ff7 100644 --- a/contrib/lisp/org-invoice.el +++ b/contrib/lisp/org-invoice.el @@ -23,7 +23,7 @@ ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ;; -;; Commentary: +;;; Commentary: ;; ;; Building on top of the terrific OrgMode, org-invoice tries to ;; provide functionality for managing invoices. Currently, it does @@ -226,8 +226,8 @@ looks like tree2, where the level is 2." (setq org-invoice-total-time (+ org-invoice-total-time work) org-invoice-total-price (+ org-invoice-total-price price))) - (setq total (and total (org-minutes-to-hh:mm-string total))) - (setq work (and work (org-minutes-to-hh:mm-string work))) + (setq total (and total (org-minutes-to-clocksum-string total))) + (setq work (and work (org-minutes-to-clocksum-string work))) (insert-before-markers (concat "|" title (cond @@ -251,7 +251,7 @@ looks like tree2, where the level is 2." (when with-summary (insert-before-markers (concat "|-\n|Total:|" - (org-minutes-to-hh:mm-string org-invoice-total-time) + (org-minutes-to-clocksum-string org-invoice-total-time) (and with-price (concat "|" (format "%.2f" org-invoice-total-price))) "|\n"))))) diff --git a/contrib/lisp/org-jira.el b/contrib/lisp/org-jira.el index f511667a3..57128fbee 100644 --- a/contrib/lisp/org-jira.el +++ b/contrib/lisp/org-jira.el @@ -14,9 +14,8 @@ ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. -;; For a copy of the GNU General Public License, search the Internet, -;; or write to the Free Software Foundation, Inc., 59 Temple Place, -;; Suite 330, Boston, MA 02111-1307 USA +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This adds a jira protocol to org mode. diff --git a/contrib/lisp/org-learn.el b/contrib/lisp/org-learn.el index f70ca11e7..1f5e76cf8 100644 --- a/contrib/lisp/org-learn.el +++ b/contrib/lisp/org-learn.el @@ -9,12 +9,12 @@ ;; ;; This file is not part of GNU Emacs. ;; -;; GNU Emacs is free software: you can redistribute it and/or modify +;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. diff --git a/contrib/lisp/org-mac-iCal.el b/contrib/lisp/org-mac-iCal.el index 82cf91df1..afec84b7a 100644 --- a/contrib/lisp/org-mac-iCal.el +++ b/contrib/lisp/org-mac-iCal.el @@ -3,24 +3,23 @@ ;; Copyright (C) 2009-2013 Christopher Suckling ;; Author: Christopher Suckling +;; Version: 0.1057.104 +;; Keywords: outlines, calendar -;; This file is Free Software; you can redistribute it and/or modify +;; This file is not part of GNU Emacs. + +;; This program is Free Software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; It is distributed in the hope that it will be useful, but WITHOUT -;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -;; License for more details. +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;; Version: 0.1057.104 -;; Keywords: outlines, calendar +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/contrib/lisp/org-mac-link-grabber.el b/contrib/lisp/org-mac-link-grabber.el index 1a4f915a7..05986172b 100644 --- a/contrib/lisp/org-mac-link-grabber.el +++ b/contrib/lisp/org-mac-link-grabber.el @@ -1,5 +1,5 @@ ;;; org-mac-link-grabber.el --- Grab links and url from various mac -;;; application and insert them as links into org-mode documents +;; Application and insert them as links into org-mode documents ;; ;; Copyright (c) 2010-2013 Free Software Foundation, Inc. ;; @@ -20,8 +20,7 @@ ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs. If not, see . ;; ;;; Commentary: ;; diff --git a/lisp/org-mac-message.el b/contrib/lisp/org-mac-message.el similarity index 97% rename from lisp/org-mac-message.el rename to contrib/lisp/org-mac-message.el index 5df68f56a..dca63c9bd 100644 --- a/lisp/org-mac-message.el +++ b/contrib/lisp/org-mac-message.el @@ -7,7 +7,7 @@ ;; Keywords: outlines, hypermedia, calendar, wp -;; This file is part of GNU Emacs. +;; This file is not part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -23,9 +23,10 @@ ;; along with GNU Emacs. If not, see . ;;; Commentary: -;; This file implements links to Apple Mail.app messages from within Org-mode. -;; Org-mode does not load this module by default - if you would actually like -;; this to happen then configure the variable `org-modules'. +;; This file implements links to Apple Mail.app messages from within +;; Org-mode. Org-mode does not load this module by default - if you +;; would actually like this to happen then configure the variable +;; `org-modules' and add Org's contrib/ directory to your `load-path'. ;; If you would like to create links to all flagged messages in an ;; Apple Mail.app account, please customize the variable diff --git a/contrib/lisp/org-mairix.el b/contrib/lisp/org-mairix.el index 0f7d4b1e0..b08897d53 100644 --- a/contrib/lisp/org-mairix.el +++ b/contrib/lisp/org-mairix.el @@ -3,6 +3,8 @@ ;; Copyright (C) 2007-2013 Georg C. F. Greve ;; mutt support by Adam Spiers ;; +;; This file is not part of GNU Emacs. +;; ;; Author: Georg C. F. Greve ;; Keywords: outlines, hypermedia, calendar, wp, email, mairix ;; Purpose: Integrate mairix email searching into Org mode @@ -20,9 +22,7 @@ ;; License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; USAGE NOTE ;; diff --git a/contrib/lisp/org-man.el b/contrib/lisp/org-man.el index 27e8cca24..a9db83d5d 100644 --- a/contrib/lisp/org-man.el +++ b/contrib/lisp/org-man.el @@ -7,27 +7,25 @@ ;; ;; This file is not yet part of GNU Emacs. ;; -;; GNU Emacs is free software; you can redistribute it and/or modify +;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: (require 'org) -(org-add-link-type "man" 'org-man-open) +(org-add-link-type "man" 'org-man-open 'org-man-export) (add-hook 'org-store-link-functions 'org-man-store-link) (defcustom org-man-command 'man @@ -59,6 +57,17 @@ PATH should be a topic that can be thrown at the man command." (match-string 1 (buffer-name)) (error "Cannot create link to this man page"))) +(defun org-man-export (link description format) + "Export a man page link from Org files." + (let ((path (format "http://man.he.net/?topic=%s§ion=all" link)) + (desc (or description link))) + (cond + ((eq format 'html) (format "%s" path desc)) + ((eq format 'latex) (format "\\href{%s}{%s}" path desc)) + ((eq format 'texinfo) (format "@uref{%s,%s}" path desc)) + ((eq format 'ascii) (format "%s (%s)" desc path)) + (t path)))) + (provide 'org-man) ;;; org-man.el ends here diff --git a/contrib/lisp/org-mew.el b/contrib/lisp/org-mew.el new file mode 100644 index 000000000..ca6a3527f --- /dev/null +++ b/contrib/lisp/org-mew.el @@ -0,0 +1,364 @@ +;;; org-mew.el --- Support for links to Mew messages from within Org-mode + +;; Copyright (C) 2008-2013 Free Software Foundation, Inc. + +;; Author: Tokuya Kameshima +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file implements links to Mew messages from within Org-mode. +;; Org-mode loads this module by default - if this is not what you want, +;; configure the variable `org-modules'. +;; +;; Here is an example of workflow: + +;; In your ~/.mew.el configuration file: +;; +;; (define-key mew-summary-mode-map "'" 'org-mew-search) +;; (eval-after-load "mew-summary" +;; '(define-key mew-summary-mode-map "\C-o" 'org-mew-capture)) + +;; 1. In the Mew's inbox folder, take a glance at new messages to find +;; a message that requires any action. + +;; 2. If the message is a reply from somebody and associated with the +;; existing orgmode entry, type M-x `org-mew-search' RET (or press +;; the ' key simply) to find the entry. If you can find the entry +;; successfully and think you should start the task right now, +;; start the task by M-x `org-agenda-clock-in' RET. + +;; 3. If the message is a new message, type M-x `org-mew-capture' RET, +;; enter the refile folder, and the buffer to capture the message +;; is shown up (without selecting the template by hand). Then you +;; can fill the template and type C-c C-c to complete the capture. +;; Note that you can configure `org-capture-templates' so that the +;; captured entry has a link to the message. + +;;; Code: + +(require 'org) + +(defgroup org-mew nil + "Options concerning the Mew link." + :tag "Org Startup" + :group 'org-link) + +(defcustom org-mew-link-to-refile-destination t + "Create a link to the refile destination if the message is marked as refile." + :group 'org-mew + :type 'boolean) + +(defcustom org-mew-inbox-folder nil + "The folder where new messages are incorporated. +If `org-mew-inbox-folder' is non-nil, `org-mew-open' locates the message +in this inbox folder as well as the folder specified by the link." + :group 'org-mew + :type 'string) + +(defcustom org-mew-use-id-db t + "Use ID database to locate the message if id.db is created." + :group 'org-mew + :type 'boolean) + +(defcustom org-mew-subject-alist + (list (cons (concat "^\\(?:\\(?:re\\|fwd?\\): *\\)*" + "\\(?:[[(][a-z0-9._-]+[:,]? [0-9]+[])]\\)? *" + "\\(?:\\(?:re\\|fwd?\\): *\\)*" + "\\(.*\\)[ \t]*") + 1)) + "Alist of subject regular expression and matched group number for search." + :group 'org-mew + :type '(repeat (cons (regexp) (integer)))) + +(defcustom org-mew-capture-inbox-folders nil + "List of inbox folders whose messages need refile marked before capture. +`org-mew-capture' will ask you to put the refile mark on the +message if the message's folder is any of these folders and the +message is not marked. Nil means `org-mew-capture' never ask you +destination folders before capture." + :group 'org-mew + :type '(repeat string)) + +(defcustom org-mew-capture-guess-alist nil + "Alist of the regular expression of the folder name and the capture +template selection keys. + +For example, + '((\"^%emacs-orgmode$\" . \"o\") + (\"\" . \"t\")) +the messages in \"%emacs-orgmode\" folder will be captured with +the capture template associated with \"o\" key, and any other +messages will be captured with the capture template associated +with \"t\" key." + :group 'org-mew + :type '(repeat (cons regexp string))) + +;; Declare external functions and variables +(declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit)) +(declare-function mew-case-folder "ext:mew-func" (case folder)) +(declare-function mew-folder-path-to-folder + "ext:mew-func" (path &optional has-proto)) +(declare-function mew-idstr-to-id-list "ext:mew-header" (idstr &optional rev)) +(declare-function mew-folder-remotep "ext:mew-func" (folder)) +(declare-function mew-folder-virtualp "ext:mew-func" (folder)) +(declare-function mew-header-get-value "ext:mew-header" + (field &optional as-list)) +(declare-function mew-init "ext:mew" ()) +(declare-function mew-refile-get "ext:mew-refile" (msg)) +(declare-function mew-sinfo-get-case "ext:mew-summary" ()) +(declare-function mew-summary-diag-global "ext:mew-thread" (id opt who)) +(declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay)) +(declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext)) +(declare-function mew-summary-get-mark "ext:mew-mark" ()) +(declare-function mew-summary-message-number2 "ext:mew-syntax" ()) +(declare-function mew-summary-pick-with-mewl "ext:mew-pick" + (pattern folder src-msgs)) +(declare-function mew-summary-refile "ext:mew-refile" (&optional report)) +(declare-function mew-summary-search-msg "ext:mew-const" (msg)) +(declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg)) +(declare-function mew-summary-visit-folder "ext:mew-summary4" + (folder &optional goend no-ls)) +(declare-function mew-window-push "ext:mew" ()) +(declare-function mew-expand-folder "ext:mew-func" (folder)) +(declare-function mew-case:folder-folder "ext:mew-func" (case:folder)) +(declare-function mew "ext:mew" (&optional arg)) +(declare-function mew-message-goto-summary "ext:mew-message" ()) +(declare-function mew-summary-mode "ext:mew-summary" ()) + +(defvar mew-init-p) +(defvar mew-mark-afterstep-spec) +(defvar mew-summary-goto-line-then-display) + +;; Install the link type +(org-add-link-type "mew" 'org-mew-open) +(add-hook 'org-store-link-functions 'org-mew-store-link) + +;; Implementation +(defun org-mew-store-link () + "Store a link to a Mew folder or message." + (save-window-excursion + (if (eq major-mode 'mew-message-mode) + (mew-message-goto-summary)) + (when (memq major-mode '(mew-summary-mode mew-virtual-mode)) + (let ((msgnum (mew-summary-message-number2)) + (folder-name (org-mew-folder-name))) + (if (fboundp 'mew-summary-set-message-buffer) + (mew-summary-set-message-buffer folder-name msgnum) + (set-buffer (mew-cache-hit folder-name msgnum t))) + (let* ((message-id (mew-header-get-value "Message-Id:")) + (from (mew-header-get-value "From:")) + (to (mew-header-get-value "To:")) + (date (mew-header-get-value "Date:")) + (date-ts (and date (format-time-string + (org-time-stamp-format t) + (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) + (subject (mew-header-get-value "Subject:")) + desc link) + (org-store-link-props :type "mew" :from from :to to + :subject subject :message-id message-id) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) + (setq message-id (org-remove-angle-brackets message-id)) + (setq desc (org-email-link-description)) + (setq link (concat "mew:" folder-name "#" message-id)) + (org-add-link-props :link link :description desc) + link))))) + +(defun org-mew-folder-name () + "Return the folder name of the current message." + (save-window-excursion + (if (eq major-mode 'mew-message-mode) + (mew-message-goto-summary)) + (let* ((msgnum (mew-summary-message-number2)) + (mark-info (mew-summary-get-mark))) + (if (and org-mew-link-to-refile-destination + (eq mark-info ?o)) ; marked as refile + (mew-case-folder (mew-sinfo-get-case) + (nth 1 (mew-refile-get msgnum))) + (let ((folder-or-path (mew-summary-folder-name))) + (mew-folder-path-to-folder folder-or-path t)))))) + +(defun org-mew-open (path) + "Follow the Mew message link specified by PATH." + (let (folder message-id) + (cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's + (setq folder (match-string 1 path)) + (setq message-id (match-string 2 path))) + ((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path) + (setq folder (match-string 1 path)) + (setq message-id (match-string 4 path))) + ((and org-mew-use-id-db (string-match "\\`#\\(.+\\)" path)) + (setq folder nil) + (setq message-id (match-string 1 path))) + (t (error "Error in Mew link"))) + (require 'mew) + (mew-window-push) + (unless mew-init-p (mew-init)) + (if (null folder) + (progn + (mew t) + (org-mew-open-by-message-id message-id)) + (or (org-mew-follow-link folder message-id) + (and org-mew-inbox-folder (not (string= org-mew-inbox-folder folder)) + (org-mew-follow-link org-mew-inbox-folder message-id)) + (and org-mew-use-id-db + (org-mew-open-by-message-id message-id)) + (error "Message not found"))))) + +(defun org-mew-follow-link (folder message-id) + (unless (org-mew-folder-exists-p folder) + (error "No such folder or wrong folder %s" folder)) + (mew-summary-visit-folder folder) + (when message-id + (let ((msgnum (org-mew-get-msgnum folder message-id))) + (when (mew-summary-search-msg msgnum) + (if mew-summary-goto-line-then-display + (mew-summary-display)) + t)))) + +(defun org-mew-folder-exists-p (folder) + (let ((dir (mew-expand-folder folder))) + (cond + ((mew-folder-virtualp folder) (get-buffer folder)) + ((null dir) nil) + ((mew-folder-remotep (mew-case:folder-folder folder)) t) + (t (file-directory-p dir))))) + +(defun org-mew-get-msgnum (folder message-id) + (if (string-match "\\`[0-9]+\\'" message-id) + message-id + (let* ((pattern (concat "message-id=" message-id)) + (msgs (mew-summary-pick-with-mewl pattern folder nil))) + (car msgs)))) + +(defun org-mew-open-by-message-id (message-id) + "Open message using ID database." + (let ((result (mew-summary-diag-global (format "<%s>" message-id) + "-p" "Message"))) + (unless (eq result t) + (error "Message not found")))) + +;; In ~/.mew.el, add the following line: +;; (define-key mew-summary-mode-map "'" 'org-mew-search) +(defun org-mew-search (&optional arg) + "Show all entries related to the message using `org-search-view'. + +It shows entries which contains the message ID, the reference +IDs, or the subject of the message. + +With C-u prefix, search for the entries that contains the message +ID or any of the reference IDs. With C-u C-u prefix, search for +the message ID or the last reference ID. + +The search phase for the subject is extracted with +`org-mew-subject-alist', which defines the regular expression of +the subject and the group number to extract. You can get rid of +\"Re:\" and some other prefix from the subject text." + (interactive "P") + (when (memq major-mode '(mew-summary-mode mew-virtual-mode)) + (let ((last-reference-only (equal arg '(16))) + (by-subject (null arg)) + (msgnum (mew-summary-message-number2)) + (folder-name (mew-summary-folder-name)) + subject message-id references id-list) + (save-window-excursion + (if (fboundp 'mew-summary-set-message-buffer) + (mew-summary-set-message-buffer folder-name msgnum) + (set-buffer (mew-cache-hit folder-name msgnum t))) + (setq subject (mew-header-get-value "Subject:")) + (setq message-id (mew-header-get-value "Message-Id:")) + (setq references (mew-header-get-value "References:"))) + (setq id-list (mapcar (lambda (id) (org-remove-angle-brackets id)) + (mew-idstr-to-id-list references))) + (if last-reference-only + (setq id-list (last id-list)) + (if message-id + (setq id-list (cons (org-remove-angle-brackets message-id) + id-list)))) + (when (and by-subject (stringp subject)) + (catch 'matched + (mapc (lambda (elem) + (let ((regexp (car elem)) + (num (cdr elem))) + (when (string-match regexp subject) + (setq subject (match-string num subject)) + (throw 'matched t)))) + org-mew-subject-alist)) + (setq id-list (cons subject id-list))) + (cond ((null id-list) + (error "No message ID to search.")) + ((equal (length id-list) 1) + (org-search-view nil (car id-list))) + (t + (org-search-view nil (format "{\\(%s\\)}" + (mapconcat 'regexp-quote + id-list "\\|")))))) + (delete-other-windows))) + +(defun org-mew-capture (arg) + "Guess the capture template from the folder name and invoke `org-capture'. + +This selects a capture template in `org-capture-templates' by +searching for capture template selection keys defined in +`org-mew-capture-guess-alist' which are associated with the +regular expression that matches the message's folder name, and +then invokes `org-capture'. + +If the message's folder is a inbox folder, you are prompted to +put the refile mark on the message and the capture template is +guessed from the refile destination folder. You can customize +the inbox folders by `org-mew-capture-inbox-folders'. + +If ARG is non-nil, this does not guess the capture template but +asks you to select the capture template." + (interactive "P") + (or (not (member (org-mew-folder-name) + org-mew-capture-inbox-folders)) + (eq (mew-summary-get-mark) ?o) + (save-window-excursion + (if (eq major-mode 'mew-message-mode) + (mew-message-goto-summary)) + (let ((mew-mark-afterstep-spec '((?o 0 0 0 0 0 0 0)))) + (mew-summary-refile))) + (error "No refile folder selected.")) + (let* ((org-mew-link-to-refile-destination t) + (folder-name (org-mew-folder-name)) + (keys (if arg + nil + (org-mew-capture-guess-selection-keys folder-name)))) + (org-capture nil keys))) + +(defun org-mew-capture-guess-selection-keys (folder-name) + (catch 'found + (let ((alist org-mew-capture-guess-alist)) + (while alist + (let ((elem (car alist))) + (if (string-match (car elem) folder-name) + (throw 'found (cdr elem)))) + (setq alist (cdr alist)))))) + +(provide 'org-mew) + +;;; org-mew.el ends here diff --git a/contrib/lisp/org-mime.el b/contrib/lisp/org-mime.el index 9564f3a09..855dc2d58 100644 --- a/contrib/lisp/org-mime.el +++ b/contrib/lisp/org-mime.el @@ -22,9 +22,7 @@ ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -57,6 +55,9 @@ ;;; Code: (require 'cl) +(declare-function org-export-string-as "ox" + (string backend &optional body-only ext-plist)) + (defcustom org-mime-use-property-inheritance nil "Non-nil means al MAIL_ properties apply also for sublevels." :group 'org-mime @@ -195,6 +196,8 @@ and images in a multipart/related part." html using `org-mode'. If called with an active region only export that region, otherwise export the entire body." (interactive "P") + (require 'ox-org) + (require 'ox-html) (let* ((region-p (org-region-active-p)) (html-start (or (and region-p (region-beginning)) (save-excursion @@ -204,10 +207,11 @@ export that region, otherwise export the entire body." (html-end (or (and region-p (region-end)) ;; TODO: should catch signature... (point-max))) - (raw-body (buffer-substring html-start html-end)) + (raw-body (concat org-mime-default-header + (buffer-substring html-start html-end))) (tmp-file (make-temp-name (expand-file-name "mail" temporary-file-directory))) - (body (org-export-string raw-body 'org (file-name-directory tmp-file))) + (body (org-export-string-as raw-body 'org t)) ;; because we probably don't want to skip part of our mail (org-export-skip-text-before-1st-heading nil) ;; because we probably don't want to export a huge style file @@ -219,8 +223,7 @@ export that region, otherwise export the entire body." ;; to hold attachments for inline html images (html-and-images (org-mime-replace-images - (org-export-string raw-body 'html (file-name-directory tmp-file)) - tmp-file)) + (org-export-string-as raw-body 'html t) tmp-file)) (html-images (unless arg (cdr html-and-images))) (html (org-mime-apply-html-hook (if arg @@ -295,26 +298,29 @@ export that region, otherwise export the entire body." (let ((fmt (if (symbolp fmt) fmt (intern fmt)))) (cond ((eq fmt 'org) - (insert (org-export-string (org-babel-trim (bhook body 'org)) 'org))) + (require 'ox-org) + (insert (org-export-string-as + (org-babel-trim (bhook body 'org)) 'org t))) ((eq fmt 'ascii) - (insert (org-export-string - (concat "#+Title:\n" (bhook body 'ascii)) 'ascii))) + (require 'ox-ascii) + (insert (org-export-string-as + (concat "#+Title:\n" (bhook body 'ascii)) 'ascii t))) ((or (eq fmt 'html) (eq fmt 'html-ascii)) + (require 'ox-ascii) + (require 'ox-org) (let* ((org-link-file-path-type 'absolute) ;; we probably don't want to export a huge style file (org-export-htmlize-output-type 'inline-css) - (html-and-images (org-mime-replace-images - (org-export-string - (bhook body 'html) - 'html (file-name-nondirectory file)) - file)) + (html-and-images + (org-mime-replace-images + (org-export-string-as (bhook body 'html) 'html t) file)) (images (cdr html-and-images)) (html (org-mime-apply-html-hook (car html-and-images)))) (insert (org-mime-multipart - (org-export-string + (org-export-string-as (org-babel-trim (bhook body (if (eq fmt 'html) 'org 'ascii))) - (if (eq fmt 'html) 'org 'ascii)) + (if (eq fmt 'html) 'org 'ascii) t) html) (mapconcat 'identity images "\n")))))))) diff --git a/contrib/lisp/org-mtags.el b/contrib/lisp/org-mtags.el index cbd85afee..dadcef720 100644 --- a/contrib/lisp/org-mtags.el +++ b/contrib/lisp/org-mtags.el @@ -9,20 +9,18 @@ ;; ;; This file is not yet part of GNU Emacs. ;; -;; GNU Emacs is free software; you can redistribute it and/or modify +;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el index 9b5674d60..4047448e6 100644 --- a/contrib/lisp/org-notify.el +++ b/contrib/lisp/org-notify.el @@ -5,6 +5,8 @@ ;; Author: Peter Münster ;; Keywords: notification, todo-list, alarm, reminder, pop-up +;; This file is not part of GNU Emacs. + ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or @@ -35,6 +37,7 @@ ;; (org-notify-start) ;; Example setup: +;; ;; (org-notify-add 'appt ;; '(:time "-1s" :period "20s" :duration 10 ;; :actions (-message -ding)) @@ -42,11 +45,12 @@ ;; :actions -notify) ;; '(:time "2h" :period "5m" :actions -message) ;; '(:time "3d" :actions -email)) +;; ;; This means for todo-items with `notify' property set to `appt': 3 days ;; before deadline, send a reminder-email, 2 hours before deadline, start to ;; send messages every 5 minutes, then 15 minutes before deadline, start to -;; pop up notification windows every 2 minutes. The timeout of the window is -;; set to 100 seconds. Finally, when deadline is overdue, send messages and +;; pop up notification windows every 2 minutes. The timeout of the window is +;; set to 100 seconds. Finally, when deadline is overdue, send messages and ;; make noise." ;; Take also a look at the function `org-notify-add'. @@ -104,12 +108,21 @@ (cdr (assoc (match-string 3 str) conv)) (if (= (length (match-string 1 str)) 1) -1 1))))) +(defun org-notify-convert-deadline (orig) + "Convert original deadline from `org-element-parse-buffer' to +simple timestamp string." + (if orig + (replace-regexp-in-string "^<\\|>$" "" + (plist-get (plist-get orig 'timestamp) + :raw-value)))) + (defun org-notify-make-todo (heading &rest ignored) "Create one todo item." (macrolet ((get (k) `(plist-get list ,k)) (pr (k v) `(setq result (plist-put result ,k ,v)))) (let* ((list (nth 1 heading)) (notify (or (get :notify) "default")) - (deadline (get :deadline)) (heading (get :raw-value)) + (deadline (org-notify-convert-deadline (get :deadline))) + (heading (get :raw-value)) result) (when (and (eq (get :todo-type) 'todo) heading deadline) (pr :heading heading) (pr :notify (intern notify)) @@ -173,26 +186,29 @@ forgotten tasks." (return))))))) (defun org-notify-add (name &rest params) - "Add a new notification type. The NAME can be used in Org-mode property -`notify'. If NAME is `default', the notification type applies for todo items -without the `notify' property. This file predefines such a default + "Add a new notification type. +The NAME can be used in Org-mode property `notify'. If NAME is +`default', the notification type applies for todo items without +the `notify' property. This file predefines such a default notification type. Each element of PARAMS is a list with parameters for a given time -distance to the deadline. This distance must increase from one element to -the next. +distance to the deadline. This distance must increase from one +element to the next. + List of possible parameters: + :time Time distance to deadline, when this type of notification shall - start. It's a string: an integral value (positive or negative) + start. It's a string: an integral value (positive or negative) followed by a unit (s, m, h, d, w, M). :actions A function or a list of functions to be called to notify the - user. Instead of a function name, you can also supply a suffix + user. Instead of a function name, you can also supply a suffix of one of the various predefined `org-notify-action-xxx' functions. - :period Optional: can be used to repeat the actions periodically. Same - format as :time. + :period Optional: can be used to repeat the actions periodically. + Same format as :time. :duration Some actions use this parameter to specify the duration of the - notification. It's an integral number in seconds. + notification. It's an integral number in seconds. :audible Overwrite the value of `org-notify-audible' for this action. For the actions, you can use your own functions or some of the predefined @@ -200,11 +216,12 @@ ones, whose names are prefixed with `org-notify-action-'." (setq org-notify-map (plist-put org-notify-map name params))) (defun org-notify-start (&optional secs) - "Start the notification daemon. If SECS is positive, it's the -period in seconds for processing the notifications of one -org-agenda file, and if negative, notifications will be checked -only when emacs is idle for -SECS seconds. The default value for -SECS is 20." + "Start the notification daemon. +If SECS is positive, it's the period in seconds for processing +the notifications of one org-agenda file, and if negative, +notifications will be checked only when emacs is idle for -SECS +seconds. The default value for SECS is 20." + (interactive) (if org-notify-timer (org-notify-stop)) (setq secs (or secs 20) @@ -216,8 +233,8 @@ SECS is 20." (defun org-notify-stop () "Stop the notification daemon." (when org-notify-timer - (cancel-timer org-notify-timer) - (setq org-notify-timer nil))) + (cancel-timer org-notify-timer) + (setq org-notify-timer nil))) (defun org-notify-on-action (plist key) "User wants to see action." @@ -299,7 +316,7 @@ SECS is 20." (defun org-notify-select-highest-window () "Select the highest window on the frame, that is not is not an -org-notify window. Mostly copied from `appt-select-lowest-window'." +org-notify window. Mostly copied from `appt-select-lowest-window'." (let ((highest-window (selected-window)) (bottom-edge (nth 3 (window-edges))) next-bottom-edge) @@ -370,7 +387,7 @@ terminal an emacs window." ;;; Provide a minimal default setup. (org-notify-add 'default '(:time "1h" :actions -notify/window - :period "2m" :duration 60)) + :period "2m" :duration 60)) (provide 'org-notify) diff --git a/contrib/lisp/org-notmuch.el b/contrib/lisp/org-notmuch.el index 2de58b9c5..c7f92feba 100644 --- a/contrib/lisp/org-notmuch.el +++ b/contrib/lisp/org-notmuch.el @@ -19,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/contrib/lisp/org-panel.el b/contrib/lisp/org-panel.el index 3ffdfaf9e..dec724103 100644 --- a/contrib/lisp/org-panel.el +++ b/contrib/lisp/org-panel.el @@ -50,9 +50,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth -;; Floor, Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -133,8 +131,6 @@ active.)" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Hook functions etc -;;(defvar orgpan-this-panel-window nil) - (defun orgpan-delete-panel () "Remove the panel." (interactive) @@ -203,8 +199,7 @@ active.)" (unless (and orgpan-point (= (point) orgpan-point)) ;; Go backward so it is possible to click on a "button": - (orgpan-backward-field))))) - (setq orgpan-this-panel-window nil)) + (orgpan-backward-field)))))) (error (lwarn 't :warning "orgpan-post: %S" err)))) ;; (defun orgpan-window-config-change () @@ -294,7 +289,7 @@ active.)" (defun orgpan-check-panel-mode () (unless (derived-mode-p 'orgpan-mode) - (error "Not orgpan-mode in buffer: " major-mode))) + (error "Not orgpan-mode in buffer: %s" major-mode))) (defun orgpan-display-bindings-help () (orgpan-check-panel-mode) @@ -401,6 +396,9 @@ There can be only one such buffer at any time.") (defvar orgpan-point nil) ;;(make-variable-buffer-local 'orgpan-point) +(defvar viper-emacs-state-mode-list) +(defvar viper-new-major-mode-buffer-list) + (defun orgpan-avoid-viper-in-buffer () ;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state': (set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode)) @@ -598,12 +596,11 @@ button changes the binding of the arrow keys." org-mode-map)) ;;(org-back-to-heading) ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change) - (split-window) + (setq orgpan-org-window (selected-window)) + (setq orgpan-panel-window (split-window nil -4 'below)) + (select-window orgpan-panel-window) (set-window-buffer (selected-window) (orgpan-make-panel-buffer)) - (setq orgpan-panel-window (selected-window)) ;;(set-window-dedicated-p (selected-window) t) - (fit-window-to-buffer nil nil 3) - (setq orgpan-org-window (next-window)) ;; The minor mode version starts here: (when orgpan-minor-mode-version (select-window orgpan-org-window) diff --git a/contrib/lisp/org-registry.el b/contrib/lisp/org-registry.el index 65a059211..1950797c8 100644 --- a/contrib/lisp/org-registry.el +++ b/contrib/lisp/org-registry.el @@ -11,6 +11,8 @@ ;; Description: Shows Org files where the current buffer is linked ;; URL: http://www.cognition.ens.fr/~guerry/u/org-registry.el ;; +;; This file is not part of GNU Emacs. +;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) @@ -22,8 +24,7 @@ ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/contrib/lisp/org-screen.el b/contrib/lisp/org-screen.el index 96c212122..3334a0fff 100644 --- a/contrib/lisp/org-screen.el +++ b/contrib/lisp/org-screen.el @@ -7,20 +7,18 @@ ;; ;; This file is not yet part of GNU Emacs. ;; -;; GNU Emacs is free software; you can redistribute it and/or modify +;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/contrib/lisp/org-secretary.el b/contrib/lisp/org-secretary.el index c9941a9bc..e98eb3499 100644 --- a/contrib/lisp/org-secretary.el +++ b/contrib/lisp/org-secretary.el @@ -19,9 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/contrib/lisp/org-static-mathjax.el b/contrib/lisp/org-static-mathjax.el index 29f2cfef8..ac13ee2dd 100644 --- a/contrib/lisp/org-static-mathjax.el +++ b/contrib/lisp/org-static-mathjax.el @@ -2,6 +2,22 @@ ;; ;; Author: Jan Böker +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: ;; This elisp code integrates Static MathJax into the ;; HTML export process of Org-mode. ;; @@ -39,7 +55,7 @@ ;; of your math, add the following line at the top of your Org file: ;; -*- coding: utf-8; -*- ;; -;; License: GPL v2 or later +;;; Code: (defcustom org-static-mathjax-app-ini-path (or (expand-file-name diff --git a/contrib/lisp/org-sudoku.el b/contrib/lisp/org-sudoku.el index 159976270..2bf24d8ad 100644 --- a/contrib/lisp/org-sudoku.el +++ b/contrib/lisp/org-sudoku.el @@ -9,20 +9,18 @@ ;; ;; This file is not yet part of GNU Emacs. ;; -;; GNU Emacs is free software; you can redistribute it and/or modify +;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/contrib/lisp/org-toc.el b/contrib/lisp/org-toc.el index 7302a6181..e0e60987f 100644 --- a/contrib/lisp/org-toc.el +++ b/contrib/lisp/org-toc.el @@ -20,8 +20,7 @@ ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/contrib/lisp/org-track.el b/contrib/lisp/org-track.el index d0581358f..db8c34ec6 100644 --- a/contrib/lisp/org-track.el +++ b/contrib/lisp/org-track.el @@ -16,12 +16,12 @@ ;; ;; This file is not part of GNU Emacs. ;; -;; GNU Emacs is free software: you can redistribute it and/or modify +;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. @@ -69,10 +69,9 @@ unpack it into that directory (i.e. a subdirectory sources. All you'll have to do is call `M-x org-track-update' from time to time." - :version "22.1" :group 'org) -(defcustom org-track-directory "~/.emacs.d/org/lisp" +(defcustom org-track-directory (concat user-emacs-directory "org/lisp") "Directory where your org-mode/ directory lives. If that directory does not exist, it will be created." :type 'directory) diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el index 60bf21c3e..fa4140637 100644 --- a/contrib/lisp/org-velocity.el +++ b/contrib/lisp/org-velocity.el @@ -17,9 +17,8 @@ ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. -;; For a copy of the GNU General Public License, search the Internet, -;; or write to the Free Software Foundation, Inc., 59 Temple Place, -;; Suite 330, Boston, MA 02111-1307 USA +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; Org-Velocity.el is an interface for Org inspired by the minimalist diff --git a/lisp/org-vm.el b/contrib/lisp/org-vm.el similarity index 97% rename from lisp/org-vm.el rename to contrib/lisp/org-vm.el index fc2a34b8f..f60c5bbb2 100644 --- a/lisp/org-vm.el +++ b/contrib/lisp/org-vm.el @@ -10,14 +10,14 @@ ;; by Konrad Hinsen ;; Requires VM 8.2.0a or later. ;; -;; This file is part of GNU Emacs. +;; This file is not part of GNU Emacs. ;; -;; GNU Emacs is free software: you can redistribute it and/or modify +;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el index 6e5a38bb9..4efc37394 100644 --- a/contrib/lisp/org-wikinodes.el +++ b/contrib/lisp/org-wikinodes.el @@ -9,12 +9,12 @@ ;; ;; This file is not part of GNU Emacs. ;; -;; GNU Emacs is free software: you can redistribute it and/or modify +;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. @@ -281,30 +281,29 @@ with working links." link file) (goto-char (point-min)) (while (re-search-forward re nil t) - (org-if-unprotected-at (match-beginning 0) - (unless (save-match-data - (or (org-at-heading-p) - (org-in-regexp org-bracket-link-regexp) - (org-in-regexp org-plain-link-re) - (org-in-regexp "<<[^<>]+>>"))) - (setq link (match-string 0)) - (delete-region (match-beginning 0) (match-end 0)) - (save-match-data - (cond - ((org-find-exact-headline-in-buffer link (current-buffer)) - ;; Found in current buffer - (insert (format "[[#%s][%s]]" link link))) - ((eq org-wikinodes-scope 'file) - ;; No match in file, and other files are not allowed - (insert (format "%s" link))) - ((setq file - (and (org-string-nw-p org-current-export-file) - (org-wikinodes-which-file - link (file-name-directory org-current-export-file)))) - ;; Match in another file in the current directory - (insert (format "[[file:%s::%s][%s]]" file link link))) - (t ;; No match for this link - (insert (format "%s" link)))))))))) + (unless (save-match-data + (or (org-at-heading-p) + (org-in-regexp org-bracket-link-regexp) + (org-in-regexp org-plain-link-re) + (org-in-regexp "<<[^<>]+>>"))) + (setq link (match-string 0)) + (delete-region (match-beginning 0) (match-end 0)) + (save-match-data + (cond + ((org-find-exact-headline-in-buffer link (current-buffer)) + ;; Found in current buffer + (insert (format "[[#%s][%s]]" link link))) + ((eq org-wikinodes-scope 'file) + ;; No match in file, and other files are not allowed + (insert (format "%s" link))) + ((setq file + (and (org-string-nw-p org-current-export-file) + (org-wikinodes-which-file + link (file-name-directory org-current-export-file)))) + ;; Match in another file in the current directory + (insert (format "[[file:%s::%s][%s]]" file link link))) + (t ;; No match for this link + (insert (format "%s" link))))))))) ;;; Hook the WikiNode mechanism into Org diff --git a/lisp/org-wl.el b/contrib/lisp/org-wl.el similarity index 97% rename from lisp/org-wl.el rename to contrib/lisp/org-wl.el index b755c023e..7d685df7c 100644 --- a/lisp/org-wl.el +++ b/contrib/lisp/org-wl.el @@ -7,14 +7,14 @@ ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org ;; -;; This file is part of GNU Emacs. +;; This file is not part of GNU Emacs. ;; -;; GNU Emacs is free software: you can redistribute it and/or modify +;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. @@ -46,13 +46,11 @@ (defcustom org-wl-link-remove-filter nil "Remove filter condition if message is filter folder." :group 'org-wl - :version "24.1" :type 'boolean) (defcustom org-wl-shimbun-prefer-web-links nil "If non-nil create web links for shimbun messages." :group 'org-wl - :version "24.1" :type 'boolean) (defcustom org-wl-nntp-prefer-web-links nil @@ -60,19 +58,16 @@ When folder name contains string \"gmane\" link to gmane, googlegroups otherwise." :type 'boolean - :version "24.1" :group 'org-wl) (defcustom org-wl-disable-folder-check t "Disable check for new messages when open a link." :type 'boolean - :version "24.1" :group 'org-wl) (defcustom org-wl-namazu-default-index nil "Default namazu search index." :type 'directory - :version "24.1" :group 'org-wl) ;; Declare external functions and variables diff --git a/contrib/lisp/org2rem.el b/contrib/lisp/org2rem.el deleted file mode 100644 index df8496bcb..000000000 --- a/contrib/lisp/org2rem.el +++ /dev/null @@ -1,651 +0,0 @@ -;;; org2rem.el --- Convert org appointments into reminders - -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. - -;; Author: Bastien Guerry and Shatad Pratap -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; Version: 6.09a -;; -;; This file is not part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; (require 'org2rem) -;; To export, do -;; -;; M-x org2rem-combine-agenda-files -;; -;; Then you can use reming like this: -;; -;; $ remind ~/org.rem -;; -;; If you want to use this regualrly, try in .emacs -;; -;; (add-hook 'org-mode-hook -;; (lambda() (add-hook 'after-save-hook -;; 'org-export-remind-all-agenda-files t t))) - -(require 'org) -(require 'org-agenda) -(require 'org-exp) -(eval-and-compile - (require 'cl)) - -(defgroup org2rem nil - "Options specific for Remind export of Org-mode files." - :tag "Org Export Remind" - :group 'org-export) - -(defcustom org-combined-agenda-remind-file "~/org.rem" - "The file name for the Remind file covering all agenda files. -This file is created with the command \\[org2rem-all-agenda-files]. -The file name should be absolute, the file will be overwritten without warning." - :group 'org2rem - :type 'file) - -(defcustom org-remind-combined-name "OrgMode" - "Calendar name for the combined Remind representing all agenda files." - :group 'org2rem - :type 'string) - -(defcustom org-remind-use-deadline '(event-if-not-todo todo-due) - "Contexts where Remind export should use a deadline time stamp. -This is a list with several symbols in it. Valid symbol are: - -event-if-todo Deadlines in TODO entries become calendar events. -event-if-not-todo Deadlines in non-TODO entries become calendar events. -todo-due Use deadlines in TODO entries as due-dates" - :group 'org2rem - :type '(set :greedy t - (const :tag "Deadlines in non-TODO entries become events" - event-if-not-todo) - (const :tag "Deadline in TODO entries become events" - event-if-todo) - (const :tag "Deadlines in TODO entries become due-dates" - todo-due))) - -(defcustom org-remind-use-scheduled '(todo-start) - "Contexts where Remind export should use a scheduling time stamp. -This is a list with several symbols in it. Valid symbol are: - -event-if-todo Scheduling time stamps in TODO entries become an event. -event-if-not-todo Scheduling time stamps in non-TODO entries become an event. -todo-start Scheduling time stamps in TODO entries become start date. - Some calendar applications show TODO entries only after - that date." - :group 'org2rem - :type '(set :greedy t - (const :tag - "SCHEDULED timestamps in non-TODO entries become events" - event-if-not-todo) - (const :tag "SCHEDULED timestamps in TODO entries become events" - event-if-todo) - (const :tag "SCHEDULED in TODO entries become start date" - todo-start))) - -(defcustom org-remind-categories '(local-tags category) - "Items that should be entered into the categories field. -This is a list of symbols, the following are valid: - -category The Org-mode category of the current file or tree -todo-state The todo state, if any -local-tags The tags, defined in the current line -all-tags All tags, including inherited ones." - :group 'org2rem - :type '(repeat - (choice - (const :tag "The file or tree category" category) - (const :tag "The TODO state" todo-state) - (const :tag "Tags defined in current line" local-tags) - (const :tag "All tags, including inherited ones" all-tags)))) - -(defcustom org-remind-include-todo nil - "Non-nil means export to remind files should also cover TODO items." - :group 'org2rem - :type '(choice - (const :tag "None" nil) - (const :tag "Unfinished" t) - (const :tag "All" all))) - -(defcustom org-remind-include-sexps t - "Non-nil means export to Remind files should also cover sexp entries. -These are entries like in the diary, but directly in an Org-mode file." - :group 'org2rem - :type 'boolean) - -(defcustom org-remind-deadline-over-scheduled t - "Non-nil means use deadline as target when both deadline and -scheduled present, vice-versa. Default is Non-nil." - :group 'org2rem - :type 'boolean) - -(defcustom org-remind-escape-percentage t - "Non-nil means % will be escaped, vice-versa. Default is Non-nil." - :group 'org2rem - :type 'boolean) - -(defcustom org-remind-extra-warn-days 3 - "Extra days Remind keep reminding." - :group 'org2rem - :type 'number) - -(defcustom org-remind-advanced-warn-days 3 - "Advanced days Remind start reminding." - :group 'org2rem - :type 'number) - -(defcustom org-remind-suppress-last-newline nil - "Non-nil means suppress last newline REM body. Default is nil." - :group 'org2rem - :type 'boolean) - -(defcustom org-remind-include-body 100 - "Amount of text below headline to be included in Remind export. -This is a number of characters that should maximally be included. -Properties, scheduling and clocking lines will always be removed. -The text will be inserted into the DESCRIPTION field." - :group 'org2rem - :type '(choice - (const :tag "Nothing" nil) - (const :tag "Everything" t) - (integer :tag "Max characters"))) - -(defcustom org-remind-store-UID nil - "Non-nil means store any created UIDs in properties. -The Remind standard requires that all entries have a unique identifyer. -Org will create these identifiers as needed. When this variable is non-nil, -the created UIDs will be stored in the ID property of the entry. Then the -next time this entry is exported, it will be exported with the same UID, -superceeding the previous form of it. This is essential for -synchronization services. -This variable is not turned on by default because we want to avoid creating -a property drawer in every entry if people are only playing with this feature, -or if they are only using it locally." - :group 'org2rem - :type 'boolean) - -;;;; Exporting - -;;; Remind export - -;;;###autoload -(defun org2rem-this-file () - "Export current file as an Remind file. -The Remind file will be located in the same directory as the Org-mode -file, but with extension `.rem'." - (interactive) - (org2rem nil buffer-file-name)) - -;;;###autoload -(defun org2rem-all-agenda-files () - "Export all files in `org-agenda-files' to Remind .rem files. -Each Remind file will be located in the same directory as the Org-mode -file, but with extension `.rem'." - (interactive) - (apply 'org2rem nil (org-agenda-files t))) - -;;;###autoload -(defun org2rem-combine-agenda-files () - "Export all files in `org-agenda-files' to a single combined Remind file. -The file is stored under the name `org-combined-agenda-remind-file'." - (interactive) - (apply 'org2rem t (org-agenda-files t))) - -(defun org2rem (combine &rest files) - "Create Remind files for all elements of FILES. -If COMBINE is non-nil, combine all calendar entries into a single large -file and store it under the name `org-combined-agenda-remind-file'." - (save-excursion - (org-agenda-prepare-buffers files) - (let* ((dir (org-export-directory - :ical (list :publishing-directory - org-export-publishing-directory))) - file rem-file rem-buffer category started org-agenda-new-buffers) - (and (get-buffer "*rem-tmp*") (kill-buffer "*rem-tmp*")) - (when combine - (setq rem-file - (if (file-name-absolute-p org-combined-agenda-remind-file) - org-combined-agenda-remind-file - (expand-file-name org-combined-agenda-remind-file dir)) - rem-buffer (org-get-agenda-file-buffer rem-file)) - (set-buffer rem-buffer) (erase-buffer)) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (set-buffer (org-get-agenda-file-buffer file)) - (unless combine - (setq rem-file (concat (file-name-as-directory dir) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".rem")) - (setq rem-buffer (org-get-agenda-file-buffer rem-file)) - (with-current-buffer rem-buffer (erase-buffer))) - (setq category (or org-category - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)))) - (if (symbolp category) (setq category (symbol-name category))) - (let ((standard-output rem-buffer)) - (if combine - (and (not started) (setq started t) - (org-start-remind-file org-remind-combined-name)) - (org-start-remind-file category)) - (org-print-remind-entries combine) - (when (or (and combine (not files)) (not combine)) - (org-finish-remind-file) - (set-buffer rem-buffer) - (run-hooks 'org-before-save-Remind-file-hook) - (save-buffer) - (run-hooks 'org-after-save-Remind-file-hook) - (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)) - )))) - (org-release-buffers org-agenda-new-buffers)))) - -(defvar org-before-save-Remind-file-hook nil - "Hook run before an Remind file has been saved. -This can be used to modify the result of the export.") - -(defvar org-after-save-Remind-file-hook nil - "Hook run after an Remind file has been saved. -The Remind buffer is still current when this hook is run. -A good way to use this is to tell a desktop calenndar application to re-read -the Remind file.") - -(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el -(defun org-print-remind-entries (&optional combine) - "Print Remind entries for the current Org-mode file to `standard-output'. -When COMBINE is non nil, add the category to each line." - (require 'org-agenda) - (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) - (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) - (dts (org-rem-ts-to-string - (format-time-string (cdr org-time-stamp-formats) (current-time)) - "start time:")) - hd ts ts2 state status (inc t) pos b sexp rrule - scheduledp deadlinep todo prefix due start - tmp pri categories entry location summary desc uid - remind-aw remind-ew (org-rem-ew org-remind-extra-warn-days) - (org-rem-aw org-remind-advanced-warn-days) - trigger diff-days (dos org-remind-deadline-over-scheduled) - (suppress-last-newline org-remind-suppress-last-newline) - (sexp-buffer (get-buffer-create "*rem-tmp*"))) - (org-refresh-category-properties) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re1 nil t) - (catch :skip - (org-agenda-skip) - (when (boundp 'org-remind-verify-function) - (unless (funcall org-remind-verify-function) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq pos (match-beginning 0) - ts (match-string 0) - inc t - hd (condition-case nil - (org-remind-cleanup-string - (org-get-heading)) - (error (throw :skip nil))) - summary (org-remind-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-remind-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-remind-include-body (org-get-entry))) - t org-remind-include-body) - location (org-remind-cleanup-string - (org-entry-get nil "LOCATION")) - uid (if org-remind-store-UID - (org-id-get-create) - (or (org-id-get) (org-id-new))) - categories (org-export-get-remind-categories) - deadlinep nil scheduledp nil) - (if (looking-at re2) - (progn - (goto-char (match-end 0)) - (setq ts2 (match-string 1) - inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2)))) - (setq tmp (buffer-substring (max (point-min) - (- pos org-ds-keyword-length)) - pos) - ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) - (progn - (setq inc nil) - (replace-match "\\1" t nil ts)) - ts) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - todo (org-get-todo-state) - ;; donep (org-entry-is-done-p) - )) - (when (and - deadlinep - (if todo - (not (memq 'event-if-todo org-remind-use-deadline)) - (not (memq 'event-if-not-todo org-remind-use-deadline)))) - (throw :skip t)) - (when (and - scheduledp - (if todo - (not (memq 'event-if-todo org-remind-use-scheduled)) - (not (memq 'event-if-not-todo org-remind-use-scheduled)))) - (throw :skip t)) - (setq prefix (if deadlinep "DEADLINE-" (if scheduledp "SCHEDULED-" "TS-"))) - (if (or (string-match org-tr-regexp hd) - (string-match org-ts-regexp hd)) - (setq hd (replace-match "" t t hd))) - (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts) - (setq rrule ;is recurrence value. later give it good name. - (* (string-to-number - (cdr (assoc - (match-string 2 ts) - '(("d" . "1")("w" . "7") - ("m" . "0")("y" . "0"))))) - (string-to-number (match-string 1 ts)))) - (setq rrule nil)) - (setq summary (or summary hd)) - (if (string-match org-bracket-link-regexp summary) - (setq summary - (replace-match (if (match-end 3) - (match-string 3 summary) - (match-string 1 summary)) - t t summary))) - (if deadlinep (setq summary (concat "DEADLINE: " summary))) - (if scheduledp (setq summary (concat "SCHEDULED: " summary))) - (if (string-match "\\`<%%" ts) - (with-current-buffer sexp-buffer - (insert (substring ts 1 -1) " " summary "\n")) - (princ (format "\n## BEGIN:EVENT -## UID: %s -REM %s %s MSG EVENT:%s%s %s%s%% -## CATEGORIES:%s -## END:EVENT\n" - (concat prefix uid) - (org-rem-ts-to-string ts nil nil rrule) - (org-rem-ts-to-string ts2 "UNTIL " inc) - summary - (if (and desc (string-match "\\S-" desc)) - (concat "%_\\\n" desc) "") - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - (if suppress-last-newline "" "%_") - categories))))) - - (when (and org-remind-include-sexps - (condition-case nil (require 'remind) (error nil)) - (fboundp 'remind-export-region)) - ;; Get all the literal sexps - (goto-char (point-min)) - (while (re-search-forward "^&?%%(" nil t) - (catch :skip - (org-agenda-skip) - (setq b (match-beginning 0)) - (goto-char (1- (match-end 0))) - (forward-sexp 1) - (end-of-line 1) - (setq sexp (buffer-substring b (point))) - (with-current-buffer sexp-buffer - (insert sexp "\n")))) - ;; (princ (org-diary-to-rem-string sexp-buffer)) - (kill-buffer sexp-buffer)) - - (when org-remind-include-todo - (setq prefix "TODO-") - (goto-char (point-min)) - (while (re-search-forward org-todo-line-regexp nil t) - (catch :skip - (org-agenda-skip) - (when (boundp 'org-remind-verify-function) - (unless (funcall org-remind-verify-function) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq state (match-string 2)) - (setq status (if (member state org-done-keywords) - "COMPLETED" "NEEDS-ACTION")) - (when (and state - (or (not (member state org-done-keywords)) - (eq org-remind-include-todo 'all)) - (not (member org-archive-tag (org-get-tags-at))) - ) - (setq hd (match-string 3) - summary (org-remind-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-remind-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-remind-include-body (org-get-entry))) - t org-remind-include-body) - location (org-remind-cleanup-string - (org-entry-get nil "LOCATION")) - due (and (member 'todo-due org-remind-use-deadline) - (org-entry-get nil "DEADLINE")) - start (and (member 'todo-start org-remind-use-scheduled) - (org-entry-get nil "SCHEDULED")) - categories (org-export-get-remind-categories) - uid (if org-remind-store-UID - (org-id-get-create) - (or (org-id-get) (org-id-new)))) - - (if (and due start) - (setq diff-days (org-rem-time-diff-days due start))) - - (setq remind-aw - (if due - (if diff-days - (if (> diff-days 0) - (if dos diff-days 0) - (if dos 0 diff-days)) - 1000))) - - (if (and (numberp org-rem-aw) (> org-rem-aw 0)) - (setq remind-aw (+ (or remind-aw 0) org-rem-aw))) - - (setq remind-ew - (if due - (if diff-days - (if (> diff-days 0) due nil) - due))) - - (setq trigger (if dos (if due due start) (if start start due))) - ;; (and trigger (setq trigger (org-rem-ts-to-string trigger nil nil 1 remind-aw))) - (if trigger - (setq trigger (concat - (format "[trigger('%s')] *%d " - (org-rem-ts-to-remind-date-type trigger) 1) - (if remind-aw (format "++%d" remind-aw))))) - (and due (setq due (org-rem-ts-to-remind-date-type due))) - (and start (setq start (org-rem-ts-to-remind-date-type start))) - (and remind-ew (setq remind-ew (org-rem-ts-to-remind-date-type remind-ew))) - - (if (string-match org-bracket-link-regexp hd) - (setq hd (replace-match (if (match-end 3) (match-string 3 hd) - (match-string 1 hd)) - t t hd))) - (if (string-match org-priority-regexp hd) - (setq pri (string-to-char (match-string 2 hd)) - hd (concat (substring hd 0 (match-beginning 1)) - (substring hd (match-end 1)))) - (setq pri org-default-priority)) - (setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri)) - (- org-lowest-priority org-highest-priority)))))) - - (princ (format "\n## BEGIN:TODO -## UID: %s -REM %s %s %s MSG TODO: %s%s%s%s%s%s%% -## CATEGORIES:%s -## SEQUENCE:1 -## STATUS:%s -## END:TODO\n" - (concat prefix uid) - (or trigger "") ;; dts) - (if remind-ew (format "UNTIL [trigger('%s' + %d)]" remind-ew (or org-rem-ew 0)) "") - (if pri (format "PRIORITY %d" pri) "") - (or summary hd) - (if (and desc (string-match "\\S-" desc)) - (concat "%_\\\nDESCRIPTION: " desc) "") - (if (and location (string-match "\\S-" location)) - (concat "LOCATION: " location) "") - (if start - (concat - "%_\\\n['" start "' - today()] " - "days over, for scheduled date - " - "[trigger('" start "')]") "") - (if due - (concat - "%_\\\n[today() - '" due "'] " - "days left, to deadline date - " - "[trigger('" due "')]") "") - (if suppress-last-newline "" "%_") - categories - status))))))))) - -(defun org-export-get-remind-categories () - "Get categories according to `org-remind-categories'." - (let ((cs org-remind-categories) c rtn tmp) - (while (setq c (pop cs)) - (cond - ((eq c 'category) (push (org-get-category) rtn)) - ((eq c 'todo-state) - (setq tmp (org-get-todo-state)) - (and tmp (push tmp rtn))) - ((eq c 'local-tags) - (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn))) - ((eq c 'all-tags) - (setq rtn (append (nreverse (org-get-tags-at (point))) rtn))))) - (mapconcat 'identity (nreverse rtn) ","))) - -(defun org-remind-cleanup-string (s &optional is-body maxlength) - "Take out stuff and quote what needs to be quoted. -When IS-BODY is non-nil, assume that this is the body of an item, clean up -whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH -characters." - (if (or (not s) (string-match "^[ \t\n]*$" s)) - nil - (when is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s))))) - (if org-remind-escape-percentage - (let ((start 0)) - (while (string-match "\\([%]\\)" s start) - (setq start (+ (match-beginning 0) 2) - s (replace-match "\\1\\1" nil nil s))))) - - (let ((start 0)) - (while (string-match "\\([\n]\\)" s start) - (setq start (+ (match-beginning 0) 4) ;; less than 4 is not correct. - s (replace-match "%_\\\\\\1" nil nil s)))) - - (let ((start 0)) - (while (string-match "\\([[]\\)" s start) - (setq start (+ (match-beginning 0) 5) - s (replace-match (concat "\[" "\"" "\\1" "\"" "\]") nil nil s)))) - -;;; (when is-body -;;; (while (string-match "[ \t]*\n[ \t]*" s) -;;; (setq s (replace-match "%_" t t s)))) - - (setq s (org-trim s)) - (if is-body - (if maxlength - (if (and (numberp maxlength) - (> (length s) maxlength)) - (setq s (substring s 0 maxlength))))) - s)) - -(defun org-get-entry () - "Clean-up description string." - (save-excursion - (org-back-to-heading t) - (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) - -(defun org-start-remind-file (name) - "Start an Remind file by inserting the header." - (let ((user user-full-name) - (name (or name "unknown")) - (timezone (cadr (current-time-zone)))) - (princ - (format "# -*- Mode: shell-script; auto-fill-mode: nil -*- -## BEGIN: Reminders -## VERSION:2.0 -## Emacs with Org-mode -## Calendar:%s -## Created by: %s -## Timezone:%s -## Calscale:Gregorian\n" name user timezone)))) - -(defun org-finish-remind-file () - "Finish an Remind file by inserting the END statement." - (princ "\n## END:Reminders\n")) - -(defun org-rem-ts-to-remind-date-type (s) - (format-time-string - "%Y-%m-%d" - (apply 'encode-time (butlast (org-parse-time-string s) 3)))) - -;; (defun org-rem-date-type-to-string (s keyword &optional inc day-repeat day-advance-warn) -;; (if trigger -;; (setq trigger -;; (concat -;; (format "[trigger('%s')] *%d " -;; (org-rem-ts-to-remind-date-type trigger) day-repeat) -;; (if day-advance-warn (format "++%d" day-advance-warn)))))) - -;; (format-time-string "%Y" -;; (apply 'encode-time (butlast (org-parse-time-string "<2008-11-20 Thu 10:30>") 3))) - -(defun org-rem-ts-to-string (s keyword &optional inc day-repeat day-advance-warn) - "Take a time string S and convert it to Remind format. -KEYWORD is added in front, to make a complete line like DTSTART.... -When INC is non-nil, increase the hour by two (if time string contains -a time), or the day by one (if it does not contain a time)." - (let ((t1 (org-parse-time-string s 'nodefault)) - t2 fmt have-time time) - (if (and (car t1) (nth 1 t1) (nth 2 t1)) - (setq t2 t1 have-time t) - (setq t2 (org-parse-time-string s))) - (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) - (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) - (when inc - (if have-time - (if org-agenda-default-appointment-duration - (setq mi (+ org-agenda-default-appointment-duration mi)) - (setq h (+ 2 h))) - (setq d (1+ d)))) - (setq time (encode-time s mi h d m y))) - (setq fmt (concat - "%d %b %Y" - (if day-advance-warn (format " ++%d" day-advance-warn)) - (if day-repeat (format " *%d" day-repeat)) - (if have-time " AT %H:%M"))) - (concat keyword (format-time-string fmt time)))) - -(defun org-rem-time-diff-days (end start) - (floor (/ (apply '- (mapcar - (lambda (s) - (let* - ((t1 (org-parse-time-string s)) - (s (car t1)) (mi (nth 1 t1)) - (h (nth 2 t1)) (d (nth 3 t1)) - (m (nth 4 t1)) (y (nth 5 t1))) - (float-time (encode-time s mi h d m y)))) - (list end start))) (* 24 60 60)))) - -(provide 'org2rem) - -;;; org-exp.el ends here diff --git a/contrib/lisp/orgtbl-sqlinsert.el b/contrib/lisp/orgtbl-sqlinsert.el index 880944fb7..f07a0ba3e 100644 --- a/contrib/lisp/orgtbl-sqlinsert.el +++ b/contrib/lisp/orgtbl-sqlinsert.el @@ -5,6 +5,8 @@ ;; Author: Jason Riedy ;; Keywords: org, tables, sql +;; This file is not part of GNU Emacs. + ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or diff --git a/contrib/lisp/ox-confluence.el b/contrib/lisp/ox-confluence.el new file mode 100644 index 000000000..5e01e1ed6 --- /dev/null +++ b/contrib/lisp/ox-confluence.el @@ -0,0 +1,191 @@ +;;; ox-confluence --- Confluence Wiki Back-End for Org Export Engine + +;; Copyright (C) 2012 Sébastien Delafond + +;; Author: Sébastien Delafond +;; Keywords: outlines, confluence, wiki + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; ox-confluence.el lets you convert Org files to confluence files +;; using the ox.el export engine. +;; +;; Put this file into your load-path and the following into your ~/.emacs: +;; (require 'ox-confluence) +;; +;; Export Org files to confluence: +;; M-x org-confluence-export-as-confluence RET +;; +;;; Code: + +(require 'ox) +(require 'ox-ascii) + +;; Define the backend itself +(org-export-define-derived-backend 'confluence 'ascii + :translate-alist '((bold . org-confluence-bold) + (example-block . org-confluence-example-block) + (fixed-width . org-confluence-fixed-width) + (footnote-definition . org-confluence-empty) + (footnote-reference . org-confluence-empty) + (headline . org-confluence-headline) + (italic . org-confluence-italic) + (link . org-confluence-link) + (section . org-confluence-section) + (src-block . org-confluence-src-block) + (strike-through . org-confluence-strike-through) + (table . org-confluence-table) + (table-cell . org-confluence-table-cell) + (table-row . org-confluence-table-row) + (template . org-confluence-template) + (underline . org-confluence-underline))) + +;; All the functions we use +(defun org-confluence-bold (bold contents info) + (format "*%s*" contents)) + +(defun org-confluence-empty (empty contents info) + "") + +(defun org-confluence-example-block (example-block contents info) + ;; FIXME: provide a user-controlled variable for theme + (let ((content (org-export-format-code-default example-block info))) + (org-confluence--block "none" "Confluence" content))) + +(defun org-confluence-italic (italic contents info) + (format "_%s_" contents)) + +(defun org-confluence-fixed-width (fixed-width contents info) + (format "\{\{%s\}\}" contents)) + +(defun org-confluence-headline (headline contents info) + (let ((low-level-rank (org-export-low-level-p headline info)) + (text (org-export-data (org-element-property :title headline) + info)) + (level (org-export-get-relative-level headline info))) + ;; Else: Standard headline. + (format "h%s. %s\n%s" level text + (if (org-string-nw-p contents) contents + "")))) + +(defun org-confluence-link (link desc info) + (let ((raw-link (org-element-property :raw-link link))) + (concat "[" + (when (org-string-nw-p desc) (format "%s|" desc)) + (cond + ((string-match "^confluence:" raw-link) + (replace-regexp-in-string "^confluence:" "" raw-link)) + (t + raw-link)) + "]"))) +(defun org-confluence-section (section contents info) + contents) + +(defun org-confluence-src-block (src-block contents info) + ;; FIXME: provide a user-controlled variable for theme + (let* ((lang (org-element-property :language src-block)) + (language (if (string= lang "sh") "bash" ;; FIXME: provide a mapping of some sort + lang)) + (content (org-export-format-code-default src-block info))) + (org-confluence--block language "Emacs" content))) + +(defun org-confluence-strike-through (strike-through contents info) + (format "-%s-" contents)) + +(defun org-confluence-table (table contents info) + contents) + +(defun org-confluence-table-row (table-row contents info) + (concat + (if (org-string-nw-p contents) (format "|%s" contents) + "") + (when (org-export-table-row-ends-header-p table-row info) + "|"))) + +(defun org-confluence-table-cell (table-cell contents info) + (let ((table-row (org-export-get-parent table-cell))) + (concat + (when (org-export-table-row-starts-header-p table-row info) + "|") + contents "|"))) + +(defun org-confluence-template (contents info) + (let ((depth (plist-get info :with-toc))) + (concat (when depth "\{toc\}\n\n") contents))) + +(defun org-confluence-underline (underline contents info) + (format "+%s+" contents)) + +(defun org-confluence--block (language theme contents) + (concat "\{code:theme=" theme + (when language (format "|language=%s" language)) + "}\n" + contents + "\{code\}\n")) + +;; main interactive entrypoint +(defun org-confluence-export-as-confluence + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a text buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, strip title, table +of contents and footnote definitions from output. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org E-Confluence Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (if async + (org-export-async-start + (lambda (output) + (with-current-buffer (get-buffer-create "*Org E-Confluence Export*") + (erase-buffer) + (insert output) + (goto-char (point-min)) + (text-mode) + (org-export-add-to-stack (current-buffer) 'confluence))) + `(org-export-as 'confluence ,subtreep ,visible-only ,body-only + ',ext-plist)) + (let ((outbuf (org-export-to-buffer + 'confluence "*Org E-Confluence Export*" + subtreep visible-only body-only ext-plist))) + (with-current-buffer outbuf (text-mode)) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window outbuf))))) + +(provide 'ox-confluence) diff --git a/contrib/lisp/ox-deck.el b/contrib/lisp/ox-deck.el new file mode 100644 index 000000000..6338643b4 --- /dev/null +++ b/contrib/lisp/ox-deck.el @@ -0,0 +1,590 @@ +;;; ox-deck.el --- deck.js Presentation Back-End for Org Export Engine + +;; Copyright (C) 2013 Rick Frankel + +;; Author: Rick Frankel +;; Keywords: outlines, hypermedia, slideshow + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This library implements a deck.js presentation back-end for the Org +;; generic exporter. + +;; Installation +;; ------------- +;; Get a copy of deck.js from http://imakewebthings.com/deck.js/ or +;; the gitub repository at https://github.com/imakewebthings/deck.js. +;; +;; Add the path to the extracted code to the variable +;; `org-deck-directories' There are a number of customization in the +;; org-export-deck group, most of which can be overrriden with buffer +;; local customization (starting with DECK_.) + +;; See ox.el and ox-html.el for more details on how this exporter +;; works (it is derived from ox-html.) + +(require 'ox-html) +(eval-when-compile (require 'cl)) + +(org-export-define-derived-backend 'deck 'html + :menu-entry + '(?d "Export to deck.js HTML Presentation" + ((?H "To temporary buffer" org-deck-export-as-html) + (?h "To file" org-deck-export-to-html) + (?o "To file and open" + (lambda (a s v b) + (if a (org-deck-export-to-html t s v b) + (org-open-file (org-deck-export-to-html nil s v b))))))) + :options-alist + '((:html-link-home "HTML_LINK_HOME" nil nil) + (:html-link-up "HTML_LINK_UP" nil nil) + (:deck-postamble "DECK_POSTAMBLE" nil org-deck-postamble newline) + (:deck-preamble "DECK_PREAMBLE" nil org-deck-preamble newline) + (:html-head-include-default-style "HTML_INCLUDE_DEFAULT_STYLE" nil nil) + (:html-head-include-scripts "HTML_INCLUDE_SCRIPTS" nil nil) + (:deck-base-url "DECK_BASE_URL" nil org-deck-base-url) + (:deck-theme "DECK_THEME" nil org-deck-theme) + (:deck-transition "DECK_TRANSITION" nil org-deck-transition) + (:deck-include-extensions "DECK_INCLUDE_EXTENSIONS" nil + org-deck-include-extensions split) + (:deck-exclude-extensions "DECK_EXCLUDE_EXTENSIONS" nil + org-deck-exclude-extensions split)) + :translate-alist + '((headline . org-deck-headline) + (inner-template . org-deck-inner-template) + (item . org-deck-item) + (template . org-deck-template))) + +(defgroup org-export-deck nil + "Options for exporting Org mode files to deck.js HTML Presentations." + :tag "Org Export DECK" + :group 'org-export-html) + +(defcustom org-deck-directories '("./deck.js") + "Directories to search for deck.js components (jquery, +modernizr; core, extensions and themes directories.)" + :group 'org-export-deck + :type '(repeat (string :tag "Directory"))) + +(defun org-deck--cleanup-components (components) + (remove-duplicates + (car (remove 'nil components)) + :test (lambda (x y) + (string= (file-name-nondirectory x) + (file-name-nondirectory y))))) + +(defun org-deck--find-extensions () + "Returns a unique list of all extensions found in +in the extensions directories under `org-deck-directories'" + (org-deck--cleanup-components + (mapcar ; extensions under existing dirs + (lambda (dir) + (when (file-directory-p dir) (directory-files dir t "^[^.]"))) + (mapcar ; possible extension directories + (lambda (x) (expand-file-name "extensions" x)) + org-deck-directories)))) + +(defun org-deck--find-css (type) + "Return a unique list of all the css stylesheets in the themes/TYPE +directories under `org-deck-directories'." + (org-deck--cleanup-components + (mapcar + (lambda (dir) + (let ((css-dir (expand-file-name + (concat (file-name-as-directory "themes") type) dir))) + (when (file-directory-p css-dir) + (directory-files css-dir t "\\.css$")))) + org-deck-directories))) + +(defun org-deck-list-components () + "List all available deck extensions, styles and +transitions (with full paths) to a temporary buffer." + (interactive) + (let ((outbuf (get-buffer-create "*deck.js Extensions*"))) + (with-current-buffer outbuf + (erase-buffer) + (insert "Extensions\n----------\n") + (insert (mapconcat 'identity (org-deck--find-extensions) "\n")) + (insert "\n\nStyles\n------\n") + (insert (mapconcat 'identity (org-deck--find-css "style") "\n")) + (insert "\n\nTransitions\n----------\n") + (insert (mapconcat 'identity (org-deck--find-css "transition") "\n"))) + (switch-to-buffer-other-window outbuf))) + +(defcustom org-deck-include-extensions nil + "If non-nil, list of extensions to include instead of all available. +Can be overriden or set with the DECK_INCLUDE_EXTENSIONS property. +During output generation, the extensions found by +`org-deck--find-extensions' are searched for the appropriate +files (scripts and/or stylesheets) to include in the generated +html. The href/src attributes are created relative to `org-deck-base-url'." + :group 'org-export-deck + :type '(repeat (string :tag "Extension"))) + +(defcustom org-deck-exclude-extensions nil + "If non-nil, list of extensions to exclude. +Can be overriden or set with the DECK_EXCLUDE_EXTENSIONS property." + :group 'org-export-deck + :type '(repeat (string :tag "Extension"))) + +(defcustom org-deck-theme "swiss.css" + "deck.js theme. Can be overriden with the DECK_THEME property. +If this value contains a path component (\"/\"), it is used as a +literal path (url). Otherwise it is prepended with +`org-deck-base-url'/themes/style/." + :group 'org-export-deck + :type 'string) + +(defcustom org-deck-transition "fade.css" + "deck.js transition theme. Can be overriden with the +DECK_TRANSITION property. +If this value contains a path component (\"/\"), it is used as a +literal path (url). Otherwise it is prepended with +`org-deck-base-url'/themes/transition/." + :group 'org-export-deck + :type 'string) + +(defcustom org-deck-base-url "deck.js" + "Url prefix to deck.js base directory containing the core, extensions +and themes directories. +Can be overriden with the DECK_BASE_URL property." + :group 'org-export-deck + :type 'string) + +(defvar org-deck-pre/postamble-styles + `((both "left: 5px; width: 100%;") + (preamble "position: absolute; top: 10px;") + (postamble "")) + "Alist of css styles for the preamble, postamble and both respectively. +Can be overriden in `org-deck-styles'. See also `org-html-divs'.") + +(defcustom org-deck-postamble "

    %a - %t

    " + "Non-nil means insert a postamble in HTML export. + +When set to a string, use this string +as the postamble. When t, insert a string as defined by the +formatting string in `org-html-postamble-format'. + +When set to a function, apply this function and insert the +returned string. The function takes the property list of export +options as its only argument. + +This is included in the document at the bottom of the content +section, and uses the postamble element and id from +`org-html-divs'. The default places the author and presentation +title at the bottom of each slide. + +The css styling is controlled by `org-deck-pre/postamble-styles'. + +Setting :deck-postamble in publishing projects will take +precedence over this variable." + :group 'org-export-deck + :type '(choice (const :tag "No postamble" nil) + (const :tag "Default formatting string" t) + (string :tag "Custom formatting string") + (function :tag "Function (must return a string)"))) + +(defcustom org-deck-preamble nil + "Non-nil means insert a preamble in HTML export. + +When set to a string, use this string +as the preamble. When t, insert a string as defined by the +formatting string in `org-html-preamble-format'. + +When set to a function, apply this function and insert the +returned string. The function takes the property list of export +options as its only argument. + +This is included in the document at the top of content section, and +uses the preamble element and id from `org-html-divs'. The css +styling is controlled by `org-deck-pre/postamble-styles'. + +Setting :deck-preamble in publishing projects will take +precedence over this variable." + :group 'org-export-deck + :type '(choice (const :tag "No preamble" nil) + (const :tag "Default formatting string" t) + (string :tag "Custom formatting string") + (function :tag "Function (must return a string)"))) + +(defvar org-deck-toc-styles + (mapconcat + 'identity + (list + "#table-of-contents a {color: inherit;}" + "#table-of-contents ul {margin-bottom: 0;}" + "#table-of-contents li {padding: 0;}") "\n") + "Default css styles used for formatting a table of contents slide. +Can be overriden in `org-deck-styles'. +Note that when the headline numbering option is true, a \"list-style: none\" +is automatically added to avoid both numbers and bullets on the toc entries.") + +(defcustom org-deck-styles + " +#title-slide h1 { + position: static; padding: 0; + margin-top: 10%; + -webkit-transform: none; + -moz-transform: none; + -ms-transform: none; + -o-transform: none; + transform: none; +} +#title-slide h2 { + text-align: center; + border:none; + padding: 0; + margin: 0; +}" + "Deck specific CSS styles to include in exported html. +Defaults to styles for the title page." + :group 'org-export-deck + :type 'string) + +(defcustom org-deck-title-slide-template + "

    %t

    +

    %a

    +

    %e

    +

    %d

    " + "Format template to specify title page section. +See `org-html-postamble-format' for the valid elements which +can be included. + +It will be wrapped in the element defined in the :html-container +property, and defaults to the value of `org-html-container-element', +and have the id \"title-slide\"." + :group 'org-export-deck + :type 'string) + +(defun org-deck-toc (depth info) + (concat + (format "<%s id='table-of-contents' class='slide'>\n" + (plist-get info :html-container)) + (format "

    %s

    \n" (org-html--translate "Table of Contents" info)) + (org-html--toc-text + (mapcar + (lambda (headline) + (let* ((class (org-element-property :HTML_CONTAINER_CLASS headline)) + (section-number + (when + (and (not (org-export-low-level-p headline info)) + (org-export-numbered-headline-p headline info)) + (concat + (mapconcat + 'number-to-string + (org-export-get-headline-number headline info) ".") ". "))) + (title + (concat + section-number + (replace-regexp-in-string ; remove any links in headline... + "]*>" "" + (org-export-data + (org-element-property :title headline) info))))) + (cons + (if (and class (string-match-p "\\" class)) + (format + "%s" + (or (org-element-property :CUSTOM_ID headline) + (mapconcat + 'number-to-string + (org-export-get-headline-number headline info) "-")) + title) + title) + (org-export-get-relative-level headline info)))) + (org-export-collect-headlines info depth))) + (format "\n" (plist-get info :html-container)))) + +(defun org-deck--get-packages (info) + (let ((prefix (concat (plist-get info :deck-base-url) "/")) + (theme (plist-get info :deck-theme)) + (transition (plist-get info :deck-transition)) + (include (plist-get info :deck-include-extensions)) + (exclude (plist-get info :deck-exclude-extensions)) + (scripts '()) (sheets '()) (snippets '())) + (add-to-list 'scripts (concat prefix "jquery-1.7.2.min.js")) + (add-to-list 'scripts (concat prefix "core/deck.core.js")) + (add-to-list 'scripts (concat prefix "modernizr.custom.js")) + (add-to-list 'sheets (concat prefix "core/deck.core.css")) + (mapc + (lambda (extdir) + (let* ((name (file-name-nondirectory extdir)) + (dir (file-name-as-directory extdir)) + (path (concat prefix "extensions/" name "/")) + (base (format "deck.%s." name))) + (when (and (or (eq nil include) (member name include)) + (not (member name exclude))) + (when (file-exists-p (concat dir base "js")) + (add-to-list 'scripts (concat path base "js"))) + (when (file-exists-p (concat dir base "css")) + (add-to-list 'sheets (concat path base "css"))) + (when (file-exists-p (concat dir base "html")) + (add-to-list 'snippets (concat dir base "html")))))) + (org-deck--find-extensions)) + (if (not (string-match-p "^[[:space:]]*$" theme)) + (add-to-list 'sheets + (if (file-name-directory theme) theme + (format "%sthemes/style/%s" prefix theme)))) + (if (not (string-match-p "^[[:space:]]*$" transition)) + (add-to-list + 'sheets + (if (file-name-directory transition) transition + (format "%sthemes/transition/%s" prefix transition)))) + (list :scripts (nreverse scripts) :sheets (nreverse sheets) + :snippets snippets))) + +(defun org-deck-inner-template (contents info) + "Return body of document string after HTML conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (concat contents "\n")) + +(defun org-deck-headline (headline contents info) + (let ((org-html-toplevel-hlevel 2) + (class (or (org-element-property :HTML_CONTAINER_CLASS headline) "")) + (level (org-export-get-relative-level headline info))) + (when (and (= 1 level) (not (string-match-p "\\" class))) + (org-element-put-property headline :HTML_CONTAINER_CLASS (concat class " slide"))) + (org-html-headline headline contents info))) + +(defun org-deck-item (item contents info) + "Transcode an ITEM element from Org to HTML. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information. +If the containing headline has the property :slide, then +the \"slide\" class will be added to the to the list element, + which will make the list into a \"build\"." + (let ((text (org-html-item item contents info))) + (if (org-export-get-node-property :STEP item t) + (replace-regexp-in-string "^
  • " "
  • " text) + text))) + +(defun org-deck-template (contents info) + "Return complete document string after HTML conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (let ((pkg-info (org-deck--get-packages info)) + (org-html--pre/postamble-class "deck-status") + (info (plist-put + (plist-put info :html-preamble (plist-get info :deck-preamble)) + :html-postamble (plist-get info :deck-postamble)))) + (mapconcat + 'identity + (list + (plist-get info :html-doctype) + (let ((lang (plist-get info :language))) + (mapconcat + (lambda (x) + (apply + 'format + "" + x)) + (list `("[if lt IE 7]>" "class='no-js ie6'" ,lang "") + `("[if IE 7]>" "class='no-js ie7'" ,lang "") + `("[if IE 8]>" "class='no-js ie8'" ,lang "") + `("[if gt IE 8]>" "" ,lang "" + (mapconcat + (lambda (list) + (format + (concat + "") + dir (nth 0 list) (nth 1 list) (nth 2 list))) + (list + '("outline.css" "screen" "outlineStyle") + '("print.css" "print" "slidePrint") + '("opera.css" "projection" "operaFix")) "\n") + (format (concat + "") + (if (string-match-p "^\\(http\\|/\\)" theme) theme + (concat dir "/" theme))) + "" + (concat + "")) "\n"))) + +(defun org-s5--build-meta-info (info) + (concat + (org-html--build-meta-info info) + (format "\n" + (plist-get info :s5-version)) + (format "\n" + (plist-get info :s5-default-view)) + (format "" + (plist-get info :s5-control-visibility)))) + +(defun org-s5-headline (headline contents info) + (let ((org-html-toplevel-hlevel 1) + (class (or (org-element-property :HTML_CONTAINER_CLASS headline) "")) + (level (org-export-get-relative-level headline info))) + (when (and (= 1 level) (not (string-match-p "\\" class))) + (org-element-put-property headline :HTML_CONTAINER_CLASS (concat class " slide"))) + (org-html-headline headline contents info))) + +(defun org-s5-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to HTML. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information. +If a containing headline has the property :INCREMENTAL, +then the \"incremental\" class will be added to the to the list, +which will make the list into a \"build\"." + (let* ((type (org-element-property :type plain-list)) + (tag (case type + (ordered "ol") + (unordered "ul") + (descriptive "dl")))) + (format "%s\n%s%s" + (format + "<%s class='org-%s%s'>" tag tag + (if (org-export-get-node-property :INCREMENTAL plain-list t) + " incremental" "")) + contents (org-html-end-plain-list type)))) + +(defun org-s5-inner-template (contents info) + "Return body of document string after HTML conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (concat contents "\n")) + +(defun org-s5-template (contents info) + "Return complete document string after HTML conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (let ((org-html-divs + (if (equal (plist-get info :html-container) "li") + (append '((content "ol" "content")) org-s5--divs) + org-s5--divs)) + (info (plist-put + (plist-put info :html-preamble (plist-get info :s5-preamble)) + :html-postamble (plist-get info :s5-postamble)))) + (mapconcat + 'identity + (list + (plist-get info :html-doctype) + (format "" + (plist-get info :language) (plist-get info :language)) + "" + (org-s5--build-meta-info info) + (org-s5--build-head info) + (org-html--build-head info) + (org-html--build-mathjax-config info) + "" + "" + "
    " + "
    " + "
    " + (org-html--build-pre/postamble 'preamble info) + (org-html--build-pre/postamble 'postamble info) + "
    " + (format "<%s id=\"%s\" class=\"presentation\">" + (nth 1 (assq 'content org-html-divs)) + (nth 2 (assq 'content org-html-divs))) + ;; title page + (format "<%s id='title-slide' class='slide'>" + (plist-get info :html-container)) + (format-spec org-s5-title-slide-template (org-html-format-spec info)) + (format "" (plist-get info :html-container)) + ;; table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth (org-s5-toc depth info))) + contents + (format "" (nth 1 (assq 'content org-html-divs))) + "" + "\n") "\n"))) + +(defun org-s5-export-as-html + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to an HTML buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\" and \"\" tags. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org S5 Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (if async + (org-export-async-start + (lambda (output) + (with-current-buffer (get-buffer-create "*Org S5 Export*") + (erase-buffer) + (insert output) + (goto-char (point-min)) + (nxml-mode) + (org-export-add-to-stack (current-buffer) 's5))) + `(org-export-as 's5 ,subtreep ,visible-only ,body-only ',ext-plist)) + (let ((outbuf (org-export-to-buffer + 's5 "*Org S5 Export*" + subtreep visible-only body-only ext-plist))) + ;; Set major mode. + (with-current-buffer outbuf (nxml-mode)) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window outbuf))))) + +(defun org-s5-export-to-html + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a S5 HTML file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\" and \"\" tags. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let* ((extension (concat "." org-html-extension)) + (file (org-export-output-file-name extension subtreep)) + (org-export-coding-system org-html-coding-system)) + (if async + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 's5)) + (let ((org-export-coding-system org-html-coding-system)) + `(expand-file-name + (org-export-to-file + 's5 ,file ,subtreep ,visible-only ,body-only ',ext-plist)))) + (let ((org-export-coding-system org-html-coding-system)) + (org-export-to-file + 's5 file subtreep visible-only body-only ext-plist))))) + +(defun org-s5-publish-to-html (plist filename pub-dir) + "Publish an org file to S5 HTML Presentation. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 's5 filename ".html" plist pub-dir)) + +(provide 'ox-s5) + +;;; ox-s5.el ends here diff --git a/contrib/lisp/ox-taskjuggler.el b/contrib/lisp/ox-taskjuggler.el new file mode 100644 index 000000000..16f0e8d2d --- /dev/null +++ b/contrib/lisp/ox-taskjuggler.el @@ -0,0 +1,904 @@ +;;; ox-taskjuggler.el --- TaskJuggler Back-End for Org Export Engine +;; +;; Copyright (C) 2007-2013 Free Software Foundation, Inc. +;; +;; Emacs Lisp Archive Entry +;; Filename: ox-taskjuggler.el +;; Author: Christian Egli +;; Nicolas Goaziou +;; Maintainer: Christian Egli +;; Keywords: org, taskjuggler, project planning +;; Description: Converts an Org mode buffer into a TaskJuggler project plan + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: +;; +;; This library implements a TaskJuggler exporter for Org mode. +;; TaskJuggler is a project planing tool that uses a text format to +;; define projects, tasks and resources, so it is a natural fit for +;; Org mode. It can produce all sorts of reports for tasks or +;; resources in either HTML, CSV or PDF. TaskJuggler is implemented +;; in Ruby and should therefore run on any platform. +;; +;; The exporter does not export all the nodes of a document or +;; strictly follow the order of the nodes in the document. +;; +;; Instead the TaskJuggler exporter looks for a tree that defines the +;; tasks and a optionally tree that defines the resources for this +;; project. It then creates a TaskJuggler file based on these trees +;; and the attributes defined in all the nodes. +;; +;; * Installation +;; +;; Put this file into your load-path and the following line into your +;; ~/.emacs: +;; +;; (add-to-list 'org-export-backends 'taskjuggler) +;; +;; or customize `org-export-backends' variable. +;; +;; The interactive functions are the following: +;; +;; M-x `org-taskjuggler-export' +;; M-x `org-taskjuggler-export-and-open' +;; +;; * Tasks +;; +;; Let's illustrate the usage with a small example. Create your tasks +;; as you usually do with org-mode. Assign efforts to each task using +;; properties (it's easiest to do this in the column view). You +;; should end up with something similar to the example by Peter Jones +;; in: +;; +;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org. +;; +;; Now mark the top node of your tasks with a tag named +;; "taskjuggler_project" (or whatever you customized +;; `org-taskjuggler-project-tag' to). You are now ready to export the +;; project plan with `org-taskjuggler-export-and-open' which will +;; export the project plan and open a Gantt chart in TaskJugglerUI. +;; +;; * Resources +;; +;; Next you can define resources and assign those to work on specific +;; tasks. You can group your resources hierarchically. Tag the top +;; node of the resources with "taskjuggler_resource" (or whatever you +;; customized `org-taskjuggler-resource-tag' to). You can optionally +;; assign an identifier (named "resource_id") to the resources (using +;; the standard org properties commands) or you can let the exporter +;; generate identifiers automatically (the exporter picks the first +;; word of the headline as the identifier as long as it is unique, see +;; the documentation of `org-taskjuggler--build-unique-id'). Using that +;; identifier you can then allocate resources to tasks. This is again +;; done with the "allocate" property on the tasks. Do this in column +;; view or when on the task type +;; +;; C-c C-x p allocate RET RET +;; +;; Once the allocations are done you can again export to TaskJuggler +;; and check in the Resource Allocation Graph which person is working +;; on what task at what time. +;; +;; * Export of properties +;; +;; The exporter also takes TODO state information into consideration, +;; i.e. if a task is marked as done it will have the corresponding +;; attribute in TaskJuggler ("complete 100"). Also it will export any +;; property on a task resource or resource node which is known to +;; TaskJuggler, such as limits, vacation, shift, booking, efficiency, +;; journalentry, rate for resources or account, start, note, duration, +;; end, journalentry, milestone, reference, responsible, scheduling, +;; etc for tasks. +;; +;; * Dependencies +;; +;; The exporter will handle dependencies that are defined in the tasks +;; either with the ORDERED attribute (see TODO dependencies in the Org +;; mode manual) or with the BLOCKER attribute (see org-depend.el) or +;; alternatively with a depends attribute. Both the BLOCKER and the +;; depends attribute can be either "previous-sibling" or a reference +;; to an identifier (named "task_id") which is defined for another +;; task in the project. BLOCKER and the depends attribute can define +;; multiple dependencies separated by either space or comma. You can +;; also specify optional attributes on the dependency by simply +;; appending it. The following examples should illustrate this: +;; +;; * Training material +;; :PROPERTIES: +;; :task_id: training_material +;; :ORDERED: t +;; :END: +;; ** Markup Guidelines +;; :PROPERTIES: +;; :Effort: 2d +;; :END: +;; ** Workflow Guidelines +;; :PROPERTIES: +;; :Effort: 2d +;; :END: +;; * Presentation +;; :PROPERTIES: +;; :Effort: 2d +;; :BLOCKER: training_material { gapduration 1d } some_other_task +;; :END: +;; +;;;; * TODO +;; - Look at org-file-properties, org-global-properties and +;; org-global-properties-fixed +;; - What about property inheritance and org-property-inherit-p? +;; - Use TYPE_TODO as an way to assign resources +;; +;;; Code: + +(eval-when-compile (require 'cl)) + +(require 'ox) + + + +;;; User Variables + +(defgroup org-export-taskjuggler nil + "Options specific for TaskJuggler export back-end." + :tag "Org Export TaskJuggler" + :group 'org-export) + +(defcustom org-taskjuggler-extension ".tjp" + "Extension of TaskJuggler files." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-taskjuggler-project-tag "taskjuggler_project" + "Tag marking project's tasks. +This tag is used to find the tree containing all the tasks for +the project." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-taskjuggler-resource-tag "taskjuggler_resource" + "Tag marking project's resources. +This tag is used to find the tree containing all the resources +for the project." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-taskjuggler-report-tag "taskjuggler_report" + "Tag marking project's reports. +This tag is used to find the tree containing all the reports for +the project." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-taskjuggler-target-version 3.0 + "Which version of TaskJuggler the exporter is targeting. +By default a project plan is exported which conforms to version +3.x of TaskJuggler. For a project plan that is compatible with +versions of TaskJuggler older than 3.0 set this to 2.4. + +If you change this variable be sure to also change +`org-taskjuggler-default-reports' as the format of reports has +changed considerably between version 2.x and 3.x of TaskJuggler" + :group 'org-export-taskjuggler + :type 'number) + +(defcustom org-taskjuggler-default-project-version "1.0" + "Default version string for the project. +This value can also be set with the \":VERSION:\" property +associated to the headline defining the project." + :group 'org-export-taskjuggler + :type 'string) + +(defcustom org-taskjuggler-default-project-duration 280 + "Default project duration. +The value will be used if no start and end date have been defined +in the root node of the task tree, i.e. the tree that has been +marked with `org-taskjuggler-project-tag'" + :group 'org-export-taskjuggler + :type 'integer) + +(defcustom org-taskjuggler-default-reports + '("textreport report \"Plan\" { + formats html + header '== <-query attribute=\"name\"-> ==' + + center -8<- + [#Plan Plan] | [#Resource_Allocation Resource Allocation] + ---- + === Plan === + <[report id=\"plan\"]> + ---- + === Resource Allocation === + <[report id=\"resourceGraph\"]> + ->8- +} + +# A traditional Gantt chart with a project overview. +taskreport plan \"\" { + headline \"Project Plan\" + columns bsi, name, start, end, effort, chart + loadunit shortauto + hideresource 1 +} + +# A graph showing resource allocation. It identifies whether each +# resource is under- or over-allocated for. +resourcereport resourceGraph \"\" { + headline \"Resource Allocation Graph\" + columns no, name, effort, weekly + loadunit shortauto + hidetask ~(isleaf() & isleaf_()) + sorttasks plan.start.up +}") + "Default reports for the project. +These are sensible default reports to give a good out-of-the-box +result when exporting without defining any reports. If you want +to define your own reports you can change them here or simply +define the default reports so that they include an external +report definition as follows: + +include reports.tji + +These default are made to work with tj3. If you are targeting +TaskJuggler 2.4 (see `org-taskjuggler-target-version') please +change these defaults to something like the following: + +taskreport \"Gantt Chart\" { + headline \"Project Gantt Chart\" + columns hierarchindex, name, start, end, effort, duration, completed, chart + timeformat \"%Y-%m-%d\" + hideresource 1 + loadunit shortauto +} + +resourcereport \"Resource Graph\" { + headline \"Resource Allocation Graph\" + columns no, name, utilization, freeload, chart + loadunit shortauto + sorttasks startup + hidetask ~isleaf() +}" + :group 'org-export-taskjuggler + :type '(repeat (string :tag "Report"))) + +(defcustom org-taskjuggler-default-global-header "" + "Default global header for the project. +This goes before project declaration, and might be useful for +early macros." + :group 'org-export-taskjuggler + :type '(string :tag "Preamble")) + +(defcustom org-taskjuggler-default-global-properties + "shift s40 \"Part time shift\" { + workinghours wed, thu, fri off +} +" + "Default global properties for the project. + +Here you typically define global properties such as shifts, +accounts, rates, vacation, macros and flags. Any property that +is allowed within the TaskJuggler file can be inserted. You +could for example include another TaskJuggler file. + +The global properties are inserted after the project declaration +but before any resource and task declarations." + :group 'org-export-taskjuggler + :type '(string :tag "Preamble")) + +(defcustom org-taskjuggler-valid-task-attributes + '(account start note duration endbuffer endcredit end + flags journalentry length limits maxend maxstart minend + minstart period reference responsible scheduling + startbuffer startcredit statusnote chargeset charge) + "Valid attributes for Taskjuggler tasks. +If one of these appears as a property for a headline, it will be +exported with the corresponding task." + :group 'org-export-taskjuggler) + +(defcustom org-taskjuggler-valid-resource-attributes + '(limits vacation shift booking efficiency journalentry rate + workinghours flags) + "Valid attributes for Taskjuggler resources. +If one of these appears as a property for a headline, it will be +exported with the corresponding resource." + :group 'org-export-taskjuggler) + +(defcustom org-taskjuggler-valid-report-attributes + '(headline columns definitions timeformat hideresource hidetask + loadunit sorttasks formats period) + "Valid attributes for Taskjuggler reports. +If one of these appears as a property for a headline, it will be +exported with the corresponding report." + :group 'org-export-taskjuggler) + +(defcustom org-taskjuggler-keep-project-as-task t + "Non-nil keeps the project headline as an umbrella task for all tasks. +Setting this to nil will allow maintaining completely separated +task buckets, while still sharing the same resources pool." + :group 'org-export-taskjuggler + :type 'boolean) + + + +;;; Hooks + +(defvar org-taskjuggler-final-hook nil + "Hook run after a TaskJuggler files has been saved. +This hook is run with the name of the file as argument.") + + + +;;; Back-End Definition + +(org-export-define-backend 'taskjuggler + '((template . org-taskjuggler-project-plan)) + :menu-entry + '(?J "Export to TaskJuggler" + ((?j "As TJP file" (lambda (a s v b) (org-taskjuggler-export a s v))) + (?o "As TJP file and open" + (lambda (a s v b) + (if a (org-taskjuggler-export a s v) + (org-taskjuggler-export-and-open s v)))))) + ;; This property will be used to store unique ids in communication + ;; channel. Ids will be retrieved with `org-taskjuggler-get-id'. + :options-alist '((:taskjuggler-unique-ids nil nil nil))) + + + +;;; Unique IDs + +(defun org-taskjuggler-assign-task-ids (tasks info) + "Assign a unique ID to each task in TASKS. +TASKS is a list of headlines. INFO is a plist used as a +communication channel. Return value is an alist between +headlines and their associated ID. IDs are hierarchical, which +means they only need to be unique among the task siblings." + (let* (alist + (build-id + (lambda (tasks local-ids) + (org-element-map tasks 'headline + (lambda (task) + (let ((id (org-taskjuggler--build-unique-id task local-ids))) + (push id local-ids) + (push (cons task id) alist) + (funcall build-id (org-element-contents task) nil))) + info nil 'headline)))) + (funcall build-id tasks nil) + alist)) + +(defun org-taskjuggler-assign-resource-ids (resources info) + "Assign a unique ID to each resource within RESOURCES. +RESOURCES is a list of headlines. INFO is a plist used as a +communication channel. Return value is an alist between +headlines and their associated ID." + (let (ids) + (org-element-map resources 'headline + (lambda (resource) + (let ((id (org-taskjuggler--build-unique-id resource ids))) + (push id ids) + (cons resource id))) + info))) + + + +;;; Accessors + +(defun org-taskjuggler-get-project (info) + "Return project in parse tree. +INFO is a plist used as a communication channel. First headline +in buffer with `org-taskjuggler-project-tag' defines the project. +If no such task is defined, pick the first headline in buffer. +If there is no headline at all, return nil." + (or (org-element-map (plist-get info :parse-tree) 'headline + (lambda (hl) + (and (member org-taskjuggler-project-tag + (org-export-get-tags hl info)) + hl)) + info t) + (org-element-map tree 'headline 'identity info t))) + +(defun org-taskjuggler-get-id (item info) + "Return id for task or resource ITEM. +ITEM is a headline. INFO is a plist used as a communication +channel. Return value is a string." + (cdr (assq item (plist-get info :taskjuggler-unique-ids)))) + +(defun org-taskjuggler-get-name (item) + "Return name for task or resource ITEM. +ITEM is a headline. Return value is a string." + ;; Quote double quotes in name. + (replace-regexp-in-string + "\"" "\\\"" (org-element-property :raw-value item) t t)) + +(defun org-taskjuggler-get-start (item) + "Return start date for task or resource ITEM. +ITEM is a headline. Return value is a string or nil if ITEM +doesn't have any start date defined.." + (let ((scheduled (org-element-property :scheduled item))) + (and scheduled (org-timestamp-format scheduled "%Y-%02m-%02d")))) + +(defun org-taskjuggler-get-end (item) + "Return end date for task or resource ITEM. +ITEM is a headline. Return value is a string or nil if ITEM +doesn't have any end date defined.." + (let ((deadline (org-element-property :deadline item))) + (and deadline (org-timestamp-format deadline "%Y-%02m-%02d")))) + + + +;;; Internal Functions + +(defun org-taskjuggler--indent-string (s) + "Indent string S by 2 spaces. +Return new string. If S is the empty string, return it." + (if (equal "" s) s (replace-regexp-in-string "^ *\\S-" " \\&" s))) + +(defun org-taskjuggler--build-attributes (item attributes) + "Return attributes string for task, resource or report ITEM. +ITEM is a headline. ATTRIBUTES is a list of symbols +representing valid attributes for ITEM." + (mapconcat + (lambda (attribute) + (let ((value (org-element-property + (intern (upcase (format ":%s" attribute))) + item))) + (and value (format "%s %s\n" attribute value)))) + (remq nil attributes) "")) + +(defun org-taskjuggler--build-unique-id (item unique-ids) + "Return a unique id for a given task or a resource. +ITEM is an `headline' type element representing the task or +resource. Its id is derived from its name and made unique +against UNIQUE-IDS. If the (downcased) first token of the +headline is not unique try to add more (downcased) tokens of the +headline or finally add more underscore characters (\"_\")." + (let ((id (org-string-nw-p (org-element-property :TASK_ID item)))) + ;; If an id is specified, use it, as long as it's unique. + (if (and id (not (member id unique-ids))) id + (let* ((parts (org-split-string (org-element-property :raw-value item))) + (id (org-taskjuggler--clean-id (downcase (pop parts))))) + ;; Try to add more parts of the headline to make it unique. + (while (and (car parts) (member id unique-ids)) + (setq id (concat id "_" + (org-taskjuggler--clean-id (downcase (pop parts)))))) + ;; If it's still not unique, add "_". + (while (member id unique-ids) + (setq id (concat id "_"))) + id)))) + +(defun org-taskjuggler--clean-id (id) + "Clean and return ID to make it acceptable for TaskJuggler. +ID is a string." + ;; Replace non-ascii by "_". + (replace-regexp-in-string + "[^a-zA-Z0-9_]" "_" + ;; Make sure id doesn't start with a number. + (replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id))) + + + +;;; Dependencies + +(defun org-taskjuggler-resolve-dependencies (task info) + "Return a list of all tasks TASK depends on. +TASK is a headline. INFO is a plist used as a communication +channel." + (let ((deps-ids + ;; Get all dependencies specified in BLOCKER and DEPENDS task + ;; properties. Clean options from them. + (let ((deps (concat (org-element-property :BLOCKER task) + (org-element-property :DEPENDS task)))) + (and deps + (org-split-string (replace-regexp-in-string "{.*?}" "" deps) + "[ ,]* +")))) + depends) + (when deps-ids + ;; Find tasks with :task_id: property matching id in DEPS-IDS. + ;; Add them to DEPENDS. + (let* ((project (org-taskjuggler-get-project info)) + (tasks (if org-taskjuggler-keep-project-as-task project + (org-element-contents project)))) + (setq depends + (org-element-map tasks 'headline + (lambda (task) + (let ((task-id (org-element-property :TASK_ID task))) + (and task-id (member task-id deps-ids) task))) + info))) + ;; Check BLOCKER and DEPENDS properties. If "previous-sibling" + ;; belongs to DEPS-ID, add it to DEPENDS. + (when (and (member-ignore-case "previous-sibling" deps-ids) + (not (org-export-first-sibling-p task info))) + (let ((prev (org-export-get-previous-element task info))) + (and (not (memq prev depends)) (push prev depends))))) + ;; Check ORDERED status of parent. + (let ((parent (org-export-get-parent task))) + (when (and parent + (org-element-property :ORDERED parent) + (not (org-export-first-sibling-p task info))) + (push (org-export-get-previous-element task info) depends))) + ;; Return dependencies. + depends)) + +(defun org-taskjuggler-format-dependencies (dependencies task info) + "Format DEPENDENCIES to match TaskJuggler syntax. +DEPENDENCIES is list of dependencies for TASK, as returned by +`org-taskjuggler-resolve-depedencies'. TASK is a headline. +INFO is a plist used as a communication channel. Return value +doesn't include leading \"depends\"." + (let ((dep-str (concat (org-element-property :BLOCKER task) + " " + (org-element-property :DEPENDS task))) + (get-path + (lambda (dep) + ;; Return path to DEP relatively to TASK. + (let ((parent (org-export-get-parent dep)) + (exclamations 1) + (option + (let ((id (org-element-property :TASK_ID dep))) + (and id + (string-match (concat id " +\\({.*?}\\)") dep-str) + (org-match-string-no-properties 1)))) + path) + ;; Compute number of exclamation marks by looking for the + ;; common ancestor between TASK and DEP. + (while (not (org-element-map parent 'headline + (lambda (hl) (eq hl task)))) + (incf exclamations) + (setq parent (org-export-get-parent parent))) + ;; Build path from DEP to PARENT. + (while (not (eq parent dep)) + (push (org-taskjuggler-get-id dep info) path) + (setq dep (org-export-get-parent dep))) + ;; Return full path. Add dependency options, if any. + (concat (make-string exclamations ?!) + (mapconcat 'identity path ".") + (and option (concat " " option))))))) + ;; Return dependencies string, without the leading "depends". + (mapconcat (lambda (dep) (funcall get-path dep)) dependencies ", "))) + + + +;;; Translator Functions + +(defun org-taskjuggler-project-plan (contents info) + "Build TaskJuggler project plan. +CONTENTS is ignored. INFO is a plist holding export options. +Return complete project plan as a string in TaskJuggler syntax." + (let* ((tree (plist-get info :parse-tree)) + (project (or (org-taskjuggler-get-project info) + (error "No project specified")))) + (concat + ;; 1. Insert header. + (org-element-normalize-string org-taskjuggler-default-global-header) + ;; 2. Insert project. + (org-taskjuggler--build-project project info) + ;; 3. Insert global properties. + (org-element-normalize-string org-taskjuggler-default-global-properties) + ;; 4. Insert resources. Provide a default one if none is + ;; specified. + (let ((main-resources + ;; Collect contents from various trees marked with + ;; `org-taskjuggler-resource-tag'. Only gather top level + ;; resources. + (apply 'append + (org-element-map tree 'headline + (lambda (hl) + (and (member org-taskjuggler-resource-tag + (org-export-get-tags hl info)) + (org-element-map (org-element-contents hl) 'headline + 'identity info nil 'headline))) + info nil 'headline)))) + ;; Assign a unique ID to each resource. Store it under + ;; `:taskjuggler-unique-ids' property in INFO. + (setq info + (plist-put info :taskjuggler-unique-ids + (org-taskjuggler-assign-resource-ids + main-resources info))) + (concat + (if main-resources + (mapconcat + (lambda (resource) (org-taskjuggler--build-resource resource info)) + main-resources "") + (format "resource %s \"%s\" {\n}\n" (user-login-name) user-full-name)) + ;; 5. Insert tasks. + (let ((main-tasks + ;; If `org-taskjuggler-keep-project-as-task' is + ;; non-nil, there is only one task. Otherwise, every + ;; direct children of PROJECT is a top level task. + (if org-taskjuggler-keep-project-as-task (list project) + (or (org-element-map (org-element-contents project) 'headline + 'identity info nil 'headline) + (error "No task specified"))))) + ;; Assign a unique ID to each task. Add it to + ;; `:taskjuggler-unique-ids' property in INFO. + (setq info + (plist-put info :taskjuggler-unique-ids + (append + (org-taskjuggler-assign-task-ids main-tasks info) + (plist-get info :taskjuggler-unique-ids)))) + ;; If no resource is allocated among tasks, allocate one to + ;; the first task. + (unless (org-element-map main-tasks 'headline + (lambda (task) (org-element-property :ALLOCATE task)) + info t) + (org-element-put-property + (car main-tasks) :ALLOCATE + (or (org-taskjuggler-get-id (car main-resources) info) + (user-login-name)))) + (mapconcat + (lambda (task) (org-taskjuggler--build-task task info)) + main-tasks "")) + ;; 6. Insert reports. If no report is defined, insert default + ;; reports. + (let ((main-reports + ;; Collect contents from various trees marked with + ;; `org-taskjuggler-report-tag'. Only gather top level + ;; reports. + (apply 'append + (org-element-map tree 'headline + (lambda (hl) + (and (member org-taskjuggler-report-tag + (org-export-get-tags hl info)) + (org-element-map (org-element-contents hl) + 'headline 'identity info nil 'headline))) + info nil 'headline)))) + (if main-reports + (mapconcat + (lambda (report) (org-taskjuggler--build-report report info)) + main-reports "") + (mapconcat 'org-element-normalize-string + org-taskjuggler-default-reports "")))))))) + +(defun org-taskjuggler--build-project (project info) + "Return a project declaration. +PROJECT is a headline. INFO is a plist used as a communication +channel. If no start date is specified, start today. If no end +date is specified, end `org-taskjuggler-default-project-duration' +days from now." + (format "project %s \"%s\" \"%s\" %s %s {\n}\n" + (org-taskjuggler-get-id project info) + (org-taskjuggler-get-name project) + ;; Version is obtained through :TASKJUGGLER_VERSION: + ;; property or `org-taskjuggler-default-project-version'. + (or (org-element-property :VERSION project) + org-taskjuggler-default-project-version) + (or (org-taskjuggler-get-start project) + (format-time-string "%Y-%m-%d")) + (let ((end (org-taskjuggler-get-end project))) + (or (and end (format "- %s" end)) + (format "+%sd" org-taskjuggler-default-project-duration))))) + +(defun org-taskjuggler--build-resource (resource info) + "Return a resource declaration. + +RESOURCE is a headline. INFO is a plist used as a communication +channel. + +All valid attributes from RESOURCE are inserted. If RESOURCE +defines a property \"resource_id\" it will be used as the id for +this resource. Otherwise it will use the ID property. If +neither is defined a unique id will be associated to it." + (concat + ;; Opening resource. + (format "resource %s \"%s\" {\n" + (org-taskjuggler--clean-id + (or (org-element-property :RESOURCE_ID resource) + (org-element-property :ID resource) + (org-taskjuggler-get-id resource info))) + (org-taskjuggler-get-name resource)) + ;; Add attributes. + (org-taskjuggler--indent-string + (org-taskjuggler--build-attributes + resource org-taskjuggler-valid-resource-attributes)) + ;; Add inner resources. + (org-taskjuggler--indent-string + (mapconcat + 'identity + (org-element-map (org-element-contents resource) 'headline + (lambda (hl) (org-taskjuggler--build-resource hl info)) + info nil 'headline) + "")) + ;; Closing resource. + "}\n")) + +(defun org-taskjuggler--build-report (report info) + "Return a report declaration. +REPORT is a headline. INFO is a plist used as a communication +channel." + (concat + ;; Opening report. + (format "%s \"%s\" {\n" + (or (org-element-property :REPORT_KIND report) "taskreport") + (org-taskjuggler-get-name report)) + ;; Add attributes. + (org-taskjuggler--indent-string + (org-taskjuggler--build-attributes + report org-taskjuggler-valid-report-attributes)) + ;; Add inner reports. + (org-taskjuggler--indent-string + (mapconcat + 'identity + (org-element-map (org-element-contents report) 'headline + (lambda (hl) (org-taskjuggler--build-report hl info)) + info nil 'headline) + "")) + ;; Closing report. + "}\n")) + +(defun org-taskjuggler--build-task (task info) + "Return a task declaration. + +TASK is a headline. INFO is a plist used as a communication +channel. + +All valid attributes from TASK are inserted. If TASK defines +a property \"task_id\" it will be used as the id for this task. +Otherwise it will use the ID property. If neither is defined +a unique id will be associated to it." + (let* ((allocate (org-element-property :ALLOCATE task)) + (complete + (if (eq (org-element-property :todo-type task) 'done) "100" + (org-element-property :COMPLETE task))) + (depends (org-taskjuggler-resolve-dependencies task info)) + (effort (org-element-property :EFFORT task)) + (milestone + (or (org-element-property :MILESTONE task) + (not (or (org-element-map (org-element-contents task) 'headline + 'identity info t) ; Has task any child? + effort + (org-element-property :LENGTH task) + (org-element-property :DURATION task) + (and (org-taskjuggler-get-start task) + (org-taskjuggler-get-end task)) + (org-element-property :PERIOD task))))) + (priority + (let ((pri (org-element-property :priority task))) + (and pri + (max 1 (/ (* 1000 (- org-lowest-priority pri)) + (- org-lowest-priority org-highest-priority))))))) + (concat + ;; Opening task. + (format "task %s \"%s\" {\n" + (org-taskjuggler-get-id task info) + (org-taskjuggler-get-name task)) + ;; Add default attributes. + (and depends + (format " depends %s\n" + (org-taskjuggler-format-dependencies depends task info))) + (and allocate + (format " purge %s\n allocate %s\n" + ;; Compatibility for previous TaskJuggler versions. + (if (>= org-taskjuggler-target-version 3.0) "allocate" + "allocations") + allocate)) + (and complete (format " complete %s\n" complete)) + (and effort + (format " effort %s\n" + (let* ((minutes (org-duration-string-to-minutes effort)) + (hours (/ minutes 60.0))) + (format "%.1fh" hours)))) + (and priority (format " priority %s\n" complete)) + (and milestone " milestone\n") + ;; Add other valid attributes. + (org-taskjuggler--indent-string + (org-taskjuggler--build-attributes + task org-taskjuggler-valid-task-attributes)) + ;; Add inner tasks. + (org-taskjuggler--indent-string + (mapconcat 'identity + (org-element-map (org-element-contents task) 'headline + (lambda (hl) (org-taskjuggler--build-task hl info)) + info nil 'headline) + "")) + ;; Closing task. + "}\n"))) + + + +;;; Interactive Functions + +;;;###autoload +(defun org-taskjuggler-export (&optional async subtreep visible-only) + "Export current buffer to a TaskJuggler file. + +The exporter looks for a tree with tag that matches +`org-taskjuggler-project-tag' and takes this as the tasks for +this project. The first node of this tree defines the project +properties such as project name and project period. + +If there is a tree with tag that matches +`org-taskjuggler-resource-tag' this tree is taken as resources +for the project. If no resources are specified, a default +resource is created and allocated to the project. + +Also the TaskJuggler project will be created with default reports +as defined in `org-taskjuggler-default-reports'. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Return output file's name." + (interactive) + (let ((outfile + (org-export-output-file-name org-taskjuggler-extension subtreep))) + (if async + (org-export-async-start + (lambda (f) + (org-export-add-to-stack f 'taskjuggler) + (run-hook-with-args 'org-taskjuggler-final-hook f)) + `(expand-file-name + (org-export-to-file 'taskjuggler ,outfile ,subtreep ,visible-only))) + (org-export-to-file 'taskjuggler outfile subtreep visible-only) + (run-hook-with-args 'org-taskjuggler-final-hook outfile) + outfile))) + +;;;###autoload +(defun org-taskjuggler-export-and-open (&optional subtreep visible-only) + "Export current buffer to a TaskJuggler file and open it. + +The exporter looks for a tree with tag that matches +`org-taskjuggler-project-tag' and takes this as the tasks for +this project. The first node of this tree defines the project +properties such as project name and project period. + +If there is a tree with tag that matches +`org-taskjuggler-resource-tag' this tree is taken as resources +for the project. If no resources are specified, a default +resource is created and allocated to the project. + +Also the TaskJuggler project will be created with default reports +as defined in `org-taskjuggler-default-reports'. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Open file with the TaskJuggler GUI." + (interactive) + (let* ((file (org-taskjuggler-export nil subtreep visible-only)) + (process-name "TaskJugglerUI") + (command (concat process-name " " file))) + (start-process-shell-command process-name nil command))) + + +(provide 'ox-taskjuggler) + +;; Local variables: +;; sentence-end-double-space: t +;; End: + +;;; ox-taskjuggler.el ends here diff --git a/contrib/scripts/x11idle.c b/contrib/scripts/x11idle.c new file mode 100644 index 000000000..22cefe1e6 --- /dev/null +++ b/contrib/scripts/x11idle.c @@ -0,0 +1,28 @@ +#include +#include + +/* Based on code from + * http://coderrr.wordpress.com/2008/04/20/getting-idle-time-in-unix/ + * + * compile with 'gcc -l Xss x11idle.c -o x11idle' and copy x11idle into your + * path + */ +main() { + XScreenSaverInfo *info = XScreenSaverAllocInfo(); + //open the display specified by the DISPLAY environment variable + Display *display = XOpenDisplay(0); + + //display could be null if there is no X server running + if (info == NULL || display == NULL) { + return -1; + } + + //X11 is running, try to retrieve info + if (XScreenSaverQueryInfo(display, DefaultRootWindow(display), info) == 0) { + return -1; + } + + //info was retrieved successfully, print idle time + printf("%lu\n", info->idle); + return 0; +} diff --git a/contrib/babel/library-of-babel.org b/doc/library-of-babel.org similarity index 100% rename from contrib/babel/library-of-babel.org rename to doc/library-of-babel.org diff --git a/doc/org.texi b/doc/org.texi index f7695e4d4..5ec0bc16b 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -11,11 +11,11 @@ @set txicodequotebacktick @c Version and Contact Info -@set MAINTAINERSITE @uref{http://orgmode.org,maintainers webpage} +@set MAINTAINERSITE @uref{http://orgmode.org,maintainers web page} @set AUTHOR Carsten Dominik -@set MAINTAINER Carsten Dominik -@set MAINTAINEREMAIL @email{carsten at orgmode dot org} -@set MAINTAINERCONTACT @uref{mailto:carsten at orgmode dot org,contact the maintainer} +@set MAINTAINER Bastien Guerry +@set MAINTAINEREMAIL @email{bzg at gnu dot org} +@set MAINTAINERCONTACT @uref{mailto:bzg at gnu dot org,contact the maintainer} @c %**end of header @finalout @@ -288,7 +288,8 @@ modify this GNU manual.'' @subtitle Release @value{VERSION} @author by Carsten Dominik -with contributions by David O'Toole, Bastien Guerry, Philip Rooke, Dan Davison, Eric Schulte, Thomas Dye and Jambunathan K. +with contributions by David O'Toole, Bastien Guerry, Philip Rooke, Dan +Davison, Eric Schulte, Thomas Dye, Jambunathan K and Nicolas Goaziou. @c The following two commands start the copyright page. @page @@ -321,7 +322,7 @@ with contributions by David O'Toole, Bastien Guerry, Philip Rooke, Dan Davison, * Capture - Refile - Archive:: The ins and outs for projects * Agenda Views:: Collecting information into views * Markup:: Prepare text for rich export -* Exporting:: Sharing and publishing of notes +* Exporting:: Sharing and publishing notes * Publishing:: Create a web site of linked Org files * Working With Source Code:: Export, evaluate, and tangle code blocks * Miscellaneous:: All the rest which did not fit elsewhere @@ -358,6 +359,18 @@ Document structure * Blocks:: Folding blocks * Footnotes:: How footnotes are defined in Org's syntax * Orgstruct mode:: Structure editing outside Org +* Org syntax:: Formal description of Org's syntax + +Visibility cycling + +* Global and local cycling:: Cycling through various visibility states +* Initial visibility:: Setting the initial visibility state +* Catching invisible edits:: Preventing mistakes when editing invisible parts + +Global and local cycling + +* Initial visibility:: Setting the initial visibility state +* Catching invisible edits:: Preventing mistakes when editing invisible parts Tables @@ -376,6 +389,7 @@ The spreadsheet * Durations and time values:: How to compute durations and time values * Field and range formulas:: Formula for specific (ranges of) fields * Column formulas:: Formulas valid for an entire column +* Lookup functions:: Lookup functions for searching tables * Editing and debugging formulas:: Fixing formulas * Updating the table:: Recomputing all dependent fields * Advanced features:: Field and column names, parameters and automatic recalc @@ -424,6 +438,7 @@ Tags * Tag inheritance:: Tags use the tree structure of the outline * Setting tags:: How to assign tags to a headline +* Tag groups:: Use one tag to search for several tags * Tag searches:: Searching for combinations of tags Properties and columns @@ -478,7 +493,7 @@ Capture - Refile - Archive * Attachments:: Add files to tasks * RSS Feeds:: Getting input from RSS feeds * Protocols:: External (e.g., Browser) access to Emacs and Org -* Refiling notes:: Moving a tree from one place to another +* Refile and copy:: Moving/copying a tree from one place to another * Archiving:: What to do with finished projects Capture @@ -522,7 +537,8 @@ Presentation and sorting * Categories:: Not all tasks are equal * Time-of-day specifications:: How the agenda knows the time -* Sorting of agenda items:: The order of things +* Sorting agenda items:: The order of things +* Filtering/limiting agenda items:: Dynamically narrow the agenda Custom agenda views @@ -533,19 +549,19 @@ Custom agenda views Markup for rich export * Structural markup elements:: The basic structure as seen by the exporter -* Images and tables:: Tables and Images will be included +* Images and tables:: Images, tables and caption mechanism * Literal examples:: Source code examples with special formatting * Include files:: Include additional files into a document * Index entries:: Making an index -* Macro replacement:: Use macros to create complex output +* Macro replacement:: Use macros to create templates * Embedded @LaTeX{}:: LaTeX can be freely used inside Org documents +* Special blocks:: Containers targeted at export back-ends Structural markup elements * Document title:: Where the title is taken from * Headings and sections:: The document structure as seen by the exporter * Table of contents:: The if and where of the table of contents -* Initial text:: Text before the first heading? * Lists:: Lists * Paragraphs:: Paragraphs * Footnote markup:: Footnotes @@ -563,18 +579,19 @@ Embedded @LaTeX{} Exporting -* Selective export:: Using tags to select and exclude trees -* Export options:: Per-file export settings -* The export dispatcher:: How to access exporter commands +* The Export Dispatcher:: The main exporter interface +* Export back-ends:: Built-in export formats +* Export settings:: Generic export settings * ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding +* Beamer export:: Exporting as a Beamer presentation * HTML export:: Exporting to HTML * @LaTeX{} and PDF export:: Exporting to @LaTeX{}, and processing to PDF -* DocBook export:: Exporting to DocBook +* Markdown export:: Exporting to Markdown * OpenDocument Text export:: Exporting to OpenDocument Text -* TaskJuggler export:: Exporting to TaskJuggler -* Freemind export:: Exporting to Freemind mind maps -* XOXO export:: Exporting to XOXO -* iCalendar export:: Exporting in iCalendar format +* iCalendar export:: Exporting to iCalendar +* Other built-in back-ends:: Exporting to @code{Texinfo}, a man page, or Org +* Export in foreign buffers:: Author tables in lists in Org syntax +* Advanced configuration:: Fine-tuning the export output HTML export @@ -591,21 +608,10 @@ HTML export @LaTeX{} and PDF export -* @LaTeX{}/PDF export commands:: +* @LaTeX{} export commands:: How to export to LaTeX and PDF * Header and sectioning:: Setting up the export file structure * Quoting @LaTeX{} code:: Incorporating literal @LaTeX{} code -* Tables in @LaTeX{} export:: Options for exporting tables to @LaTeX{} -* Images in @LaTeX{} export:: How to insert figures into @LaTeX{} output -* Beamer class export:: Turning the file into a presentation - -DocBook export - -* DocBook export commands:: How to invoke DocBook export -* Quoting DocBook code:: Incorporating DocBook code in Org files -* Recursive sections:: Recursive sections in DocBook -* Tables in DocBook export:: Tables are exported as HTML tables -* Images in DocBook export:: How to insert figures into DocBook output -* Special characters:: How to handle special characters +* @LaTeX{} specific attributes:: Controlling @LaTeX{} output OpenDocument Text export @@ -717,6 +723,7 @@ Specific header arguments * shebang:: Make tangled files executable * eval:: Limit evaluation of specific code blocks * wrap:: Mark source block evaluation results +* post:: Post processing of code block results Miscellaneous @@ -742,11 +749,13 @@ Hacking * Hooks:: How to reach into Org's internals * Add-on packages:: Available extensions * Adding hyperlink types:: New custom link types +* Adding export back-ends:: How to write new export back-ends * Context-sensitive commands:: How to add functionality to such commands * Tables in arbitrary syntax:: Orgtbl for @LaTeX{} and other programs * Dynamic blocks:: Automatically filled blocks * Special agenda views:: Customized views -* Extracting agenda information:: Postprocessing of agenda information +* Speeding up your agendas:: Tips on how to speed up your agendas +* Extracting agenda information:: Post-processing of agenda information * Using the property API:: Writing programs that use entry properties * Using the mapping API:: Mapping over all or selected entries @@ -755,7 +764,7 @@ Tables and lists in arbitrary syntax * Radio tables:: Sending and receiving radio tables * A @LaTeX{} example:: Step by step, almost a tutorial * Translator functions:: Copy and modify -* Radio lists:: Doing the same for lists +* Radio lists:: Sending and receiving lists MobileOrg @@ -795,7 +804,7 @@ timestamps, and scheduling. It dynamically compiles entries into an agenda that utilizes and smoothly integrates much of the Emacs calendar and diary. Plain text URL-like links connect to websites, emails, Usenet messages, BBDB entries, and any files related to the projects. -For printing and sharing of notes, an Org file can be exported as a +For printing and sharing notes, an Org file can be exported as a structured ASCII file, as HTML, or (TODO and agenda items only) as an iCalendar file. It can also serve as a publishing tool for a set of linked web pages. @@ -829,7 +838,7 @@ ends, for example: @pindex GTD, Getting Things Done @r{@bullet{} an environment in which to implement David Allen's GTD system} @r{@bullet{} a simple hypertext system, with HTML and @LaTeX{} export} -@r{@bullet{} a publishing tool to create a set of interlinked webpages} +@r{@bullet{} a publishing tool to create a set of interlinked web pages} @r{@bullet{} an environment for literate programming} @end example @@ -868,10 +877,11 @@ We @b{strongly recommend} to stick to a single installation method. Recent Emacs distributions include a packaging system which lets you install Elisp libraries. You can install Org with @kbd{M-x package-install RET org}. -To make sure your Org configuration is well taken into account, initialize -the package system with @code{(package-initialize)} before setting any Org -option. If you want to use Org's package repository, check out the -@uref{http://orgmode.org/elpa.html, Org ELPA page}. +You need to do this in a session where no @code{.org} file has been visited. +Then, to make sure your Org configuration is taken into account, initialize +the package system with @code{(package-initialize)} in your @file{.emacs} +before setting any Org option. If you want to use Org's package repository, +check out the @uref{http://orgmode.org/elpa.html, Org ELPA page}. @subsubheading Downloading Org as an archive @@ -879,17 +889,17 @@ You can download Org latest release from @uref{http://orgmode.org/, Org's website}. In this case, make sure you set the load-path correctly in your @file{.emacs}: -@example +@lisp (add-to-list 'load-path "~/path/to/orgdir/lisp") -@end example +@end lisp The downloaded archive contains contributed libraries that are not included in Emacs. If you want to use them, add the @file{contrib} directory to your load-path: -@example +@lisp (add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t) -@end example +@end lisp Optionally, you can compile the files and/or install them in your system. Run @code{make help} to list compilation and installation options. @@ -970,7 +980,7 @@ MY PROJECTS -*- mode: org; -*- @vindex org-insert-mode-line-in-empty-file @noindent which will select Org mode for this buffer no matter what the file's name is. See also the variable -@code{org-insert-mode-line-in-empty-file}. +@var{org-insert-mode-line-in-empty-file}. Many commands in Org work on the region if the region is @i{active}. To make use of this, you need to have @code{transient-mark-mode} @@ -1002,10 +1012,10 @@ version of Org available---if you are running an outdated version, it is quite possible that the bug has been fixed already. If the bug persists, prepare a report and provide as much information as possible, including the version information of Emacs (@kbd{M-x emacs-version @key{RET}}) and Org -(@kbd{M-x org-version @key{RET}}), as well as the Org related setup in +(@kbd{M-x org-version RET}), as well as the Org related setup in @file{.emacs}. The easiest way to do this is to use the command @example -@kbd{M-x org-submit-bug-report} +@kbd{M-x org-submit-bug-report RET} @end example @noindent which will put all this information into an Emacs mail buffer so that you only need to add your description. If you re not sending the Email @@ -1026,7 +1036,7 @@ is not necessary. In that case it is sufficient to start Emacs as @code{emacs -Q}. The @code{minimal-org.el} setup file can have contents as shown below. -@example +@lisp ;;; Minimal setup to load latest `org-mode' ;; activate debugging @@ -1037,7 +1047,7 @@ shown below. ;; add latest org-mode to load path (add-to-list 'load-path (expand-file-name "/path/to/org-mode/lisp")) (add-to-list 'load-path (expand-file-name "/path/to/org-mode/contrib/lisp" t)) -@end example +@end lisp If an error occurs, a backtrace can be very useful (see below on how to create one). Often a small example file helps, along with clear information @@ -1065,7 +1075,7 @@ Reload uncompiled versions of all Org mode Lisp files. The backtrace contains much more information if it is produced with uncompiled code. To do this, use @example -C-u M-x org-reload RET +@kbd{C-u M-x org-reload RET} @end example @noindent or select @code{Org -> Refresh/Reload -> Reload Org uncompiled} from the @@ -1153,6 +1163,7 @@ edit the structure of the document. * Blocks:: Folding blocks * Footnotes:: How footnotes are defined in Org's syntax * Orgstruct mode:: Structure editing outside Org +* Org syntax:: Formal description of Org's syntax @end menu @node Outlines, Headlines, Document Structure, Document Structure @@ -1179,8 +1190,8 @@ command, @command{org-cycle}, which is bound to the @key{TAB} key. Headlines define the structure of an outline tree. The headlines in Org start with one or more stars, on the left margin@footnote{See the variables -@code{org-special-ctrl-a/e}, @code{org-special-ctrl-k}, and -@code{org-ctrl-k-protect-subtree} to configure special behavior of @kbd{C-a}, +@var{org-special-ctrl-a/e}, @var{org-special-ctrl-k}, and +@var{org-ctrl-k-protect-subtree} to configure special behavior of @kbd{C-a}, @kbd{C-e}, and @kbd{C-k} in headlines.} @footnote{Clocking only works with headings indented less then 30 stars.}. For example: @@ -1204,7 +1215,7 @@ An empty line after the end of a subtree is considered part of it and will be hidden when the subtree is folded. However, if you leave at least two empty lines, one empty line will remain visible after folding the subtree, in order to structure the collapsed view. See the -variable @code{org-cycle-separator-lines} to modify this behavior. +variable @var{org-cycle-separator-lines} to modify this behavior. @node Visibility cycling, Motion, Headlines, Document Structure @section Visibility cycling @@ -1214,6 +1225,15 @@ variable @code{org-cycle-separator-lines} to modify this behavior. @cindex show hidden text @cindex hide text +@menu +* Global and local cycling:: Cycling through various visibility states +* Initial visibility:: Setting the initial visibility state +* Catching invisible edits:: Preventing mistakes when editing invisible parts +@end menu + +@node Global and local cycling, Initial visibility, Visibility cycling, Visibility cycling +@subsection Global and local cycling + Outlines make it possible to hide parts of the text in the buffer. Org uses just two commands, bound to @key{TAB} and @kbd{S-@key{TAB}} to change the visibility in the buffer. @@ -1235,10 +1255,10 @@ Org uses just two commands, bound to @key{TAB} and @vindex org-cycle-emulate-tab @vindex org-cycle-global-at-bob The cursor must be on a headline for this to work@footnote{see, however, -the option @code{org-cycle-emulate-tab}.}. When the cursor is at the +the option @var{org-cycle-emulate-tab}.}. When the cursor is at the beginning of the buffer and the first line is not a headline, then @key{TAB} actually runs global cycling (see below)@footnote{see the -option @code{org-cycle-global-at-bob}.}. Also when called with a prefix +option @var{org-cycle-global-at-bob}.}. Also when called with a prefix argument (@kbd{C-u @key{TAB}}), global cycling is invoked. @cindex global visibility states @@ -1296,6 +1316,15 @@ the previously used indirect buffer. Copy the @i{visible} text in the region into the kill ring. @end table +@menu +* Initial visibility:: Setting the initial visibility state +* Catching invisible edits:: Preventing mistakes when editing invisible parts +@end menu + +@node Initial visibility, Catching invisible edits, Global and local cycling, Visibility cycling +@subsection Initial visibility + +@cindex visibility, initialize @vindex org-startup-folded @vindex org-agenda-inhibit-startup @cindex @code{overview}, STARTUP keyword @@ -1303,11 +1332,13 @@ Copy the @i{visible} text in the region into the kill ring. @cindex @code{showall}, STARTUP keyword @cindex @code{showeverything}, STARTUP keyword -When Emacs first visits an Org file, the global state is set to -OVERVIEW, i.e., only the top level headlines are visible. This can be -configured through the variable @code{org-startup-folded}, or on a -per-file basis by adding one of the following lines anywhere in the -buffer: +When Emacs first visits an Org file, the global state is set to OVERVIEW, +i.e., only the top level headlines are visible@footnote{When +@var{org-agenda-inhibit-startup} is non-@code{nil}, Org will not honor the default +visibility state when first opening a file for the agenda (@pxref{Speeding up +your agendas}).} This can be configured through the variable +@var{org-startup-folded}, or on a per-file basis by adding one of the +following lines anywhere in the buffer: @example #+STARTUP: overview @@ -1318,7 +1349,7 @@ buffer: The startup visibility options are ignored when the file is open for the first time during the agenda generation: if you want the agenda to honor -the startup visibility, set @code{org-agenda-inhibit-startup} to nil. +the startup visibility, set @var{org-agenda-inhibit-startup} to @code{nil}. @cindex property, VISIBILITY @noindent @@ -1326,6 +1357,7 @@ Furthermore, any entries with a @samp{VISIBILITY} property (@pxref{Properties and Columns}) will get their visibility adapted accordingly. Allowed values for this property are @code{folded}, @code{children}, @code{content}, and @code{all}. + @table @asis @orgcmd{C-u C-u @key{TAB},org-set-startup-visibility} Switch back to the startup visibility of the buffer, i.e., whatever is @@ -1333,6 +1365,17 @@ requested by startup options and @samp{VISIBILITY} properties in individual entries. @end table +@node Catching invisible edits, , Initial visibility, Visibility cycling +@subsection Catching invisible edits + +@vindex org-catch-invisible-edits +@cindex edits, catching invisible +Sometimes you may inadvertently edit an invisible part of the buffer and be +confused on what as been edited and how to undo the mistake. Setting +@var{org-catch-invisible-edits} to non-@code{nil} will help prevent this. See the +docstring of this option on how Org should catch invisible edits and process +them. + @node Motion, Structure editing, Visibility cycling, Document Structure @section Motion @cindex motion, between headlines @@ -1361,7 +1404,7 @@ you can use the following keys to find your destination: @key{down} / @key{up} @r{Next/previous visible headline.} @key{RET} @r{Select this location.} @kbd{/} @r{Do a Sparse-tree search} -@r{The following keys work if you turn off @code{org-goto-auto-isearch}} +@r{The following keys work if you turn off @var{org-goto-auto-isearch}} n / p @r{Next/previous visible headline.} f / b @r{Next/previous headline same level.} u @r{One level up.} @@ -1370,7 +1413,7 @@ q @r{Quit} @end example @vindex org-goto-interface @noindent -See also the variable @code{org-goto-interface}. +See also the option @var{org-goto-interface}. @end table @node Structure editing, Sparse trees, Motion, Document Structure @@ -1389,17 +1432,20 @@ See also the variable @code{org-goto-interface}. @table @asis @orgcmd{M-@key{RET},org-insert-heading} @vindex org-M-RET-may-split-line -Insert new heading with same level as current. If the cursor is in a plain -list item, a new item is created (@pxref{Plain lists}). To force creation of -a new headline, use a prefix argument. When this command is used in the -middle of a line, the line is split and the rest of the line becomes the new -headline@footnote{If you do not want the line to be split, customize the -variable @code{org-M-RET-may-split-line}.}. If the command is used at the -beginning of a headline, the new headline is created before the current line. -If at the beginning of any other line, the content of that line is made the -new heading. If the command is used at the end of a folded subtree (i.e., -behind the ellipses at the end of a headline), then a headline like the -current one will be inserted after the end of the subtree. +Insert a new heading/item with the same level than the one at point. +If the cursor is in a plain list item, a new item is created +(@pxref{Plain lists}). To prevent this behavior in lists, call the +command with a prefix argument. When this command is used in the +middle of a line, the line is split and the rest of the line becomes +the new item or headline@footnote{If you do not want the line to be +split, customize the variable @var{org-M-RET-may-split-line}.}. If +the command is used at the @emph{beginning} of a headline, the new +headline is created before the current line. If the command is used +at the @emph{end} of a folded subtree (i.e., behind the ellipses at +the end of a headline), then a headline like the current one will be +inserted after the end of the subtree. Calling this command with +@kbd{C-u C-u} will unconditionally respect the headline's content and +create a new item at the end of the parent subtree. @orgcmd{C-@key{RET},org-insert-heading-respect-content} Just like @kbd{M-@key{RET}}, except when adding a new heading below the current heading, the new heading is placed after the body instead of before @@ -1407,7 +1453,7 @@ it. This command works from anywhere in the entry. @orgcmd{M-S-@key{RET},org-insert-todo-heading} @vindex org-treat-insert-todo-heading-as-state-change Insert new TODO entry with same level as current heading. See also the -variable @code{org-treat-insert-todo-heading-as-state-change}. +variable @var{org-treat-insert-todo-heading-as-state-change}. @orgcmd{C-S-@key{RET},org-insert-todo-heading-respect-content} Insert new TODO entry with same level as current heading. Like @kbd{C-@key{RET}}, the new headline will be inserted after the current @@ -1451,8 +1497,8 @@ headline marker like @samp{****}. @orgcmd{C-y,org-yank} @vindex org-yank-adjusted-subtrees @vindex org-yank-folded-subtrees -Depending on the variables @code{org-yank-adjusted-subtrees} and -@code{org-yank-folded-subtrees}, Org's internal @code{yank} command will +Depending on the options @var{org-yank-adjusted-subtrees} and +@var{org-yank-folded-subtrees}, Org's internal @code{yank} command will paste subtrees folded and in a clever way, using the same command as @kbd{C-c C-x C-y}. With the default settings, no level adjustment will take place, but the yanked tree will be folded unless doing so would swallow text @@ -1469,7 +1515,7 @@ to create a number of tasks related to a series of lectures to prepare. For more details, see the docstring of the command @code{org-clone-subtree-with-time-shift}. @orgcmd{C-c C-w,org-refile} -Refile entry or region to a different location. @xref{Refiling notes}. +Refile entry or region to a different location. @xref{Refile and copy}. @orgcmd{C-c ^,org-sort} Sort same-level entries. When there is an active region, all entries in the region will be sorted. Otherwise the children of the current headline are @@ -1522,8 +1568,8 @@ An important feature of Org mode is the ability to construct @emph{sparse trees} for selected information in an outline tree, so that the entire document is folded as much as possible, but the selected information is made visible along with the headline structure above it@footnote{See also the -variables @code{org-show-hierarchy-above}, @code{org-show-following-heading}, -@code{org-show-siblings}, and @code{org-show-entry-below} for detailed +variables @var{org-show-hierarchy-above}, @var{org-show-following-heading}, +@var{org-show-siblings}, and @var{org-show-entry-below} for detailed control on how much context is shown around each match.}. Just try it out and you will see immediately how it works. @@ -1542,7 +1588,7 @@ provide minimal context, also the full hierarchy of headlines above the match is shown, as well as the headline following the match. Each match is also highlighted; the highlights disappear when the buffer is changed by an editing command@footnote{This depends on the option -@code{org-remove-highlights-with-change}}, or by pressing @kbd{C-c C-c}. +@var{org-remove-highlights-with-change}}, or by pressing @kbd{C-c C-c}. When called with a @kbd{C-u} prefix argument, previous highlights are kept, so several calls to this command can be stacked. @orgcmdkkc{M-g n,M-g M-n,next-error} @@ -1555,7 +1601,7 @@ Jump to the previous sparse tree match in this buffer. @noindent @vindex org-agenda-custom-commands For frequently used sparse trees of specific search strings, you can -use the variable @code{org-agenda-custom-commands} to define fast +use the option @var{org-agenda-custom-commands} to define fast keyboard access to specific sparse trees. These commands will then be accessible through the agenda dispatcher (@pxref{Agenda dispatcher}). For example: @@ -1571,15 +1617,15 @@ a sparse tree matching the string @samp{FIXME}. The other sparse tree commands select headings based on TODO keywords, tags, or properties and will be discussed later in this manual. -@kindex C-c C-e v +@kindex C-c C-e C-v @cindex printing sparse trees @cindex visible text, printing To print a sparse tree, you can use the Emacs command @code{ps-print-buffer-with-faces} which does not print invisible parts of the document @footnote{This does not work under XEmacs, because XEmacs uses selective display for outlining, not text properties.}. -Or you can use the command @kbd{C-c C-e v} to export only the visible -part of the document and print the resulting file. +Or you can use @kbd{C-c C-e C-v} to export only the visible part of +the document and print the resulting file. @node Plain lists, Drawers, Sparse trees, Document Structure @section Plain lists @@ -1605,12 +1651,12 @@ is supported, it may be better to not use it for plain list items.} as bullets. @item @vindex org-plain-list-ordered-item-terminator -@vindex org-alphabetical-lists +@vindex org-list-allow-alphabetical @emph{Ordered} list items start with a numeral followed by either a period or a right parenthesis@footnote{You can filter out any of them by configuring -@code{org-plain-list-ordered-item-terminator}.}, such as @samp{1.} or +@var{org-plain-list-ordered-item-terminator}.}, such as @samp{1.} or @samp{1)}@footnote{You can also get @samp{a.}, @samp{A.}, @samp{a)} and -@samp{A)} by configuring @code{org-alphabetical-lists}. To minimize +@samp{A)} by configuring @var{org-list-allow-alphabetical}. To minimize confusion with normal text, those are limited to one character only. Beyond that limit, bullets will automatically fallback to numbers.}. If you want a list to start with a different value (e.g., 20), start the text of the item @@ -1630,11 +1676,11 @@ line. In particular, if an ordered list reaches number @samp{10.}, then the list. An item ends before the next line that is less or equally indented than its bullet/number. -@vindex org-empty-line-terminates-plain-lists +@vindex org-list-empty-line-terminates-plain-lists A list ends whenever every item has ended, which means before any line less or equally indented than items at top level. It also ends before two blank -lines@footnote{See also @code{org-empty-line-terminates-plain-lists}.}. In -that case, all items are closed. Here is an example: +lines@footnote{See also @var{org-list-empty-line-terminates-plain-lists}.}. +In that case, all items are closed. Here is an example: @example @group @@ -1667,15 +1713,15 @@ blocks can be indented to signal that they belong to a particular item. @vindex org-list-indent-offset If you find that using a different bullet for a sub-list (than that used for the current list-level) improves readability, customize the variable -@code{org-list-demote-modify-bullet}. To get a greater difference of +@var{org-list-demote-modify-bullet}. To get a greater difference of indentation between items and theirs sub-items, customize -@code{org-list-indent-offset}. +@var{org-list-indent-offset}. @vindex org-list-automatic-rules The following commands act on items when the cursor is in the first line of an item (the line with the bullet or number). Some of them imply the application of automatic rules to keep list structure intact. If some of -these actions get in your way, configure @code{org-list-automatic-rules} +these actions get in your way, configure @var{org-list-automatic-rules} to disable them individually. @table @asis @@ -1684,7 +1730,7 @@ to disable them individually. @vindex org-cycle-include-plain-lists Items can be folded just like headline levels. Normally this works only if the cursor is on a plain list item. For more details, see the variable -@code{org-cycle-include-plain-lists}. If this variable is set to +@var{org-cycle-include-plain-lists}. If this variable is set to @code{integrate}, plain list items will be treated like low-level headlines. The level of an item is then given by the indentation of the bullet/number. Items are always subordinate to real headlines, however; the @@ -1699,7 +1745,7 @@ Insert new item at current level. With a prefix argument, force a new heading (@pxref{Structure editing}). If this command is used in the middle of an item, that item is @emph{split} in two, and the second part becomes the new item@footnote{If you do not want the item to be split, customize the -variable @code{org-M-RET-may-split-line}.}. If this command is executed +variable @var{org-M-RET-may-split-line}.}. If this command is executed @emph{before item's body}, the new item is created @emph{before} the current one. @end table @@ -1716,8 +1762,8 @@ Insert a new item with a checkbox (@pxref{Checkboxes}). @vindex org-list-use-circular-motion Jump to the previous/next item in the current list@footnote{If you want to cycle around items that way, you may customize -@code{org-list-use-circular-motion}.}, but only if -@code{org-support-shift-select} is off. If not, you can still use paragraph +@var{org-list-use-circular-motion}.}, but only if +@var{org-support-shift-select} is off. If not, you can still use paragraph jumping commands like @kbd{C-@key{up}} and @kbd{C-@key{down}} to quite similar effect. @kindex M-@key{up} @@ -1725,7 +1771,7 @@ similar effect. @item M-up @itemx M-down Move the item including subitems up/down@footnote{See -@code{org-liste-use-circular-motion} for a cyclic behavior.} (swap with +@var{org-list-use-circular-motion} for a cyclic behavior.} (swap with previous/next item of same indentation). If the list is ordered, renumbering is automatic. @kindex M-@key{left} @@ -1746,7 +1792,7 @@ motion or so. As a special case, using this command on the very first item of a list will move the whole list. This behavior can be disabled by configuring -@code{org-list-automatic-rules}. The global indentation of a list has no +@var{org-list-automatic-rules}. The global indentation of a list has no influence on the text @emph{after} the list. @kindex C-c C-c @item C-c C-c @@ -1758,7 +1804,7 @@ consistency in the whole list. @item C-c - Cycle the entire list level through the different itemize/enumerate bullets (@samp{-}, @samp{+}, @samp{*}, @samp{1.}, @samp{1)}) or a subset of them, -depending on @code{org-plain-list-ordered-item-terminator}, the type of list, +depending on @var{org-plain-list-ordered-item-terminator}, the type of list, and its indentation. With a numeric prefix argument N, select the Nth bullet from this list. If there is an active region when calling this, selected text will be changed into an item. With a prefix argument, all lines will be @@ -1780,7 +1826,7 @@ Turn the whole plain list into a subtree of the current heading. Checkboxes @vindex org-support-shift-select 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}. +@var{org-support-shift-select}. @kindex C-c ^ @item C-c ^ Sort the plain list. You will be prompted for the sorting method: @@ -1798,10 +1844,9 @@ numerically, alphabetically, by time, or by custom function. @kindex C-c C-x d Sometimes you want to keep information associated with an entry, but you normally don't want to see it. For this, Org mode has @emph{drawers}. -Drawers need to be configured with the variable -@code{org-drawers}@footnote{You can define additional drawers on a -per-file basis with a line like @code{#+DRAWERS: HIDDEN STATE}}. Drawers -look like this: +Drawers need to be configured with the option @var{org-drawers}@footnote{You +can define additional drawers on a per-file basis with a line like +@code{#+DRAWERS: HIDDEN STATE}}. Drawers look like this: @example ** This is a headline @@ -1834,6 +1879,12 @@ want to store a quick note in the LOGBOOK drawer, in a similar way to state chan Add a time-stamped note to the LOGBOOK drawer. @end table +@vindex org-export-with-drawers +You can select the name of the drawers which should be exported with +@var{org-export-with-drawers}. In that case, drawer contents will appear in +export output. Property drawers are not affected by this variable and are +never exported. + @node Blocks, Footnotes, Drawers, Document Structure @section Blocks @@ -1843,7 +1894,7 @@ Org mode uses begin...end blocks for various purposes from including source code examples (@pxref{Literal examples}) to capturing time logging information (@pxref{Clocking work time}). These blocks can be folded and unfolded by pressing TAB in the begin line. You can also get all blocks -folded at startup by configuring the variable @code{org-hide-block-startup} +folded at startup by configuring the option @var{org-hide-block-startup} or on a per-file basis by using @cindex @code{hideblocks}, STARTUP keyword @@ -1858,13 +1909,13 @@ or on a per-file basis by using @cindex footnotes Org mode supports the creation of footnotes. In contrast to the -@file{footnote.el} package, Org mode's footnotes are designed for work on a -larger document, not only for one-off documents like emails. The basic -syntax is similar to the one used by @file{footnote.el}, i.e., a footnote is -defined in a paragraph that is started by a footnote marker in square -brackets in column 0, no indentation allowed. If you need a paragraph break -inside a footnote, use the @LaTeX{} idiom @samp{\par}. The footnote reference -is simply the marker in square brackets, inside text. For example: +@file{footnote.el} package, Org mode's footnotes are designed for work on +a larger document, not only for one-off documents like emails. + +A footnote is started by a footnote marker in square brackets in column 0, no +indentation allowed. It ends at the next footnote definition, headline, or +after two consecutive empty lines. The footnote reference is simply the +marker in square brackets, inside text. For example: @example The Org homepage[fn:1] now looks a lot better than it used to. @@ -1897,7 +1948,7 @@ Since Org allows multiple references to the same note, you can then use @vindex org-footnote-auto-label Footnote labels can be created automatically, or you can create names yourself. -This is handled by the variable @code{org-footnote-auto-label} and its +This is handled by the variable @var{org-footnote-auto-label} and its corresponding @code{#+STARTUP} keywords. See the docstring of that variable for details. @@ -1914,12 +1965,12 @@ is at a definition, jump to the (first) reference. @vindex org-footnote-define-inline @vindex org-footnote-section @vindex org-footnote-auto-adjust -Otherwise, create a new footnote. Depending on the variable -@code{org-footnote-define-inline}@footnote{The corresponding in-buffer +Otherwise, create a new footnote. Depending on the option +@var{org-footnote-define-inline}@footnote{The corresponding in-buffer setting is: @code{#+STARTUP: fninline} or @code{#+STARTUP: nofninline}}, the definition will be placed right into the text as part of the reference, or -separately into the location determined by the variable -@code{org-footnote-section}. +separately into the location determined by the option +@var{org-footnote-section}. When this command is called with a prefix argument, a menu of additional options is offered: @@ -1927,23 +1978,22 @@ options is offered: s @r{Sort the footnote definitions by reference sequence. During editing,} @r{Org makes no effort to sort footnote definitions into a particular} @r{sequence. If you want them sorted, use this command, which will} - @r{also move entries according to @code{org-footnote-section}. Automatic} + @r{also move entries according to @var{org-footnote-section}. Automatic} @r{sorting after each insertion/deletion can be configured using the} - @r{variable @code{org-footnote-auto-adjust}.} + @r{option @var{org-footnote-auto-adjust}.} r @r{Renumber the simple @code{fn:N} footnotes. Automatic renumbering} - @r{after each insertion/deletion can be configured using the variable} - @r{@code{org-footnote-auto-adjust}.} + @r{after each insertion/deletion can be configured using the option} + @r{@var{org-footnote-auto-adjust}.} S @r{Short for first @code{r}, then @code{s} action.} n @r{Normalize the footnotes by collecting all definitions (including} @r{inline definitions) into a special section, and then numbering them} @r{in sequence. The references will then also be numbers. This is} @r{meant to be the final step before finishing a document (e.g., sending} - @r{off an email). The exporters do this automatically, and so could} - @r{something like @code{message-send-hook}.} + @r{off an email).} d @r{Delete the footnote at point, and all definitions of and references} @r{to it.} @end example -Depending on the variable @code{org-footnote-auto-adjust}@footnote{the +Depending on the variable @var{org-footnote-auto-adjust}@footnote{the corresponding in-buffer options are @code{fnadjust} and @code{nofnadjust}.}, renumbering and sorting footnotes can be automatic after each insertion or deletion. @@ -1961,7 +2011,7 @@ Footnote labels are also links to the corresponding definition/reference, and you can use the usual commands to follow these links. @end table -@node Orgstruct mode, , Footnotes, Document Structure +@node Orgstruct mode, Org syntax, Footnotes, Document Structure @section The Orgstruct minor mode @cindex Orgstruct mode @cindex minor mode for structure editing @@ -1969,7 +2019,7 @@ you can use the usual commands to follow these links. If you like the intuitive way the Org mode structure editing and list formatting works, you might want to use these commands in other modes like Text mode or Mail mode as well. The minor mode @code{orgstruct-mode} makes -this possible. Toggle the mode with @kbd{M-x orgstruct-mode}, or +this possible. Toggle the mode with @kbd{M-x orgstruct-mode RET}, or turn it on by default, for example in Message mode, with one of: @lisp @@ -1981,10 +2031,42 @@ When this mode is active and the cursor is on a line that looks to Org like a headline or the first line of a list item, most structure editing commands will work, even if the same keys normally have different functionality in the major mode you are using. If the cursor is not in one of those special -lines, Orgstruct mode lurks silently in the shadows. When you use -@code{orgstruct++-mode}, Org will also export indentation and autofill -settings into that mode, and detect item context after the first line of an -item. +lines, Orgstruct mode lurks silently in the shadows. + +When you use @code{orgstruct++-mode}, Org will also export indentation and +autofill settings into that mode, and detect item context after the first +line of an item. + +@vindex orgstruct-heading-prefix-regexp +You can also use Org structure editing to fold and unfold headlines in +@emph{any} file, provided you defined @var{orgstruct-heading-prefix-regexp}: +the regular expression must match the local prefix to use before Org's +headlines. For example, if you set this variable to @code{"^;; "} in Emacs +Lisp files, you will be able to fold and unfold headlines in Emacs Lisp +commented lines. Some commands like @code{org-demote} are disabled when the +prefix is set, but folding/unfolding will work correctly. + +@node Org syntax, , Orgstruct mode, Document Structure +@section Org syntax +@cindex Org syntax + +A reference document providing a formal description of Org's syntax is +available as @uref{http://orgmode.org/worg/dev/org-syntax.html, a draft on +Worg}, written and maintained by Nicolas Goaziou. It defines Org's core +internal concepts such as @code{headlines}, @code{sections}, @code{affiliated +keywords}, @code{(greater) elements} and @code{objects}. Each part of an Org +file falls into one of the categories above. + +To explore the abstract structure of an Org buffer, run this in a buffer: + +@lisp +M-: (org-element-parse-buffer) RET +@end lisp + +It will output a list containing the buffer's content represented as an +abstract structure. The export engine relies on the information stored in +this list. Most interactive commands (e.g., for structure editing) also +rely on the syntactic meaning of the surrounding context. @node Tables, Hyperlinks, Document Structure, Top @chapter Tables @@ -2047,8 +2129,8 @@ inserting and deleting avoids shifting other fields. Also, when typing @emph{immediately after the cursor was moved into a new field with @kbd{@key{TAB}}, @kbd{S-@key{TAB}} or @kbd{@key{RET}}}, the field is automatically made blank. If this behavior is too -unpredictable for you, configure the variables -@code{org-enable-table-editor} and @code{org-table-auto-blank-field}. +unpredictable for you, configure the options +@var{org-enable-table-editor} and @var{org-table-auto-blank-field}. @table @kbd @tsubheading{Creation and conversion} @@ -2067,7 +2149,7 @@ table. But it is easier just to start typing, like @tsubheading{Re-aligning and field motion} @orgcmd{C-c C-c,org-table-align} -Re-align the table without moving the cursor. +Re-align the table and don't move to another field. @c @orgcmd{,org-table-next-field} Re-align the table, move to the next field. Creates a new row if @@ -2166,7 +2248,7 @@ be inserted with @kbd{C-y}. @vindex org-table-copy-increment When current field is empty, copy from first non-empty field above. When not empty, copy current field down to next row and move cursor along with it. -Depending on the variable @code{org-table-copy-increment}, integer field +Depending on the option @var{org-table-copy-increment}, integer field values will be incremented during copy. Integers that are too large will not be incremented. Also, a @code{0} prefix argument temporarily disables the increment. This key is also used by shift-selection and related modes @@ -2182,7 +2264,7 @@ window follow the cursor through the table and always show the current field. The follow mode exits automatically when the cursor leaves the table, or when you repeat this command with @kbd{C-u C-u C-c `}. @c -@item M-x org-table-import +@item M-x org-table-import RET Import a file as a table. The table should be TAB or whitespace separated. Use, for example, to import a spreadsheet table or data from a database, because these programs generally can write @@ -2195,13 +2277,13 @@ Tables can also be imported by pasting tabular text into the Org buffer, selecting the pasted text with @kbd{C-x C-x} and then using the @kbd{C-c |} command (see above under @i{Creation and conversion}). @c -@item M-x org-table-export +@item M-x org-table-export RET @findex org-table-export @vindex org-table-export-default-format Export the table, by default as a TAB-separated file. Use for data exchange with, for example, spreadsheet or database programs. The format -used to export the file can be configured in the variable -@code{org-table-export-default-format}. You may also use properties +used to export the file can be configured in the option +@var{org-table-export-default-format}. You may also use properties @code{TABLE_EXPORT_FILE} and @code{TABLE_EXPORT_FORMAT} to specify the file name and the format for table export in a subtree. Org supports quite general formats for exported tables. The exporter format is the same as the @@ -2262,7 +2344,7 @@ C-c}. When visiting a file containing a table with narrowed columns, the necessary character hiding has not yet happened, and the table needs to be aligned before it looks nice. Setting the option -@code{org-startup-align-all-tables} will realign all tables in a file +@var{org-startup-align-all-tables} will realign all tables in a file upon visiting, but also slow down startup. You can also set this option on a per-file basis with: @@ -2275,7 +2357,7 @@ If you would like to overrule the automatic alignment of number-rich columns to the right and of string-rich column to the left, you can use @samp{}, @samp{}@footnote{Centering does not work inside Emacs, but it does have an effect when exporting to HTML.} or @samp{} in a similar fashion. You may -also combine alignment and field width like this: @samp{}. +also combine alignment and field width like this: @samp{}. Lines which only contain these formatting cookies will be removed automatically when exporting the document. @@ -2324,7 +2406,7 @@ every vertical line you would like to have: If you like the intuitive way the Org table editor works, you might also want to use it in other modes like Text mode or Mail mode. The minor mode Orgtbl mode makes this possible. You can always toggle -the mode with @kbd{M-x orgtbl-mode}. To turn it on by default, for +the mode with @kbd{M-x orgtbl-mode RET}. To turn it on by default, for example in Message mode, use @lisp @@ -2360,6 +2442,7 @@ formula, moving these references by arrow keys * Durations and time values:: How to compute durations and time values * Field and range formulas:: Formula for specific (ranges of) fields * Column formulas:: Formulas valid for an entire column +* Lookup functions:: Lookup functions for searching tables * Editing and debugging formulas:: Fixing formulas * Updating the table:: Recomputing all dependent fields * Advanced features:: Field and column names, parameters and automatic recalc @@ -2385,8 +2468,8 @@ combination like @code{B3}, meaning the 2nd field in the 3rd row. @vindex org-table-use-standard-references However, Org prefers@footnote{Org will understand references typed by the user as @samp{B4}, but it will not use this syntax when offering a formula -for editing. You can customize this behavior using the variable -@code{org-table-use-standard-references}.} to use another, more general +for editing. You can customize this behavior using the option +@var{org-table-use-standard-references}.} to use another, more general representation that looks like this: @example @@@var{row}$@var{column} @@ -2453,15 +2536,15 @@ $1..$3 @r{first three fields in the current row} $P..$Q @r{range, using column names (see under Advanced)} $<<<..$>> @r{start in third column, continue to the one but last} @@2$1..@@4$3 @r{6 fields between these two fields (same as @code{A2..C4})} -@@-1$-2..@@-1 @r{in the first row up, 3 fields from 2 columns on the left} +@@-1$-2..@@-1 @r{3 fields in the row above, starting from 2 columns on the left} @@I..II @r{between first and second hline, short for @code{@@I..@@II}} @end example @noindent Range references return a vector of values that can be fed -into Calc vector functions. Empty fields in ranges are normally -suppressed, so that the vector contains only the non-empty fields (but -see the @samp{E} mode switch below). If there are no non-empty fields, -@samp{[0]} is returned to avoid syntax errors in formulas. +into Calc vector functions. Empty fields in ranges are normally suppressed, +so that the vector contains only the non-empty fields. For other options +with the mode switches @samp{E}, @samp{N} and examples @pxref{Formula syntax +for Calc}. @subsubheading Field coordinates in formulas @cindex field coordinates @@ -2494,8 +2577,8 @@ number of rows. @vindex org-table-formula-constants @samp{$name} is interpreted as the name of a column, parameter or -constant. Constants are defined globally through the variable -@code{org-table-formula-constants}, and locally (for the file) through a +constant. Constants are defined globally through the option +@var{org-table-formula-constants}, and locally (for the file) through a line like @example @@ -2527,7 +2610,7 @@ numbers. @cindex references, to a different table @cindex name, of column or field @cindex constants, in calculations -@cindex #+TBLNAME +@cindex #+NAME, for table You may also reference constants, fields and ranges from a different table, either in the current file or even in a different file. The syntax is @@ -2538,7 +2621,7 @@ remote(NAME-OR-ID,REF) @noindent where NAME can be the name of a table in the current file as set by a -@code{#+TBLNAME: NAME} line before the table. It can also be the ID of an +@code{#+NAME: Name} line before the table. It can also be the ID of an entry, even in a different file, and the reference then refers to the first table in that entry. REF is an absolute field or range reference as described above for example @code{@@3$3} or @code{$somename}, valid in the @@ -2549,14 +2632,13 @@ referenced table. @cindex formula syntax, Calc @cindex syntax, of formulas -A formula can be any algebraic expression understood by the Emacs -@file{Calc} package. @b{Note that @file{calc} has the -non-standard convention that @samp{/} has lower precedence than -@samp{*}, so that @samp{a/b*c} is interpreted as @samp{a/(b*c)}.} Before -evaluation by @code{calc-eval} (@pxref{Calling Calc from -Your Programs, calc-eval, Calling Calc from Your Lisp Programs, calc, GNU -Emacs Calc Manual}), -variable substitution takes place according to the rules described above. +A formula can be any algebraic expression understood by the Emacs @file{Calc} +package. Note that @file{calc} has the non-standard convention that @samp{/} +has lower precedence than @samp{*}, so that @samp{a/b*c} is interpreted as +@samp{a/(b*c)}. Before evaluation by @code{calc-eval} (@pxref{Calling Calc +from Your Programs, calc-eval, Calling Calc from Your Lisp Programs, calc, +GNU Emacs Calc Manual}), variable substitution takes place according to the +rules described above. @cindex vectors, in table calculations The range vectors can be directly fed into the Calc vector functions like @samp{vmean} and @samp{vsum}. @@ -2569,33 +2651,52 @@ string consists of flags to influence Calc and other modes during execution. By default, Org uses the standard Calc modes (precision 12, angular units degrees, fraction and symbolic modes off). The display format, however, has been changed to @code{(float 8)} to keep tables -compact. The default settings can be configured using the variable -@code{org-calc-default-modes}. +compact. The default settings can be configured using the option +@var{org-calc-default-modes}. -@example -p20 @r{set the internal Calc calculation precision to 20 digits} -n3 s3 e2 f4 @r{Normal, scientific, engineering, or fixed} - @r{format of the result of Calc passed back to Org.} - @r{Calc formatting is unlimited in precision as} - @r{long as the Calc calculation precision is greater.} -D R @r{angle modes: degrees, radians} -F S @r{fraction and symbolic modes} -N @r{interpret all fields as numbers, use 0 for non-numbers} -E @r{keep empty fields in ranges} -L @r{literal} -@end example +@noindent List of modes: + +@table @asis +@item @code{p20} +Set the internal Calc calculation precision to 20 digits. +@item @code{n3}, @code{s3}, @code{e2}, @code{f4} +Normal, scientific, engineering or fixed format of the result of Calc passed +back to Org. Calc formatting is unlimited in precision as long as the Calc +calculation precision is greater. +@item @code{D}, @code{R} +Degree and radian angle modes of Calc. +@item @code{F}, @code{S} +Fraction and symbolic modes of Calc. +@item @code{T}, @code{t} +Duration computations in Calc or Lisp, @pxref{Durations and time values}. +@item @code{E} +If and how to consider empty fields. Without @samp{E} empty fields in range +references are suppressed so that the Calc vector or Lisp list contains only +the non-empty fields. With @samp{E} the empty fields are kept. For empty +fields in ranges or empty field references the value @samp{nan} (not a +number) is used in Calc formulas and the empty string is used for Lisp +formulas. Add @samp{N} to use 0 instead for both formula types. For the +value of a field the mode @samp{N} has higher precedence than @samp{E}. +@item @code{N} +Interpret all fields as numbers, use 0 for non-numbers. See the next section +to see how this is essential for computations with Lisp formulas. In Calc +formulas it is used only occasionally because there number strings are +already interpreted as numbers without @samp{N}. +@item @code{L} +Literal, for Lisp formulas only. See the next section. +@end table @noindent -Unless you use large integer numbers or high-precision-calculation -and -display for floating point numbers you may alternatively provide a -@code{printf} format specifier to reformat the Calc result after it has been +Unless you use large integer numbers or high-precision-calculation and +-display for floating point numbers you may alternatively provide a +@samp{printf} format specifier to reformat the Calc result after it has been passed back to Org instead of letting Calc already do the -formatting@footnote{The @code{printf} reformatting is limited in precision -because the value passed to it is converted into an @code{integer} or -@code{double}. The @code{integer} is limited in size by truncating the -signed value to 32 bits. The @code{double} is limited in precision to 64 -bits overall which leaves approximately 16 significant decimal digits.}. -A few examples: +formatting@footnote{The @samp{printf} reformatting is limited in precision +because the value passed to it is converted into an @samp{integer} or +@samp{double}. The @samp{integer} is limited in size by truncating the +signed value to 32 bits. The @samp{double} is limited in precision to 64 +bits overall which leaves approximately 16 significant decimal digits.}. A +few examples: @example $1+$2 @r{Sum of first and second field} @@ -2606,19 +2707,38 @@ $0;%.1f @r{Reformat current cell to 1 decimal} $c/$1/$cm @r{Hz -> cm conversion, using @file{constants.el}} tan($1);Dp3s1 @r{Compute in degrees, precision 3, display SCI 1} sin($1);Dp3%.1e @r{Same, but use printf specifier for display} -vmean($2..$7) @r{Compute column range mean, using vector function} -vmean($2..$7);EN @r{Same, but treat empty fields as 0} taylor($3,x=7,2) @r{Taylor series of $3, at x=7, second degree} @end example -Calc also contains a complete set of logical operations. For example +Calc also contains a complete set of logical operations, (@pxref{Logical +Operations, , Logical Operations, calc, GNU Emacs Calc Manual}). For example -@example -if($1<20,teen,string("")) @r{"teen" if age $1 less than 20, else empty} -@end example +@table @code +@item if($1 < 20, teen, string("")) +"teen" if age $1 is less than 20, else the Org table result field is set to +empty with the empty string. +@item if("$1" == "nan" || "$2" == "nan", string(""), $1 + $2); E +Sum of the first two columns. When at least one of the input fields is empty +the Org table result field is set to empty. +@item if(typeof(vmean($1..$7)) == 12, string(""), vmean($1..$7); E +Mean value of a range unless there is any empty field. Every field in the +range that is empty is replaced by @samp{nan} which lets @samp{vmean} result +in @samp{nan}. Then @samp{typeof == 12} detects the @samp{nan} from +@samp{vmean} and the Org table result field is set to empty. Use this when +the sample set is expected to never have missing values. +@item if("$1..$7" == "[]", string(""), vmean($1..$7)) +Mean value of a range with empty fields skipped. Every field in the range +that is empty is skipped. When all fields in the range are empty the mean +value is not defined and the Org table result field is set to empty. Use +this when the sample set can have a variable size. +@item vmean($1..$7); EN +To complete the example before: Mean value of a range with empty fields +counting as samples with value 0. Use this only when incomplete sample sets +should be padded with 0 to the full size. +@end table -Note that you can also use two org-specific flags @code{T} and @code{t} for -durations computations @ref{Durations and time values}. +You can add your own Calc functions defined in Emacs Lisp with @code{defmath} +and use them in formula syntax for Calc. @node Formula syntax for Lisp, Durations and time values, Formula syntax for Calc, The spreadsheet @subsection Emacs Lisp forms as formulas @@ -2647,14 +2767,14 @@ fields, so you can embed them in list or vector syntax. Here are a few examples---note how the @samp{N} mode is used when we do computations in Lisp: -@example -@r{Swap the first two characters of the content of column 1} - '(concat (substring $1 1 2) (substring $1 0 1) (substring $1 2)) -@r{Add columns 1 and 2, equivalent to Calc's @code{$1+$2}} - '(+ $1 $2);N -@r{Compute the sum of columns 1--4, like Calc's @code{vsum($1..$4)}} - '(apply '+ '($1..$4));N -@end example +@table @code +@item '(concat (substring $1 1 2) (substring $1 0 1) (substring $1 2)) +Swap the first two characters of the content of column 1. +@item '(+ $1 $2);N +Add columns 1 and 2, equivalent to Calc's @code{$1+$2}. +@item '(apply '+ '($1..$4));N +Compute the sum of columns 1 to 4, like Calc's @code{vsum($1..$4)}. +@end table @node Durations and time values, Field and range formulas, Formula syntax for Lisp, The spreadsheet @subsection Durations and time values @@ -2678,8 +2798,8 @@ formulas or Elisp formulas: Input duration values must be of the form @code{[HH:MM[:SS]}, where seconds are optional. With the @code{T} flag, computed durations will be displayed as @code{HH:MM:SS} (see the first formula above). With the @code{t} flag, -computed durations will be displayed according to the value of the variable -@code{org-table-duration-custom-format}, which defaults to @code{'hours} and +computed durations will be displayed according to the value of the option +@var{org-table-duration-custom-format}, which defaults to @code{'hours} and will display the result as a fraction of hours (see the second formula in the example above). @@ -2742,7 +2862,7 @@ can also be used to assign a formula to some but not all fields in a row. Named field, see @ref{Advanced features}. @end table -@node Column formulas, Editing and debugging formulas, Field and range formulas, The spreadsheet +@node Column formulas, Lookup functions, Field and range formulas, The spreadsheet @subsection Column formulas @cindex column formula @cindex formula, for table column @@ -2750,10 +2870,13 @@ Named field, see @ref{Advanced features}. When you assign a formula to a simple column reference like @code{$3=}, the same formula will be used in all fields of that column, with the following very convenient exceptions: (i) If the table contains horizontal separator -hlines, everything before the first such line is considered part of the table -@emph{header} and will not be modified by column formulas. (ii) Fields that -already get a value from a field/range formula will be left alone by column -formulas. These conditions make column formulas very easy to use. +hlines with rows above and below, everything before the first such hline is +considered part of the table @emph{header} and will not be modified by column +formulas. Therefore a header is mandatory when you use column formulas and +want to add hlines to group rows, like for example to separate a total row at +the bottom from the summand rows above. (ii) Fields that already get a value +from a field/range formula will be left alone by column formulas. These +conditions make column formulas very easy to use. To assign a formula to a column, type it directly into any field in the column, preceded by an equal sign, like @samp{=$1+$2}. When you press @@ -2778,19 +2901,62 @@ stores it. With a numeric prefix argument(e.g., @kbd{C-5 C-c =}) the command will apply it to that many consecutive fields in the current column. @end table -@node Editing and debugging formulas, Updating the table, Column formulas, The spreadsheet +@node Lookup functions, Editing and debugging formulas, Column formulas, The spreadsheet +@subsection Lookup functions +@cindex lookup functions in tables +@cindex table lookup functions + +Org has three predefined Emacs Lisp functions for lookups in tables. +@table @code +@item (org-lookup-first VAL S-LIST R-LIST &optional PREDICATE) +@findex org-lookup-first +Searches for the first element @code{S} in list @code{S-LIST} for which +@lisp +(PREDICATE VAL S) +@end lisp +is @code{t}; returns the value from the corresponding position in list +@code{R-LIST}. The default @code{PREDICATE} is @code{equal}. Note that the +parameters @code{VAL} and @code{S} are passed to @code{PREDICATE} in the same +order as the corresponding parameters are in the call to +@code{org-lookup-first}, where @code{VAL} precedes @code{S-LIST}. If +@code{R-LIST} is @code{nil}, the matching element @code{S} of @code{S-LIST} +is returned. +@item (org-lookup-last VAL S-LIST R-LIST &optional PREDICATE) +@findex org-lookup-last +Similar to @code{org-lookup-first} above, but searches for the @i{last} +element for which @code{PREDICATE} is @code{t}. +@item (org-lookup-all VAL S-LIST R-LIST &optional PREDICATE) +@findex org-lookup-all +Similar to @code{org-lookup-first}, but searches for @i{all} elements for +which @code{PREDICATE} is @code{t}, and returns @i{all} corresponding +values. This function can not be used by itself in a formula, because it +returns a list of values. However, powerful lookups can be built when this +function is combined with other Emacs Lisp functions. +@end table + +If the ranges used in these functions contain empty fields, the @code{E} mode +for the formula should usually be specified: otherwise empty fields will not be +included in @code{S-LIST} and/or @code{R-LIST} which can, for example, result +in an incorrect mapping from an element of @code{S-LIST} to the corresponding +element of @code{R-LIST}. + +These three functions can be used to implement associative arrays, count +matching cells, rank results, group data etc. For practical examples +see @uref{http://orgmode.org/worg/org-tutorials/org-lookups.html, this +tutorial on Worg}. + +@node Editing and debugging formulas, Updating the table, Lookup functions, The spreadsheet @subsection Editing and debugging formulas @cindex formula editing @cindex editing, of table formulas @vindex org-table-use-standard-references -You can edit individual formulas in the minibuffer or directly in the -field. Org can also prepare a special buffer with all active -formulas of a table. When offering a formula for editing, Org -converts references to the standard format (like @code{B3} or @code{D&}) -if possible. If you prefer to only work with the internal format (like -@code{@@3$2} or @code{$4}), configure the variable -@code{org-table-use-standard-references}. +You can edit individual formulas in the minibuffer or directly in the field. +Org can also prepare a special buffer with all active formulas of a table. +When offering a formula for editing, Org converts references to the standard +format (like @code{B3} or @code{D&}) if possible. If you prefer to only work +with the internal format (like @code{@@3$2} or @code{$4}), configure the +option @var{org-table-use-standard-references}. @table @kbd @orgcmdkkc{C-c =,C-u C-c =,org-table-eval-formula} @@ -2822,6 +2988,7 @@ active formula, the cursor in the formula editor will mark it. While inside the special buffer, Org will automatically highlight any field or range reference at the cursor position. You may edit, remove and add formulas, and use the following commands: + @table @kbd @orgcmdkkc{C-c C-c,C-x C-s,org-table-fedit-finish} Exit the formula editor and store the modified formulas. With @kbd{C-u} @@ -2873,6 +3040,52 @@ You may edit the @samp{#+TBLFM} directly and re-apply the changed equations with @kbd{C-c C-c} in that line or with the normal recalculation commands in the table. +@anchor{Using multiple #+TBLFM lines} +@subsubheading Using multiple #+TBLFM lines +@cindex #+TBLFM line, multiple +@cindex #+TBLFM +@cindex #+TBLFM, switching +@kindex C-c C-c + +You may apply the formula temporarily. This is useful when you +switch the formula. Place multiple @samp{#+TBLFM} lines right +after the table, and then press @kbd{C-c C-c} on the formula to +apply. Here is an example: + +@example +| x | y | +|---+---| +| 1 | | +| 2 | | +#+TBLFM: $2=$1*1 +#+TBLFM: $2=$1*2 +@end example + +@noindent +Pressing @kbd{C-c C-c} in the line of @samp{#+TBLFM: $2=$1*2} yields: + +@example +| x | y | +|---+---| +| 1 | 2 | +| 2 | 4 | +#+TBLFM: $2=$1*1 +#+TBLFM: $2=$1*2 +@end example + +@noindent +Note: If you recalculate this table (with @kbd{C-u C-c *}, for example), you +will get the following result of applying only the first @samp{#+TBLFM} line. + +@example +| x | y | +|---+---| +| 1 | 1 | +| 2 | 2 | +#+TBLFM: $2=$1*1 +#+TBLFM: $2=$1*2 +@end example + @subsubheading Debugging formulas @cindex formula debugging @cindex debugging, of table formulas @@ -2911,10 +3124,10 @@ hline are left alone, assuming that these are part of the table header. Iterate the table by recomputing it until no further changes occur. This may be necessary if some computed fields use the value of other fields that are computed @i{later} in the calculation sequence. -@item M-x org-table-recalculate-buffer-tables +@item M-x org-table-recalculate-buffer-tables RET @findex org-table-recalculate-buffer-tables Recompute all tables in the current buffer. -@item M-x org-table-iterate-buffer-tables +@item M-x org-table-iterate-buffer-tables RET @findex org-table-iterate-buffer-tables Iterate all tables in the current buffer, in order to converge table-to-table dependencies. @@ -2967,6 +3180,7 @@ empty first field. @cindex marking characters, tables The marking characters have the following meaning: + @table @samp @item ! The fields in this line define names for the columns, so that you may @@ -3168,10 +3382,8 @@ internal structure of all links, use the menu entry If the link does not look like a URL, it is considered to be internal in the current file. The most important case is a link like @samp{[[#my-custom-id]]} which will link to the entry with the -@code{CUSTOM_ID} property @samp{my-custom-id}. Such custom IDs are very good -for HTML export (@pxref{HTML export}) where they produce pretty section -links. You are responsible yourself to make sure these custom IDs are unique -in a file. +@code{CUSTOM_ID} property @samp{my-custom-id}. You are responsible yourself +to make sure these custom IDs are unique in a file. Links such as @samp{[[My Target]]} or @samp{[[My Target][Find my target]]} lead to a text search in the current file. @@ -3179,27 +3391,48 @@ lead to a text search in the current file. The link can be followed with @kbd{C-c C-o} when the cursor is on the link, or with a mouse click (@pxref{Handling links}). Links to custom IDs will point to the corresponding headline. The preferred match for a text link is -a @i{dedicated target}: the same string in double angular brackets. Targets -may be located anywhere; sometimes it is convenient to put them into a -comment line. For example +a @i{dedicated target}: the same string in double angular brackets, like +@samp{<>}. + +@cindex #+NAME +If no dedicated target exists, the link will then try to match the exact name +of an element within the buffer. Naming is done with the @code{#+NAME} +keyword, which has to be put the line before the element it refers to, as in +the following example @example -# <> +#+NAME: My Target +| a | table | +|----+------------| +| of | four cells | @end example -@noindent In HTML export (@pxref{HTML export}), such targets will become -named anchors for direct access through @samp{http} links@footnote{Note that -text before the first headline is usually not exported, so the first such -target should be after the first headline, or in the line directly before the -first headline.}. - -If no dedicated target exists, Org will search for a headline that is exactly +If none of the above succeeds, Org will search for a headline that is exactly the link text but may also include a TODO keyword and tags@footnote{To insert -a link targeting a headline, in-buffer completion can be used. Just type a -star followed by a few optional letters into the buffer and press +a link targeting a headline, in-buffer completion can be used. Just type +a star followed by a few optional letters into the buffer and press @kbd{M-@key{TAB}}. All headlines in the current buffer will be offered as -completions.}. In non-Org files, the search will look for the words in the -link text. In the above example the search would be for @samp{my target}. +completions.}. + +During export, internal links will be used to mark objects and assign them +a number. Marked objects will then be referenced by links pointing to them. +In particular, links without a description will appear as the number assigned +to the marked object@footnote{When targeting a @code{#+NAME} keyword, +@code{#+CAPTION} keyword is mandatory in order to get proper numbering +(@pxref{Images and tables}).}. In the following excerpt from an Org buffer + +@example +- one item +- <>another item +Here we refer to item [[target]]. +@end example + +@noindent +The last sentence will appear as @samp{Here we refer to item 2} when +exported. + +In non-Org files, the search will look for the words in the link text. In +the above example the search would be for @samp{my target}. Following a link pushes a mark onto Org's own mark ring. You can return to the previous position with @kbd{C-c &}. Using this command @@ -3230,26 +3463,23 @@ cursor on or at a target. @section External links @cindex links, external @cindex external links -@cindex links, external @cindex Gnus links @cindex BBDB links @cindex IRC links @cindex URL links @cindex file links -@cindex VM links @cindex RMAIL links -@cindex WANDERLUST links @cindex MH-E links @cindex USENET links @cindex SHELL links @cindex Info links @cindex Elisp links -Org supports links to files, websites, Usenet and email messages, -BBDB database entries and links to both IRC conversations and their -logs. External links are URL-like locators. They start with a short -identifying string followed by a colon. There can be no space after -the colon. The following list shows examples for each link type. +Org supports links to files, websites, Usenet and email messages, BBDB +database entries and links to both IRC conversations and their logs. +External links are URL-like locators. They start with a short identifying +string followed by a colon. There can be no space after the colon. The +following list shows examples for each link type. @example http://www.astro.uva.nl/~dominik @r{on the web} @@ -3264,8 +3494,8 @@ file:sometextfile::NNN @r{file, jump to line number} file:projects.org @r{another Org file} file:projects.org::some words @r{text search in Org file}@footnote{ The actual behavior of the search will depend on the value of -the variable @code{org-link-search-must-match-exact-headline}. If its value -is nil, then a fuzzy text search will be done. If it is t, then only the +the option @var{org-link-search-must-match-exact-headline}. If its value +is @code{nil}, then a fuzzy text search will be done. If it is t, then only the exact headline will be matched. If the value is @code{'query-to-create}, then an exact headline will be searched; if it is not found, then the user will be queried to create it.} @@ -3276,13 +3506,6 @@ docview:papers/last.pdf::NNN @r{open in doc-view mode at page} id:B7423F4D-2E8A-471B-8810-C40F074717E9 @r{Link to heading by ID} news:comp.emacs @r{Usenet link} mailto:adent@@galaxy.net @r{Mail link} -vm:folder @r{VM folder link} -vm:folder#id @r{VM message link} -vm://myself@@some.where.org/folder#id @r{VM on remote machine} -vm-imap:account:folder @r{VM IMAP folder link} -vm-imap:account:folder#id @r{VM IMAP message link} -wl:folder @r{WANDERLUST folder link} -wl:folder#id @r{WANDERLUST message link} mhe:folder @r{MH-E folder link} mhe:folder#id @r{MH-E message link} rmail:folder @r{RMAIL folder link} @@ -3297,11 +3520,27 @@ elisp:org-agenda @r{Interactive Elisp command} elisp:(find-file-other-frame "Elisp.org") @r{Elisp form to evaluate} @end example +@cindex VM links +@cindex WANDERLUST links +On top of these built-in link types, some are available through the +@code{contrib/} directory (@pxref{Installation}). For example, these links +to VM or Wanderlust messages are available when you load the corresponding +libraries from the @code{contrib/} directory: + +@example +vm:folder @r{VM folder link} +vm:folder#id @r{VM message link} +vm://myself@@some.where.org/folder#id @r{VM on remote machine} +vm-imap:account:folder @r{VM IMAP folder link} +vm-imap:account:folder#id @r{VM IMAP message link} +wl:folder @r{WANDERLUST folder link} +wl:folder#id @r{WANDERLUST message link} +@end example + For customizing Org to add new link types @ref{Adding hyperlink types}. -A link should be enclosed in double brackets and may contain a -descriptive text to be displayed instead of the URL (@pxref{Link -format}), for example: +A link should be enclosed in double brackets and may contain a descriptive +text to be displayed instead of the URL (@pxref{Link format}), for example: @example [[http://www.gnu.org/software/emacs/][GNU Emacs]] @@ -3349,15 +3588,14 @@ timestamp in the headline.}. @cindex property, ID If the headline has a @code{CUSTOM_ID} property, a link to this custom ID will be stored. In addition or alternatively (depending on the value of -@code{org-id-link-to-org-use-id}), a globally unique @code{ID} property will -be created and/or used to construct a link@footnote{The library @code{org-id} -must first be loaded, either through @code{org-customize} by enabling -@code{id} in @code{org-modules} , or by adding @code{(require 'org-id)} in -your @file{.emacs}.}. So using this command in Org -buffers will potentially create two links: a human-readable from the custom -ID, and one that is globally unique and works even if the entry is moved from -file to file. Later, when inserting the link, you need to decide which one -to use. +@var{org-id-link-to-org-use-id}), a globally unique @code{ID} property will +be created and/or used to construct a link@footnote{The library +@file{org-id.el} must first be loaded, either through @code{org-customize} by +enabling @code{org-id} in @code{org-modules}, or by adding @code{(require +'org-id)} in your @file{.emacs}.}. So using this command in Org buffers will +potentially create two links: a human-readable from the custom ID, and one +that is globally unique and works even if the entry is moved from file to +file. Later, when inserting the link, you need to decide which one to use. @b{Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus}@* Pretty much all Emacs mail clients are supported. The link will point to the @@ -3372,10 +3610,10 @@ Links created in a BBDB buffer will point to the current entry. @b{Chat: IRC}@* @vindex org-irc-link-to-logs -For IRC links, if you set the variable @code{org-irc-link-to-logs} to -@code{t}, a @samp{file:/} style link to the relevant point in the logs for -the current conversation is created. Otherwise an @samp{irc:/} style link to -the user/channel/server under the point will be stored. +For IRC links, if you set the option @var{org-irc-link-to-logs} to @code{t}, +a @samp{file:/} style link to the relevant point in the logs for the current +conversation is created. Otherwise an @samp{irc:/} style link to the +user/channel/server under the point will be stored. @b{Other files}@* For any other files, the link will point to the file, with a search string @@ -3406,7 +3644,7 @@ type prefixes mentioned in the examples above. The link will be inserted into the buffer@footnote{After insertion of a stored link, the link will be removed from the list of stored links. To keep it in the list later use, use a triple @kbd{C-u} prefix argument to @kbd{C-c C-l}, or configure the option -@code{org-keep-stored-link-after-insertion}.}, along with a descriptive text. +@var{org-keep-stored-link-after-insertion}.}, along with a descriptive text. If some text was selected when this command is called, the selected text becomes the default description. @@ -3453,16 +3691,16 @@ TAGS view. If the cursor is on a timestamp, it compiles the agenda for that date. Furthermore, it will visit text and remote files in @samp{file:} links with Emacs and select a suitable application for local non-text files. Classification of files is based on file extension only. See option -@code{org-file-apps}. If you want to override the default application and +@var{org-file-apps}. If you want to override the default application and visit the file with Emacs, use a @kbd{C-u} prefix. If you want to avoid opening in Emacs, use a @kbd{C-u C-u} prefix.@* If the cursor is on a headline, but not on a link, offer all links in the headline and entry text. If you want to setup the frame configuration for -following links, customize @code{org-link-frame-setup}. +following links, customize @var{org-link-frame-setup}. @orgkey @key{RET} @vindex org-return-follows-link -When @code{org-return-follows-link} is set, @kbd{@key{RET}} will also follow +When @var{org-return-follows-link} is set, @kbd{@key{RET}} will also follow the link at point. @c @kindex mouse-2 @@ -3477,7 +3715,7 @@ would. Under Emacs 22 and later, @kbd{mouse-1} will also follow a link. @vindex org-display-internal-link-with-indirect-buffer Like @kbd{mouse-2}, but force file links to be opened with Emacs, and internal links to be displayed in another window@footnote{See the -variable @code{org-display-internal-link-with-indirect-buffer}}. +option @var{org-display-internal-link-with-indirect-buffer}}. @c @orgcmd{C-c C-x C-v,org-toggle-inline-images} @cindex inlining images @@ -3490,7 +3728,7 @@ images that have no description part in the link, i.e., images that will also be inlined during export. When called with a prefix argument, also display images that do have a link description. You can ask for inline images to be displayed at startup by configuring the variable -@code{org-startup-with-inline-images}@footnote{with corresponding +@var{org-startup-with-inline-images}@footnote{with corresponding @code{#+STARTUP} keywords @code{inlineimages} and @code{inlineimages}}. @orgcmd{C-c %,org-mark-ring-push} @cindex mark ring @@ -3549,7 +3787,7 @@ abbreviated link looks like this where the tag is optional. The @i{linkword} must be a word, starting with a letter, followed by letters, numbers, @samp{-}, and @samp{_}. Abbreviations are resolved -according to the information in the variable @code{org-link-abbrev-alist} +according to the information in the variable @var{org-link-abbrev-alist} that relates the linkwords to replacement text. Here is an example: @smalllisp @@ -3670,8 +3908,8 @@ If you come across such a problem, you can write custom functions to set the right search string for a particular file type, and to do the search for the string in the file. Using @code{add-hook}, these functions need to be added to the hook variables -@code{org-create-file-search-functions} and -@code{org-execute-file-search-functions}. See the docstring for these +@var{org-create-file-search-functions} and +@var{org-execute-file-search-functions}. See the docstring for these variables for more information. Org actually uses this mechanism for Bib@TeX{} database files, and you can use the corresponding code as an implementation example. See the file @file{org-bibtex.el}. @@ -3729,7 +3967,7 @@ Rotate the TODO state of the current item among If TODO keywords have fast access keys (see @ref{Fast access to TODO states}), you will be prompted for a TODO keyword through the fast selection interface; this is the default behavior when -@var{org-use-fast-todo-selection} is @code{non-nil}. +@var{org-use-fast-todo-selection} is non-@code{nil}. The same rotation can also be done ``remotely'' from the timeline and agenda buffers with the @kbd{t} command key (@pxref{Agenda commands}). @@ -3748,19 +3986,18 @@ Select the following/preceding TODO state, similar to cycling. Useful mostly if more than two TODO states are possible (@pxref{TODO extensions}). See also @ref{Conflicts}, for a discussion of the interaction with @code{shift-selection-mode}. See also the variable -@code{org-treat-S-cursor-todo-selection-as-state-change}. +@var{org-treat-S-cursor-todo-selection-as-state-change}. @orgcmd{C-c / t,org-show-todo-tree} @cindex sparse tree, for TODO @vindex org-todo-keywords View TODO items in a @emph{sparse tree} (@pxref{Sparse trees}). Folds the entire buffer, but shows all TODO items (with not-DONE state) and the headings hierarchy above them. With a prefix argument (or by using @kbd{C-c -/ T}), search for a specific TODO@. You will be prompted for the keyword, and -you can also give a list of keywords like @code{KWD1|KWD2|...} to list +/ T}), search for a specific TODO@. You will be prompted for the keyword, +and you can also give a list of keywords like @code{KWD1|KWD2|...} to list entries that match any one of these keywords. With a numeric prefix argument -N, show the tree for the Nth keyword in the variable -@code{org-todo-keywords}. With two prefix arguments, find all TODO states, -both un-done and done. +N, show the tree for the Nth keyword in the option @var{org-todo-keywords}. +With two prefix arguments, find all TODO states, both un-done and done. @orgcmd{C-c a t,org-todo-list} Show the global TODO list. Collects the TODO items (with not-DONE states) from all agenda files (@pxref{Agenda Views}) into a single buffer. The new @@ -3774,7 +4011,7 @@ Insert a new TODO entry below the current one. @noindent @vindex org-todo-state-tags-triggers Changing a TODO state can also trigger tag changes. See the docstring of the -option @code{org-todo-state-tags-triggers} for details. +option @var{org-todo-state-tags-triggers} for details. @node TODO extensions, Progress logging, TODO basics, TODO Items @section Extended use of TODO keywords @@ -3783,7 +4020,7 @@ option @code{org-todo-state-tags-triggers} for details. @vindex org-todo-keywords By default, marked TODO entries have one of only two states: TODO and DONE@. Org mode allows you to classify TODO items in more complex ways -with @emph{TODO keywords} (stored in @code{org-todo-keywords}). With +with @emph{TODO keywords} (stored in @var{org-todo-keywords}). With special setup, the TODO keyword system can work differently in different files. @@ -3931,8 +4168,8 @@ each keyword, in parentheses@footnote{All characters are allowed except @vindex org-fast-tag-selection-include-todo If you then press @kbd{C-c C-t} followed by the selection key, the entry will be switched to this state. @kbd{SPC} can be used to remove any TODO -keyword from an entry.@footnote{Check also the variable -@code{org-fast-tag-selection-include-todo}, it allows you to change the TODO +keyword from an entry.@footnote{Check also the option +@var{org-fast-tag-selection-include-todo}, it allows you to change the TODO state through the tags interface (@pxref{Setting tags}), in case you like to mingle the two concepts. Note that this means you need to come up with unique keys across both sets of keywords.} @@ -3995,8 +4232,8 @@ Org mode highlights TODO keywords with special faces: @code{org-todo} for keywords indicating that an item still has to be acted upon, and @code{org-done} for keywords indicating that an item is finished. If you are using more than 2 different states, you might want to use -special faces for some of them. This can be done using the variable -@code{org-todo-keyword-faces}. For example: +special faces for some of them. This can be done using the option +@var{org-todo-keyword-faces}. For example: @lisp @group @@ -4008,8 +4245,8 @@ special faces for some of them. This can be done using the variable While using a list with face properties as shown for CANCELED @emph{should} work, this does not always seem to be the case. If necessary, define a -special face and use that. A string is interpreted as a color. The variable -@code{org-faces-easy-properties} determines if that color is interpreted as a +special face and use that. A string is interpreted as a color. The option +@var{org-faces-easy-properties} determines if that color is interpreted as a foreground or a background color. @node TODO dependencies, , Faces for TODO keywords, TODO extensions @@ -4024,7 +4261,7 @@ dependencies. Usually, a parent TODO task should not be marked DONE until all subtasks (defined as children tasks) are marked as DONE@. And sometimes there is a logical sequence to a number of (sub)tasks, so that one task cannot be acted upon before all siblings above it are done. If you customize -the variable @code{org-enforce-todo-dependencies}, Org will block entries +the option @var{org-enforce-todo-dependencies}, Org will block entries from changing state to DONE while they have children that are not DONE@. Furthermore, if an entry has a property @code{ORDERED}, each of its children will be blocked until all earlier siblings are marked DONE@. Here is an @@ -4051,22 +4288,22 @@ example: Toggle the @code{ORDERED} property of the current entry. A property is used for this behavior because this should be local to the current entry, not inherited like a tag. However, if you would like to @i{track} the value of -this property with a tag for better visibility, customize the variable -@code{org-track-ordered-property-with-tag}. +this property with a tag for better visibility, customize the option +@var{org-track-ordered-property-with-tag}. @orgkey{C-u C-u C-u C-c C-t} Change TODO state, circumventing any state blocking. @end table @vindex org-agenda-dim-blocked-tasks -If you set the variable @code{org-agenda-dim-blocked-tasks}, TODO entries +If you set the option @var{org-agenda-dim-blocked-tasks}, TODO entries that cannot be closed because of such dependencies will be shown in a dimmed font or even made invisible in agenda views (@pxref{Agenda Views}). @cindex checkboxes and TODO dependencies @vindex org-enforce-todo-dependencies You can also block changes of TODO states by looking at checkboxes -(@pxref{Checkboxes}). If you set the variable -@code{org-enforce-todo-checkbox-dependencies}, an entry that has unchecked +(@pxref{Checkboxes}). If you set the option +@var{org-enforce-todo-checkbox-dependencies}, an entry that has unchecked checkboxes will be blocked from switching to DONE. If you need more complex dependency structures, for example dependencies @@ -4103,13 +4340,17 @@ in-buffer setting is: @code{#+STARTUP: logdone}} (setq org-log-done 'time) @end lisp +@vindex org-closed-keep-when-no-todo @noindent -Then each time you turn an entry from a TODO (not-done) state into any -of the DONE states, a line @samp{CLOSED: [timestamp]} will be inserted -just after the headline. If you turn the entry back into a TODO item -through further state cycling, that line will be removed again. If you -want to record a note along with the timestamp, use@footnote{The -corresponding in-buffer setting is: @code{#+STARTUP: lognotedone}} +Then each time you turn an entry from a TODO (not-done) state into any of the +DONE states, a line @samp{CLOSED: [timestamp]} will be inserted just after +the headline. If you turn the entry back into a TODO item through further +state cycling, that line will be removed again. If you turn the entry back +to a non-TODO state (by pressing @key{C-c C-t SPC} for example), that line +will also be removed, unless you set @var{org-closed-keep-when-no-todo} to +non-@code{nil}. If you want to record a note along with the timestamp, +use@footnote{The corresponding in-buffer setting is: @code{#+STARTUP: +lognotedone}.} @lisp (setq org-log-done 'note) @@ -4135,11 +4376,11 @@ When TODO keywords are used as workflow states (@pxref{Workflow states}), you might want to keep track of when a state change occurred and maybe take a note about this change. You can either record just a timestamp, or a time-stamped note for a change. These records will be inserted after the -headline as an itemized list, newest first@footnote{See the variable -@code{org-log-states-order-reversed}}. When taking a lot of notes, you might +headline as an itemized list, newest first@footnote{See the option +@var{org-log-states-order-reversed}}. When taking a lot of notes, you might want to get the notes out of the way into a drawer (@pxref{Drawers}). -Customize the variable @code{org-log-into-drawer} to get this behavior---the -recommended drawer for this is called @code{LOGBOOK}@footnote{Note that the +Customize @var{org-log-into-drawer} to get this behavior---the recommended +drawer for this is called @code{LOGBOOK}@footnote{Note that the @code{LOGBOOK} drawer is unfolded when pressing @key{SPC} in the agenda to show an entry---use @key{C-u SPC} to keep it folded here}. You can also overrule the setting of this variable for a subtree by setting a @@ -4164,7 +4405,7 @@ To record a timestamp without a note for TODO keywords configured with you not only define global TODO keywords and fast access keys, but also request that a time is recorded when the entry is set to DONE@footnote{It is possible that Org mode will record two timestamps -when you are using both @code{org-log-done} and state change logging. +when you are using both @var{org-log-done} and state change logging. However, it will never prompt for two notes---if you have configured both, the state change recording note will take precedence and cancel the @samp{Closing Note}.}, and that a note is recorded when switching to @@ -4187,7 +4428,7 @@ to a buffer: @cindex property, LOGGING In order to define logging settings that are local to a subtree or a single item, define a LOGGING property in this entry. Any non-empty -LOGGING property resets all logging settings to nil. You may then turn +LOGGING property resets all logging settings to @code{nil}. You may then turn on logging for this specific tree using STARTUP keywords like @code{lognotedone} or @code{logrepeat}, as well as adding state specific settings like @code{TODO(!)}. For example @@ -4216,8 +4457,7 @@ called ``habits''. A habit has the following properties: @enumerate @item -You have enabled the @code{habits} module by customizing the variable -@code{org-modules}. +You have enabled the @code{habits} module by customizing @var{org-modules}. @item The habit is a TODO item, with a TODO keyword representing an open state. @item @@ -4299,7 +4539,7 @@ The amount of history, in days before today, to appear in consistency graphs. @item org-habit-following-days The number of days after today that will appear in consistency graphs. @item org-habit-show-habits-only-for-today -If non-nil, only show habits in today's agenda view. This is set to true by +If non-@code{nil}, only show habits in today's agenda view. This is set to true by default. @end table @@ -4327,7 +4567,7 @@ By default, Org mode supports three priorities: @samp{A}, @samp{B}, and treated just like priority @samp{B}. Priorities make a difference only for sorting in the agenda (@pxref{Weekly/daily agenda}); outside the agenda, they have no inherent meaning to Org mode. The cookies can be highlighted with -special faces by customizing the variable @code{org-priority-faces}. +special faces by customizing @var{org-priority-faces}. Priorities can be attached to any outline node; they do not need to be TODO items. @@ -4345,7 +4585,7 @@ and agenda buffer with the @kbd{,} command (@pxref{Agenda commands}). @orgcmdkkcc{S-@key{up},S-@key{down},org-priority-up,org-priority-down} @vindex org-priority-start-cycle-with-default Increase/decrease priority of current headline@footnote{See also the option -@code{org-priority-start-cycle-with-default}.}. Note that these keys are +@var{org-priority-start-cycle-with-default}.}. Note that these keys are also used to modify timestamps (@pxref{Creating timestamps}). See also @ref{Conflicts}, for a discussion of the interaction with @code{shift-selection-mode}. @@ -4354,9 +4594,9 @@ also used to modify timestamps (@pxref{Creating timestamps}). See also @vindex org-highest-priority @vindex org-lowest-priority @vindex org-default-priority -You can change the range of allowed priorities by setting the variables -@code{org-highest-priority}, @code{org-lowest-priority}, and -@code{org-default-priority}. For an individual buffer, you may set +You can change the range of allowed priorities by setting the options +@var{org-highest-priority}, @var{org-lowest-priority}, and +@var{org-default-priority}. For an individual buffer, you may set these values (highest, lowest, default) like this (please make sure that the highest priority is earlier in the alphabet than the lowest priority): @@ -4375,7 +4615,7 @@ priority): It is often advisable to break down large tasks into smaller, manageable subtasks. You can do this by creating an outline tree below a TODO item, with detailed subtasks on the tree@footnote{To keep subtasks out of the -global TODO list, see the @code{org-agenda-todo-list-sublevels}.}. To keep +global TODO list, see the @var{org-agenda-todo-list-sublevels}.}. To keep the overview over the fraction of subtasks that are already completed, insert either @samp{[/]} or @samp{[%]} anywhere in the headline. These cookies will be updated each time the TODO status of a child changes, or when pressing @@ -4398,8 +4638,8 @@ this issue. @vindex org-hierarchical-todo-statistics If you would like to have the statistics cookie count any TODO entries in the -subtree (not just direct children), configure the variable -@code{org-hierarchical-todo-statistics}. To do this for a single subtree, +subtree (not just direct children), configure +@var{org-hierarchical-todo-statistics}. To do this for a single subtree, include the word @samp{recursive} into the value of the @code{COOKIE_DATA} property. @@ -4433,7 +4673,7 @@ large number of subtasks (@pxref{Checkboxes}). @vindex org-list-automatic-rules Every item in a plain list@footnote{With the exception of description -lists. But you can allow it by modifying @code{org-list-automatic-rules} +lists. But you can allow it by modifying @var{org-list-automatic-rules} accordingly.} (@pxref{Plain lists}) can be made into a checkbox by starting it with the string @samp{[ ]}. This feature is similar to TODO items (@pxref{TODO Items}), but is more lightweight. Checkboxes are not included @@ -4463,15 +4703,15 @@ checked. @cindex statistics, for checkboxes @cindex checkbox statistics @cindex property, COOKIE_DATA -@vindex org-hierarchical-checkbox-statistics +@vindex org-checkbox-hierarchical-statistics The @samp{[2/4]} and @samp{[1/3]} in the first and second line are cookies indicating how many checkboxes present in this entry have been checked off, and the total number of checkboxes present. This can give you an idea on how many checkboxes remain, even without opening a folded entry. The cookies can be placed into a headline or into (the first line of) a plain list item. Each cookie covers checkboxes of direct children structurally below the -headline/item on which the cookie appears@footnote{Set the variable -@code{org-hierarchical-checkbox-statistics} if you want such cookies to +headline/item on which the cookie appears@footnote{Set the option +@var{org-checkbox-hierarchical-statistics} if you want such cookies to count all checkboxes below the cookie, not just those belonging to direct children.}. You have to insert the cookie yourself by typing either @samp{[/]} or @samp{[%]}. With @samp{[/]} you get an @samp{n out of m} @@ -4523,8 +4763,7 @@ Toggle the @code{ORDERED} property of the entry, to toggle if checkboxes must be checked off in sequence. A property is used for this behavior because this should be local to the current entry, not inherited like a tag. However, if you would like to @i{track} the value of this property with a tag -for better visibility, customize the variable -@code{org-track-ordered-property-with-tag}. +for better visibility, customize @var{org-track-ordered-property-with-tag}. @orgcmd{C-c #,org-update-statistics-cookies} Update the statistics cookie in the current outline entry. When called with a @kbd{C-u} prefix, update the entire file. Checkbox statistic cookies are @@ -4551,13 +4790,14 @@ headline. Tags are normal words containing letters, numbers, @samp{_}, and @samp{@@}. Tags must be preceded and followed by a single colon, e.g., @samp{:work:}. Several tags can be specified, as in @samp{:work:urgent:}. Tags will by default be in bold face with the same color as the headline. -You may specify special faces for specific tags using the variable -@code{org-tag-faces}, in much the same way as you can for TODO keywords +You may specify special faces for specific tags using the option +@var{org-tag-faces}, in much the same way as you can for TODO keywords (@pxref{Faces for TODO keywords}). @menu * Tag inheritance:: Tags use the tree structure of the outline * Setting tags:: How to assign tags to a headline +* Tag groups:: Use one tag to search for several tags * Tag searches:: Searching for combinations of tags @end menu @@ -4594,8 +4834,8 @@ changes in the line.}: @noindent @vindex org-use-tag-inheritance @vindex org-tags-exclude-from-inheritance -To limit tag inheritance to specific tags, use @code{org-tags-exclude-from-inheritance}. -To turn it off entirely, use @code{org-use-tag-inheritance}. +To limit tag inheritance to specific tags, use @var{org-tags-exclude-from-inheritance}. +To turn it off entirely, use @var{org-use-tag-inheritance}. @vindex org-tags-match-list-sublevels When a headline matches during a tags search while tag inheritance is turned @@ -4603,19 +4843,19 @@ on, all the sublevels in the same tree will (for a simple match form) match as well@footnote{This is only true if the search does not involve more complex tests including properties (@pxref{Property searches}).}. The list of matches may then become very long. If you only want to see the first tags -match in a subtree, configure the variable -@code{org-tags-match-list-sublevels} (not recommended). +match in a subtree, configure @var{org-tags-match-list-sublevels} (not +recommended). @vindex org-agenda-use-tag-inheritance Tag inheritance is relevant when the agenda search tries to match a tag, either in the @code{tags} or @code{tags-todo} agenda types. In other agenda -types, @code{org-use-tag-inheritance} has no effect. Still, you may want to +types, @var{org-use-tag-inheritance} has no effect. Still, you may want to have your tags correctly set in the agenda, so that tag filtering works fine, -with inherited tags. Set @code{org-agenda-use-tag-inheritance} to control -this: the default value includes all agenda types, but setting this to nil +with inherited tags. Set @var{org-agenda-use-tag-inheritance} to control +this: the default value includes all agenda types, but setting this to @code{nil} can really speed up agenda generation. -@node Setting tags, Tag searches, Tag inheritance, Tags +@node Setting tags, Tag groups, Tag inheritance, Tags @section Setting tags @cindex setting tags @cindex tags, setting @@ -4632,10 +4872,11 @@ also a special command for inserting tags: Enter new tags for the current headline. Org mode will either offer completion or a special single-key interface for setting tags, see below. After pressing @key{RET}, the tags will be inserted and aligned -to @code{org-tags-column}. When called with a @kbd{C-u} prefix, all +to @var{org-tags-column}. When called with a @kbd{C-u} prefix, all tags in the current buffer will be aligned to that column, just to make things look nice. TAGS are automatically realigned after promotion, demotion, and TODO state changes (@pxref{TODO basics}). + @orgcmd{C-c C-c,org-set-tags-command} When the cursor is in a headline, this does the same as @kbd{C-c C-q}. @end table @@ -4644,7 +4885,7 @@ When the cursor is in a headline, this does the same as @kbd{C-c C-q}. Org supports tag insertion based on a @emph{list of tags}. By default this list is constructed dynamically, containing all tags currently used in the buffer. You may also globally specify a hard list -of tags with the variable @code{org-tag-alist}. Finally you can set +of tags with the variable @var{org-tag-alist}. Finally you can set the default tags for a given file with lines like @cindex #+TAGS @@ -4654,7 +4895,7 @@ the default tags for a given file with lines like @end example If you have globally defined your preferred set of tags using the -variable @code{org-tag-alist}, but would like to use a dynamic tag list +variable @var{org-tag-alist}, but would like to use a dynamic tag list in a specific file, add an empty TAGS option line to that file: @example @@ -4665,7 +4906,7 @@ in a specific file, add an empty TAGS option line to that file: If you have a preferred set of tags that you would like to use in every file, in addition to those defined on a per-file basis by TAGS option lines, then you may specify a list of tags with the variable -@code{org-tag-persistent-alist}. You may turn this off on a per-file basis +@var{org-tag-persistent-alist}. You may turn this off on a per-file basis by adding a STARTUP option line to that file: @example @@ -4677,7 +4918,7 @@ entering tags. However, it also implements another, quicker, tag selection method called @emph{fast tag selection}. This allows you to select and deselect tags with just a single key press. For this to work well you should assign unique letters to most of your commonly used tags. You can do this -globally by configuring the variable @code{org-tag-alist} in your +globally by configuring the variable @var{org-tag-alist} in your @file{.emacs} file. For example, you may find the need to tag many items in different files with @samp{:@@home:}. In this case you can set something like: @@ -4723,7 +4964,7 @@ and @samp{@@tennisclub} should be selected. Multiple such groups are allowed. these lines to activate any changes. @noindent -To set these mutually exclusive groups in the variable @code{org-tags-alist}, +To set these mutually exclusive groups in the variable @var{org-tag-alist}, you must use the dummy tags @code{:startgroup} and @code{:endgroup} instead of the braces. Similarly, you can use @code{:newline} to indicate a line break. The previous example would be set globally by the following @@ -4786,17 +5027,58 @@ alternatively with @kbd{C-c C-c C-c w}. Adding the non-predefined tag @vindex org-fast-tag-selection-single-key If you find that most of the time you need only a single key press to -modify your list of tags, set the variable -@code{org-fast-tag-selection-single-key}. Then you no longer have to -press @key{RET} to exit fast tag selection---it will immediately exit -after the first change. If you then occasionally need more keys, press -@kbd{C-c} to turn off auto-exit for the current tag selection process -(in effect: start selection with @kbd{C-c C-c C-c} instead of @kbd{C-c -C-c}). If you set the variable to the value @code{expert}, the special -window is not even shown for single-key tag selection, it comes up only -when you press an extra @kbd{C-c}. +modify your list of tags, set @var{org-fast-tag-selection-single-key}. +Then you no longer have to press @key{RET} to exit fast tag selection---it +will immediately exit after the first change. If you then occasionally +need more keys, press @kbd{C-c} to turn off auto-exit for the current tag +selection process (in effect: start selection with @kbd{C-c C-c C-c} +instead of @kbd{C-c C-c}). If you set the variable to the value +@code{expert}, the special window is not even shown for single-key tag +selection, it comes up only when you press an extra @kbd{C-c}. -@node Tag searches, , Setting tags, Tags +@node Tag groups, Tag searches, Setting tags, Tags +@section Tag groups + +@cindex group tags +@cindex tags, groups +In a set of mutually exclusive tags, the first tag can be defined as a +@emph{group tag}. When you search for a group tag, it will return matches +for all members in the group. In an agenda view, filtering by a group tag +will display headlines tagged with at least one of the members of the +group. This makes tag searches and filters even more flexible. + +You can set group tags by inserting a colon between the group tag and other +tags---beware that all whitespaces are mandatory so that Org can parse this +line correctly: + +@example +#+TAGS: @{ @@read : @@read_book @@read_ebook @} +@end example + +In this example, @samp{@@read} is a @emph{group tag} for a set of three +tags: @samp{@@read}, @samp{@@read_book} and @samp{@@read_ebook}. + +You can also use the @code{:grouptags} keyword directly when setting +@var{org-tag-alist}: + +@lisp +(setq org-tag-alist '((:startgroup . nil) + ("@@read" . nil) + (:grouptags . nil) + ("@@read_book" . nil) + ("@@read_ebook" . nil) + (:endgroup . nil))) +@end lisp + +You cannot nest group tags or use a group tag as a tag in another group. + +@kindex C-c C-x q +@vindex org-group-tags +If you want to ignore group tags temporarily, toggle group tags support +with @command{org-toggle-tags-groups}, bound to @kbd{C-c C-x q}. If you +want to disable tag groups completely, set @var{org-group-tags} to @code{nil}. + +@node Tag searches, , Tag groups, Tags @section Tag searches @cindex tag searches @cindex searching for tags @@ -4814,8 +5096,8 @@ Create a global list of tag matches from all agenda files. @orgcmd{C-c a M,org-tags-view} @vindex org-tags-match-list-sublevels Create a global list of tag matches from all agenda files, but check -only TODO items and force checking subitems (see variable -@code{org-tags-match-list-sublevels}). +only TODO items and force checking subitems (see the option +@var{org-tags-match-list-sublevels}). @end table These commands all prompt for a match string which allows basic Boolean logic @@ -4881,7 +5163,7 @@ first, and the value after it. Here is an example: :END: @end example -Depending on the value of @code{org-use-property-inheritance}, a property set +Depending on the value of @var{org-use-property-inheritance}, a property set this way will either be associated with a single entry, or the sub-tree defined by the entry, see @ref{Property inheritance}. @@ -4909,6 +5191,9 @@ file, use a line like #+PROPERTY: NDisks_ALL 1 2 3 4 @end example +Contrary to properties set from a special drawer, you have to refresh the +buffer with @kbd{C-c C-c} to activate this changes. + If you want to add to the value of an existing property, append a @code{+} to the property name. The following results in the property @code{var} having the value ``foo=1 bar=2''. @@ -4942,7 +5227,7 @@ Note that a property can only have one entry per Drawer. @vindex org-global-properties Property values set with the global variable -@code{org-global-properties} can be inherited by all entries in all +@var{org-global-properties} can be inherited by all entries in all Org files. @noindent @@ -4955,7 +5240,7 @@ in the current file will be offered as possible completions. @orgcmd{C-c C-x p,org-set-property} Set a property. This prompts for a property name and a value. If necessary, the property drawer is created as well. -@item C-u M-x org-insert-drawer +@item C-u M-x org-insert-drawer RET @cindex org-insert-drawer Insert a property drawer into the current entry. The drawer will be inserted early in the entry, but after the lines with planning @@ -5034,6 +5319,7 @@ FILE @r{The filename the entry is located in.} To create sparse trees and special lists with selection based on properties, the same commands are used as for tag searches (@pxref{Tag searches}). + @table @kbd @orgcmdkkc{C-c / m,C-c \\,org-match-sparse-tree} Create a sparse tree with all matching entries. With a @@ -5044,8 +5330,8 @@ Create a global list of tag/property matches from all agenda files. @orgcmd{C-c a M,org-tags-view} @vindex org-tags-match-list-sublevels Create a global list of tag matches from all agenda files, but check -only TODO items and force checking of subitems (see variable -@code{org-tags-match-list-sublevels}). +only TODO items and force checking of subitems (see the option +@var{org-tags-match-list-sublevels}). @end table The syntax for the search string is described in @ref{Matching tags and @@ -5075,10 +5361,10 @@ property, the children can inherit this property. Org mode does not turn this on by default, because it can slow down property searches significantly and is often not needed. However, if you find inheritance useful, you can turn it on by setting the variable -@code{org-use-property-inheritance}. It may be set to @code{t} to make +@var{org-use-property-inheritance}. It may be set to @code{t} to make all properties inherited from the parent, to a list of properties that should be inherited, or to a regular expression that matches -inherited properties. If a property has the value @samp{nil}, this is +inherited properties. If a property has the value @code{nil}, this is interpreted as an explicit undefine of the property, so that inheritance search will stop at this value and return @code{nil}. @@ -5276,7 +5562,7 @@ searches the hierarchy, up from point, for a @code{:COLUMNS:} property that defines a format. When one is found, the column view table is established for the tree starting at the entry that contains the @code{:COLUMNS:} property. If no such property is found, the format is taken from the -@code{#+COLUMNS} line or from the variable @code{org-columns-default-format}, +@code{#+COLUMNS} line or from the variable @var{org-columns-default-format}, and column view is established for the current entry and its subtree. @orgcmd{r,org-columns-redo} Recreate the column view, to include recent changes made in the buffer. @@ -5352,7 +5638,7 @@ global @r{make a global view, including all headings in the file} @r{run column view at the top of this file} "@var{ID}" @r{call column view in the tree that has an @code{:ID:}} @r{property with the value @i{label}. You can use} - @r{@kbd{M-x org-id-copy} to create a globally unique ID for} + @r{@kbd{M-x org-id-copy RET} to create a globally unique ID for} @r{the current entry and copy it to the kill-ring.} @end example @item :hlines @@ -5484,7 +5770,7 @@ For more complex date specifications, Org mode supports using the special sexp diary entries implemented in the Emacs calendar/diary package@footnote{When working with the standard diary sexp functions, you need to be very careful with the order of the arguments. That order depend -evilly on the variable @code{calendar-date-style} (or, for older Emacs +evilly on the variable @var{calendar-date-style} (or, for older Emacs versions, @code{european-calendar-style}). For example, to specify a date December 12, 2005, the call might look like @code{(diary-date 12 1 2005)} or @code{(diary-date 1 12 2005)} or @code{(diary-date 2005 12 1)}, depending on @@ -5492,7 +5778,7 @@ the settings. This has been the source of much confusion. Org mode users can resort to special versions of these functions like @code{org-date} or @code{org-anniversary}. These work just like the corresponding @code{diary-} functions, but with stable ISO order of arguments (year, month, day) wherever -applicable, independent of the value of @code{calendar-date-style}.}. For +applicable, independent of the value of @var{calendar-date-style}.}. For example with optional time @example @@ -5553,7 +5839,7 @@ an agenda entry. @vindex org-time-stamp-rounding-minutes Like @kbd{C-c .} and @kbd{C-c !}, but use the alternative format which contains date and time. The default time can be rounded to multiples of 5 -minutes, see the option @code{org-time-stamp-rounding-minutes}. +minutes, see the option @var{org-time-stamp-rounding-minutes}. @c @orgkey{C-c C-c} Normalize timestamp, insert/fix day name if missing or wrong. @@ -5605,10 +5891,9 @@ the following column). @vindex org-read-date-prefer-future When Org mode prompts for a date/time, the default is shown in default date/time format, and the prompt therefore seems to ask for a specific -format. But it will in fact accept any string containing some date and/or -time information, and it is really smart about interpreting your input. You -can, for example, use @kbd{C-y} to paste a (possibly multi-line) string -copied from an email message. Org mode will find whatever information is in +format. But it will in fact accept date/time information in a variety of +formats. Generally, the information should start at the beginning of the +string. Org mode will find whatever information is in there and derive anything you have not specified from the @emph{default date and time}. The default is usually the current date and time, but when modifying an existing timestamp, or when entering the second stamp of a @@ -5616,7 +5901,7 @@ range, it is taken from the stamp in the buffer. When filling in information, Org mode assumes that most of the time you will want to enter a date in the future: if you omit the month/year and the given day/month is @i{before} today, it will assume that you mean a future date@footnote{See the -variable @code{org-read-date-prefer-future}. You may set that variable to +variable @var{org-read-date-prefer-future}. You may set that variable to the symbol @code{time} to even make a time before now shift the date to tomorrow.}. If the date has been automatically shifted into the future, the time prompt will show this with @samp{(=>F).} @@ -5631,7 +5916,7 @@ in @b{bold}. 14 @result{} @b{2006}-@b{06}-14 12 @result{} @b{2006}-@b{07}-12 2/5 @result{} @b{2007}-02-05 -Fri @result{} nearest Friday (default date or later) +Fri @result{} nearest Friday after the default date sep 15 @result{} @b{2006}-09-15 feb 15 @result{} @b{2007}-02-15 sep 12 9 @result{} 2009-09-12 @@ -5642,13 +5927,12 @@ w4 @result{} ISO week for of the current year @b{2006} 2012-w04-5 @result{} Same as above @end example -Furthermore you can specify a relative date by giving, as the -@emph{first} thing in the input: a plus/minus sign, a number and a -letter ([dwmy]) to indicate change in days, weeks, months, or years. With a -single plus or minus, the date is always relative to today. With a -double plus or minus, it is relative to the default date. If instead of -a single letter, you use the abbreviation of day name, the date will be -the Nth such day, e.g.: +Furthermore you can specify a relative date by giving, as the @emph{first} +thing in the input: a plus/minus sign, a number and a letter ([hdwmy]) to +indicate change in hours, days, weeks, months, or years. With a single plus +or minus, the date is always relative to today. With a double plus or minus, +it is relative to the default date. If instead of a single letter, you use +the abbreviation of day name, the date will be the Nth such day, e.g.: @example +0 @result{} today @@ -5657,21 +5941,22 @@ the Nth such day, e.g.: +4 @result{} same as above +2w @result{} two weeks from today ++5 @result{} five days from default date -+2tue @result{} second Tuesday from now. ++2tue @result{} second Tuesday from now +-wed @result{} last Wednesday @end example @vindex parse-time-months @vindex parse-time-weekdays The function understands English month and weekday abbreviations. If you want to use unabbreviated names and/or other languages, configure -the variables @code{parse-time-months} and @code{parse-time-weekdays}. +the variables @var{parse-time-months} and @var{parse-time-weekdays}. @vindex org-read-date-force-compatible-dates Not all dates can be represented in a given Emacs implementation. By default Org mode forces dates into the compatibility range 1970--2037 which works on all Emacs implementations. If you want to use dates outside of this range, read the docstring of the variable -@code{org-read-date-force-compatible-dates}. +@var{org-read-date-force-compatible-dates}. You can specify a time range by giving start and end times or by giving a start time and a duration (in HH:MM format). Use one or two dash(es) as the @@ -5688,7 +5973,7 @@ case, e.g.: @vindex org-popup-calendar-for-date-prompt Parallel to the minibuffer prompt, a calendar is popped up@footnote{If you don't need/want the calendar, configure the variable -@code{org-popup-calendar-for-date-prompt}.}. When you exit the date +@var{org-popup-calendar-for-date-prompt}.}. When you exit the date prompt, either by clicking on a date in the calendar, or by pressing @key{RET}, the date selected in the calendar will be combined with the information entered at the prompt. You can control the calendar fully @@ -5721,8 +6006,8 @@ The actions of the date/time prompt may seem complex, but I assure you they will grow on you, and you will start getting annoyed by pretty much any other way of entering a date/time out there. To help you understand what is going on, the current interpretation of your input will be displayed live in the -minibuffer@footnote{If you find this distracting, turn the display of with -@code{org-read-date-display-live}.}. +minibuffer@footnote{If you find this distracting, turn the display off with +@var{org-read-date-display-live}.}. @node Custom time format, , The date/time prompt, Creating timestamps @subsection Custom time format @@ -5735,8 +6020,8 @@ minibuffer@footnote{If you find this distracting, turn the display of with Org mode uses the standard ISO notation for dates and times as it is defined in ISO 8601. If you cannot get used to this and require another representation of date and time to keep you happy, you can get it by -customizing the variables @code{org-display-custom-times} and -@code{org-time-stamp-custom-formats}. +customizing the options @var{org-display-custom-times} and +@var{org-time-stamp-custom-formats}. @table @kbd @orgcmd{C-c C-x C-t,org-toggle-time-stamp-overlays} @@ -5785,10 +6070,11 @@ Meaning: the task (most likely a TODO item, though not necessarily) is supposed to be finished on that date. @vindex org-deadline-warning-days +@vindex org-agenda-skip-deadline-prewarning-if-scheduled On the deadline date, the task will be listed in the agenda. In addition, the agenda for @emph{today} will carry a warning about the approaching or missed deadline, starting -@code{org-deadline-warning-days} before the due date, and continuing +@var{org-deadline-warning-days} before the due date, and continuing until the entry is marked DONE@. An example: @example @@ -5799,7 +6085,9 @@ until the entry is marked DONE@. An example: You can specify a different lead time for warnings for a specific deadlines using the following syntax. Here is an example with a warning -period of 5 days @code{DEADLINE: <2004-02-29 Sun -5d>}. +period of 5 days @code{DEADLINE: <2004-02-29 Sun -5d>}. This warning is +deactivated if the task get scheduled and you set +@var{org-agenda-skip-deadline-prewarning-if-scheduled} to @code{t}. @item SCHEDULED @cindex SCHEDULED keyword @@ -5810,7 +6098,7 @@ date. @vindex org-agenda-skip-scheduled-if-done The headline will be listed under the given date@footnote{It will still be listed on that date after it has been marked DONE@. If you don't like -this, set the variable @code{org-agenda-skip-scheduled-if-done}.}. In +this, set the variable @var{org-agenda-skip-scheduled-if-done}.}. In addition, a reminder that the scheduled date has passed will be present in the compilation for @emph{today}, until the entry is marked DONE, i.e., the task will automatically be forwarded until completed. @@ -5820,6 +6108,17 @@ the task will automatically be forwarded until completed. SCHEDULED: <2004-12-25 Sat> @end example +@vindex org-scheduled-delay-days +@vindex org-agenda-skip-scheduled-delay-if-deadline +If you want to @emph{delay} the display of this task in the agenda, use +@code{SCHEDULED: <2004-12-25 Sat -2d>}: the task is still scheduled on the +25th but will appear two days later. In case the task contains a repeater, +the delay is considered to affect all occurrences; if you want the delay to +only affect the first scheduled occurrence of the task, use @code{--2d} +instead. See @var{org-scheduled-delay-days} and +@var{org-agenda-skip-scheduled-delay-if-deadline} for details on how to +control this globally or per agenda. + @noindent @b{Important:} Scheduling an item in Org mode should @i{not} be understood in the same way that we understand @i{scheduling a meeting}. @@ -5861,7 +6160,7 @@ an item: Insert @samp{DEADLINE} keyword along with a stamp. The insertion will happen in the line directly following the headline. Any CLOSED timestamp will be removed. When called with a prefix arg, an existing deadline will be removed -from the entry. Depending on the variable @code{org-log-redeadline}@footnote{with corresponding +from the entry. Depending on the variable @var{org-log-redeadline}@footnote{with corresponding @code{#+STARTUP} keywords @code{logredeadline}, @code{lognoteredeadline}, and @code{nologredeadline}}, a note will be taken when changing an existing deadline. @@ -5871,7 +6170,7 @@ Insert @samp{SCHEDULED} keyword along with a stamp. The insertion will happen in the line directly following the headline. Any CLOSED timestamp will be removed. When called with a prefix argument, remove the scheduling date from the entry. Depending on the variable -@code{org-log-reschedule}@footnote{with corresponding @code{#+STARTUP} +@var{org-log-reschedule}@footnote{with corresponding @code{#+STARTUP} keywords @code{logreschedule}, @code{lognotereschedule}, and @code{nologreschedule}}, a note will be taken when changing an existing scheduling time. @@ -5888,7 +6187,7 @@ schedule the marked item. @cindex sparse tree, for deadlines @vindex org-deadline-warning-days Create a sparse tree with all deadlines that are either past-due, or -which will become due within @code{org-deadline-warning-days}. +which will become due within @var{org-deadline-warning-days}. With @kbd{C-u} prefix, show all deadlines in the file. With a numeric prefix, check that many days. For example, @kbd{C-1 C-c / d} shows all deadlines due tomorrow. @@ -5936,7 +6235,7 @@ way: When you try to mark such an entry DONE (using @kbd{C-c C-t}), it will shift the base date of the repeating timestamp by the repeater interval, and immediately set the entry state back to TODO@footnote{In fact, the target state is taken from, in this sequence, the @code{REPEAT_TO_STATE} property or -the variable @code{org-todo-repeat-to-state}. If neither of these is +the variable @var{org-todo-repeat-to-state}. If neither of these is specified, the target state defaults to the first state of the TODO state sequence.}. In the example above, setting the state to DONE would actually switch the date like this: @@ -5948,7 +6247,7 @@ switch the date like this: @vindex org-log-repeat A timestamp@footnote{You can change this using the option -@code{org-log-repeat}, or the @code{#+STARTUP} options @code{logrepeat}, +@var{org-log-repeat}, or the @code{#+STARTUP} options @code{logrepeat}, @code{lognoterepeat}, and @code{nologrepeat}. With @code{lognoterepeat}, you will also be prompted for a note.} will be added under the deadline, to keep a record that you actually acted on the previous instance of this deadline. @@ -5980,8 +6279,14 @@ special repeaters @samp{++} and @samp{.+}. For example: today. @end example -You may have both scheduling and deadline information for a specific -task---just make sure that the repeater intervals on both are the same. +@vindex org-agenda-skip-scheduled-if-deadline-is-shown +You may have both scheduling and deadline information for a specific task. +If the repeater is set for the scheduling information only, you probably want +the repeater to be ignored after the deadline. If so, set the variable +@var{org-agenda-skip-scheduled-if-deadline-is-shown} to +@code{repeated-after-deadline}. If you want both scheduling and deadline +information to repeat after the same interval, set the same repeater for both +timestamps. An alternative to using a repeater is to create a number of copies of a task subtree, with dates shifted in each copy. The command @kbd{C-c C-x c} was @@ -6032,7 +6337,7 @@ Start the clock on the current item (clock-in). This inserts the CLOCK keyword together with a timestamp. If this is not the first clocking of this item, the multiple CLOCK lines will be wrapped into a @code{:LOGBOOK:} drawer (see also the variable -@code{org-clock-into-drawer}). You can also overrule +@var{org-clock-into-drawer}). You can also overrule the setting of this variable for a subtree by setting a @code{CLOCK_INTO_DRAWER} or @code{LOG_INTO_DRAWER} property. When called with a @kbd{C-u} prefix argument, @@ -6049,16 +6354,16 @@ line, along with the title of the task. The clock time shown will be all time ever clocked for this task and its children. If the task has an effort estimate (@pxref{Effort estimates}), the mode line displays the current clocking time against it@footnote{To add an effort estimate ``on the fly'', -hook a function doing this to @code{org-clock-in-prepare-hook}.} If the task +hook a function doing this to @var{org-clock-in-prepare-hook}.} If the task is a repeating one (@pxref{Repeated tasks}), only the time since the last reset of the task @footnote{as recorded by the @code{LAST_REPEAT} property} will be shown. More control over what time is shown can be exercised with the @code{CLOCK_MODELINE_TOTAL} property. It may have the values @code{current} to show only the current clocking instance, @code{today} to show all time clocked on this tasks today (see also the variable -@code{org-extend-today-until}), @code{all} to include all time, or +@var{org-extend-today-until}), @code{all} to include all time, or @code{auto} which is the default@footnote{See also the variable -@code{org-clock-modeline-total}.}.@* Clicking with @kbd{mouse-1} onto the +@var{org-clock-modeline-total}.}.@* Clicking with @kbd{mouse-1} onto the mode line entry will pop up a menu with clocking options. @c @orgcmd{C-c C-x C-o,org-clock-out} @@ -6066,7 +6371,7 @@ mode line entry will pop up a menu with clocking options. Stop the clock (clock-out). This inserts another timestamp at the same location where the clock was last started. It also directly computes the resulting time in inserts it after the time range as @samp{=> -HH:MM}. See the variable @code{org-log-note-clock-out} for the +HH:MM}. See the variable @var{org-log-note-clock-out} for the possibility to record an additional note together with the clock-out timestamp@footnote{The corresponding in-buffer setting is: @code{#+STARTUP: lognoteclock-out}}. @@ -6108,7 +6413,7 @@ Display time summaries for each subtree in the current buffer. This puts overlays at the end of each headline, showing the total time recorded under that heading, including the time of any subheadings. You can use visibility cycling to study the tree, but the overlays disappear when you change the -buffer (see variable @code{org-remove-highlights-with-change}) or press +buffer (see variable @var{org-remove-highlights-with-change}) or press @kbd{C-c C-c}. @end table @@ -6162,7 +6467,7 @@ buffer with the @kbd{C-c C-x C-r} command: @vindex org-clocktable-defaults The @samp{BEGIN} line and specify a number of options to define the scope, structure, and formatting of the report. Defaults for all these options can -be configured in the variable @code{org-clocktable-defaults}. +be configured in the variable @var{org-clocktable-defaults}. @noindent First there are options that determine which clock entries are to be selected: @@ -6193,7 +6498,14 @@ be selected: thisyear, lastyear, thisyear-@var{N} @r{a relative year} @r{Use @kbd{S-@key{left}/@key{right}} keys to shift the time interval.} :tstart @r{A time string specifying when to start considering times.} + @r{Relative times like @code{"<-2w>"} can also be used. See} + @r{@ref{Matching tags and properties} for relative time syntax.} :tend @r{A time string specifying when to stop considering times.} + @r{Relative times like @code{""} can also be used. See} + @r{@ref{Matching tags and properties} for relative time syntax.} +:wstart @r{The starting day of the week. The default is 1 for monday.} +:mstart @r{The starting day of the month. The default 1 is for the first} + @r{day of the month.} :step @r{@code{week} or @code{day}, to split the table into chunks.} @r{To use this, @code{:block} or @code{:tstart}, @code{:tend} are needed.} :stepskip0 @r{Do not show steps that have zero time.} @@ -6207,7 +6519,7 @@ options are interpreted by the function @code{org-clocktable-write-default}, but you can specify your own function using the @code{:formatter} parameter. @example :emphasize @r{When @code{t}, emphasize level one and level two items.} -:lang @r{Language@footnote{Language terms can be set through the variable @code{org-clock-clocktable-language-setup}.} to use for descriptive cells like "Task".} +:lang @r{Language@footnote{Language terms can be set through the variable @var{org-clock-clocktable-language-setup}.} to use for descriptive cells like "Task".} :link @r{Link the item headlines in the table to their origins.} :narrow @r{An integer to limit the width of the headline column in} @r{the org table. If you write it like @samp{50!}, then the} @@ -6244,6 +6556,11 @@ only to fit it into the manual.} :tend "<2006-08-10 Thu 12:00>" #+END: clocktable @end example +A range starting a week ago and ending right now could be written as +@example +#+BEGIN: clocktable :tstart "<-1w>" :tend "" +#+END: clocktable +@end example A summary of the current subtree with % times would be @example #+BEGIN: clocktable :scope subtree :link t :formula % @@ -6261,6 +6578,7 @@ would be @subsubheading Resolving idle time @cindex resolve idle time +@vindex org-clock-x11idle-program-name @cindex idle, resolve, dangling If you clock in on a work item, and then walk away from your @@ -6269,17 +6587,19 @@ time you were away by either subtracting it from the current clock, or applying it to another one. @vindex org-clock-idle-time -By customizing the variable @code{org-clock-idle-time} to some integer, such +By customizing the variable @var{org-clock-idle-time} to some integer, such as 10 or 15, Emacs can alert you when you get back to your computer after being idle for that many minutes@footnote{On computers using Mac OS X, idleness is based on actual user idleness, not just Emacs' idle time. For X11, you can install a utility program @file{x11idle.c}, available in the -@code{contrib/scripts} directory of the Org git distribution, to get the same -general treatment of idleness. On other systems, idle time refers to Emacs -idle time only.}, and ask what you want to do with the idle time. There will -be a question waiting for you when you get back, indicating how much idle -time has passed (constantly updated with the current amount), as well as a -set of choices to correct the discrepancy: +@code{contrib/scripts} directory of the Org git distribution, or install the +@file{xprintidle} package and set it to the variable +@var{org-clock-x11idle-program-name} if you are running Debian, to get the +same general treatment of idleness. On other systems, idle time refers to +Emacs idle time only.}, and ask what you want to do with the idle time. +There will be a question waiting for you when you get back, indicating how +much idle time has passed (constantly updated with the current amount), as +well as a set of choices to correct the discrepancy: @table @kbd @item k @@ -6331,7 +6651,7 @@ clocks at any time using @kbd{M-x org-resolve-clocks RET} (or @kbd{C-c C-x C-z}) @vindex org-clock-continuously You may want to start clocking from the time when you clocked out the -previous task. To enable this systematically, set @code{org-clock-continuously} +previous task. To enable this systematically, set @var{org-clock-continuously} to @code{t}. Each time you clock in, Org retrieves the clock-out time of the last clocked entry for this session, and start the new clock from there. @@ -6350,7 +6670,7 @@ assign effort estimates to entries. If you are also clocking your work, you may later want to compare the planned effort with the actual working time, a great way to improve planning estimates. Effort estimates are stored in a special property @samp{Effort}@footnote{You may change the property being -used with the variable @code{org-effort-property}.}. You can set the effort +used with the variable @var{org-effort-property}.}. You can set the effort for an entry with the following commands: @table @kbd @@ -6377,7 +6697,7 @@ buffer you can use @vindex org-global-properties @vindex org-columns-default-format or, even better, you can set up these values globally by customizing the -variables @code{org-global-properties} and @code{org-columns-default-format}. +variables @var{org-global-properties} and @var{org-columns-default-format}. In particular if you want to use this setup also in the agenda, a global setup may be advised. @@ -6392,7 +6712,7 @@ will summarize the estimated work effort for each day@footnote{Please note the pitfalls of summing hierarchical data in a flat list (@pxref{Agenda column view}).}, and you can use this to find space in your schedule. To get an overview of the entire part of the day that is committed, you can set the -option @code{org-agenda-columns-add-appointments-to-effort-sum}. The +option @var{org-agenda-columns-add-appointments-to-effort-sum}. The appointments on a day that take place over a specified time interval will then also be added to the load estimate of the day. @@ -6471,7 +6791,7 @@ trees to an archive file keeps the system compact and fast. * Attachments:: Add files to tasks * RSS Feeds:: Getting input from RSS feeds * Protocols:: External (e.g., Browser) access to Emacs and Org -* Refiling notes:: Moving a tree from one place to another +* Refile and copy:: Moving/copying a tree from one place to another * Archiving:: What to do with finished projects @end menu @@ -6479,25 +6799,22 @@ trees to an archive file keeps the system compact and fast. @section Capture @cindex capture -Org's method for capturing new items is heavily inspired by John Wiegley -excellent remember package. Up to version 6.36 Org used a special setup -for @file{remember.el}. @file{org-remember.el} is still part of Org mode for -backward compatibility with existing setups. You can find the documentation -for org-remember at @url{http://orgmode.org/org-remember.pdf}. +Capture lets you quickly store notes with little interruption of your work +flow. Org's method for capturing new items is heavily inspired by John +Wiegley excellent @file{remember.el} package. Up to version 6.36, Org +used a special setup for @file{remember.el}, then replaced it with +@file{org-remember.el}. As of version 8.0, @file{org-remember.el} has +been completely replaced by @file{org-capture.el}. -The new capturing setup described here is preferred and should be used by new -users. To convert your @code{org-remember-templates}, run the command +If your configuration depends on @file{org-remember.el}, you need to update +it and use the setup described below. To convert your +@var{org-remember-templates}, run the command @example -@kbd{M-x org-capture-import-remember-templates @key{RET}} +@kbd{M-x org-capture-import-remember-templates RET} @end example @noindent and then customize the new variable with @kbd{M-x customize-variable org-capture-templates}, check the result, and save the -customization. You can then use both remember and capture until -you are familiar with the new mechanism. - -Capture lets you quickly store notes with little interruption of your work -flow. The basic process of capturing is very similar to remember, but Org -does enhance it with templates and more. +customization. @menu * Setting up capture:: Where notes will be stored @@ -6513,10 +6830,12 @@ a global key@footnote{Please select your own key, @kbd{C-c c} is only a suggestion.} for capturing new material. @vindex org-default-notes-file -@example +@smalllisp +@group (setq org-default-notes-file (concat org-directory "/notes.org")) (define-key global-map "\C-cc" 'org-capture) -@end example +@end group +@end smalllisp @node Using capture, Capture templates, Setting up capture, Capture @subsection Using capture @@ -6538,7 +6857,7 @@ so that you can resume your work without further distraction. When called with a prefix arg, finalize and then jump to the captured item. @orgcmd{C-c C-w,org-capture-refile} -Finalize the capture process by refiling (@pxref{Refiling notes}) the note to +Finalize the capture process by refiling (@pxref{Refile and copy}) the note to a different place. Please realize that this is a normal refiling command that will be executed---so the cursor position at the moment you run this command is important. If you have inserted a tree with a parent and @@ -6568,8 +6887,8 @@ Visit the last stored capture item in its buffer. @vindex org-capture-bookmark @cindex org-capture-last-stored -You can also jump to the bookmark @code{org-capture-last-stored}, which will -automatically be created unless you set @code{org-capture-bookmark} to +You can also jump to the bookmark @var{org-capture-last-stored}, which will +automatically be created unless you set @var{org-capture-bookmark} to @code{nil}. To insert the capture at point in an Org buffer, call @code{org-capture} with @@ -6585,7 +6904,7 @@ through the customize interface. @table @kbd @orgkey{C-c c C} -Customize the variable @code{org-capture-templates}. +Customize the variable @var{org-capture-templates}. @end table Before we give the formal description of template definitions, let's look at @@ -6595,13 +6914,15 @@ your file @file{~/org/gtd.org}. Also, a date tree in the file @file{journal.org} should capture journal entries. A possible configuration would look like: -@example +@smalllisp +@group (setq org-capture-templates '(("t" "Todo" entry (file+headline "~/org/gtd.org" "Tasks") "* TODO %?\n %i\n %a") ("j" "Journal" entry (file+datetree "~/org/journal.org") "* %?\nEntered on %U\n %i\n %a"))) -@end example +@end group +@end smalllisp @noindent If you then press @kbd{C-c c t}, Org will prepare the template for you like this: @@ -6614,7 +6935,7 @@ for you like this: During expansion of the template, @code{%a} has been replaced by a link to the location from where you called the capture command. This can be extremely useful for deriving tasks from emails, for example. You fill in -the task definition, press @code{C-c C-c} and Org returns you to the same +the task definition, press @kbd{C-c C-c} and Org returns you to the same place where you started the capture process. To define special keys to capture to a particular template without going @@ -6636,7 +6957,7 @@ like this: @subsubsection Template elements Now lets look at the elements of a template definition. Each entry in -@code{org-capture-templates} is a list with the following items: +@var{org-capture-templates} is a list with the following items: @table @var @item keys @@ -6646,9 +6967,9 @@ single key, or @code{"bt"} for selection with two keys. When using several keys, keys using the same prefix key must be sequential in the list and preceded by a 2-element entry explaining the prefix key, for example -@example +@smalllisp ("b" "Templates for marking stuff to buy") -@end example +@end smalllisp @noindent If you do not define a template for the @kbd{C} key, this key will be used to open the customize buffer for this complex variable. @@ -6658,6 +6979,7 @@ selection. @item type The type of entry, a symbol. Valid values are: + @table @code @item entry An Org mode node, with a headline. Will be filed as the child of the target @@ -6682,10 +7004,11 @@ Specification of where the captured item should be placed. In Org mode files, targets usually define a node. Entries will become children of this node. Other types will be added to the table or list in the body of this node. Most target specifications contain a file name. If that file name is -the empty string, it defaults to @code{org-default-notes-file}. A file can +the empty string, it defaults to @var{org-default-notes-file}. A file can also be given as a variable, function, or Emacs Lisp form. Valid values are: + @table @code @item (file "path/to/file") Text will be placed at the beginning or end of that file. @@ -6703,7 +7026,10 @@ For non-unique headings, the full path is safer. Use a regular expression to position the cursor. @item (file+datetree "path/to/file") -Will create a heading in a date tree for today's date. +Will create a heading in a date tree for today's date@footnote{Datetree +headlines for years accept tags, so if you use both @code{* 2013 :noexport:} +and @code{* 2013} in your file, the capture will refile the note to the first +one matched.}. @item (file+datetree+prompt "path/to/file") Will create a heading in a date tree, but will prompt for the date. @@ -6730,6 +7056,7 @@ more details. @item properties The rest of the entry is a property list of additional options. Recognized properties are: + @table @code @item :prepend Normally new captured information will be appended at @@ -6783,7 +7110,9 @@ dynamic insertion of content. The templates are expanded in the order given her @smallexample %[@var{file}] @r{Insert the contents of the file given by @var{file}.} %(@var{sexp}) @r{Evaluate Elisp @var{sexp} and replace with the result.} - @r{The sexp must return a string.} + @r{For convenience, %:keyword (see below) placeholders} + @r{within the expression will be expanded prior to this.} + @r{The sexp must return a string.} %<...> @r{The result of format-time-string on the ... format specification.} %t @r{Timestamp, date only.} %T @r{Timestamp, with date and time.} @@ -6798,7 +7127,7 @@ dynamic insertion of content. The templates are expanded in the order given her %x @r{Content of the X clipboard.} %k @r{Title of the currently clocked task.} %K @r{Link to the currently clocked task.} -%n @r{User name (taken from @code{user-full-name}).} +%n @r{User name (taken from @var{user-full-name}).} %f @r{File visited by current buffer when org-capture was called.} %F @r{Full path of the file or directory visited by current buffer.} %:keyword @r{Specific information for certain link types, see below.} @@ -6837,7 +7166,7 @@ vm, vm-imap, wl, mh, mew, rmail | %:type %:subject %:message-id | %:date @r{(message date header field)} | %:date-timestamp @r{(date as active timestamp)} | %:date-timestamp-inactive @r{(date as inactive timestamp)} - | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}} + | %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @var{org-from-is-user-regexp}.}} gnus | %:group, @r{for messages also all email fields} w3, w3m | %:url info | %:file %:node @@ -6860,18 +7189,18 @@ context, you can customize @var{org-capture-templates-contexts}. Let's say for example that you have a capture template @code{"p"} for storing Gnus emails containing patches. Then you would configure this option like this: -@example +@smalllisp (setq org-capture-templates-contexts '(("p" (in-mode . "message-mode")))) -@end example +@end smalllisp You can also tell that the command key @code{"p"} should refer to another template. In that case, add this command key like this: -@example +@smalllisp (setq org-capture-templates-contexts '(("p" "q" (in-mode . "message-mode")))) -@end example +@end smalllisp See the docstring of the variable for more information. @@ -6889,7 +7218,7 @@ which are files located in a directory belonging to an outline node. Org uses directories named by the unique ID of each entry. These directories are located in the @file{data} directory which lives in the same directory where your Org file lives@footnote{If you move entries or Org files from one -directory to another, you may want to configure @code{org-attach-directory} +directory to another, you may want to configure @var{org-attach-directory} to contain an absolute path.}. If you initialize this directory with @code{git init}, Org will automatically commit changes when it sees them. The attachment system has been contributed to Org by John Wiegley. @@ -6902,7 +7231,6 @@ directory. @noindent The following commands deal with attachments: @table @kbd - @orgcmd{C-c C-a,org-attach} The dispatcher for commands related to the attachment system. After these keys, a list of commands is displayed and you must press an additional key @@ -6912,7 +7240,7 @@ to select a command: @orgcmdtkc{a,C-c C-a a,org-attach-attach} @vindex org-attach-method Select a file and move it into the task's attachment directory. The file -will be copied, moved, or linked, depending on @code{org-attach-method}. +will be copied, moved, or linked, depending on @var{org-attach-method}. Note that hard links are not supported on all systems. @kindex C-c C-a c @@ -6932,7 +7260,7 @@ attachments yourself. @orgcmdtkc{o,C-c C-a o,org-attach-open} @vindex org-file-apps Open current task's attachment. If there is more than one, prompt for a -file name first. Opening will follow the rules set by @code{org-file-apps}. +file name first. Opening will follow the rules set by @var{org-file-apps}. For more details, see the information on following hyperlinks (@pxref{Handling links}). @@ -6973,15 +7301,17 @@ Org can add and change entries based on information found in RSS feeds and Atom feeds. You could use this to make a task out of each new podcast in a podcast feed. Or you could use a phone-based note-creating service on the web to import tasks into Org. To access feeds, configure the variable -@code{org-feed-alist}. The docstring of this variable has detailed +@var{org-feed-alist}. The docstring of this variable has detailed information. Here is just an example: -@example +@smalllisp +@group (setq org-feed-alist '(("Slashdot" "http://rss.slashdot.org/Slashdot/slashdot" "~/txt/org/feeds.org" "Slashdot Entries"))) -@end example +@end group +@end smalllisp @noindent will configure that new items from the feed provided by @@ -6992,7 +7322,7 @@ the following command is used: @table @kbd @orgcmd{C-c C-x g,org-feed-update-all} @item C-c C-x g -Collect items from the feeds configured in @code{org-feed-alist} and act upon +Collect items from the feeds configured in @var{org-feed-alist} and act upon them. @orgcmd{C-c C-x G,org-feed-goto-inbox} Prompt for a feed name and go to the inbox configured for this feed. @@ -7008,9 +7338,9 @@ list of drawers in that file: @end example For more information, including how to read atom feeds, see -@file{org-feed.el} and the docstring of @code{org-feed-alist}. +@file{org-feed.el} and the docstring of @var{org-feed-alist}. -@node Protocols, Refiling notes, RSS Feeds, Capture - Refile - Archive +@node Protocols, Refile and copy, RSS Feeds, Capture - Refile - Archive @section Protocols for external access @cindex protocols, for external access @cindex emacsserver @@ -7024,17 +7354,22 @@ a remote website you are looking at with the browser. See @uref{http://orgmode.org/worg/org-contrib/org-protocol.php} for detailed documentation and setup instructions. -@node Refiling notes, Archiving, Protocols, Capture - Refile - Archive -@section Refiling notes +@node Refile and copy, Archiving, Protocols, Capture - Refile - Archive +@section Refile and copy @cindex refiling notes +@cindex copying notes -When reviewing the captured data, you may want to refile some of the entries -into a different list, for example into a project. Cutting, finding the -right location, and then pasting the note is cumbersome. To simplify this -process, you can use the following special command: +When reviewing the captured data, you may want to refile or to copy some of +the entries into a different list, for example into a project. Cutting, +finding the right location, and then pasting the note is cumbersome. To +simplify this process, you can use the following special command: @table @kbd +@orgcmd{C-c M-w,org-copy} +@findex org-copy +Copying works like refiling, except that the original note is not deleted. @orgcmd{C-c C-w,org-refile} +@findex org-refile @vindex org-reverse-note-order @vindex org-refile-targets @vindex org-refile-use-outline-path @@ -7045,17 +7380,17 @@ process, you can use the following special command: 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. -Depending on @code{org-reverse-note-order}, it will be either the first or +Depending on @var{org-reverse-note-order}, it will be either the first or last subitem.@* By default, all level 1 headlines in the current buffer are considered to be targets, but you can have more complex definitions across a number of files. -See the variable @code{org-refile-targets} for details. If you would like to +See the variable @var{org-refile-targets} for details. If you would like to select a location via a file-path-like completion along the outline path, see -the variables @code{org-refile-use-outline-path} and -@code{org-outline-path-complete-in-steps}. If you would like to be able to +the variables @var{org-refile-use-outline-path} and +@var{org-outline-path-complete-in-steps}. If you would like to be able to create new nodes as new parents for refiling on the fly, check the -variable @code{org-refile-allow-creating-parent-nodes}. -When the variable @code{org-log-refile}@footnote{with corresponding +variable @var{org-refile-allow-creating-parent-nodes}. +When the variable @var{org-log-refile}@footnote{with corresponding @code{#+STARTUP} keywords @code{logrefile}, @code{lognoterefile}, and @code{nologrefile}} is set, a timestamp or a note will be recorded when an entry has been refiled. @@ -7067,11 +7402,11 @@ Jump to the location where @code{org-refile} last moved a tree to. Refile as the child of the item currently being clocked. @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 +setting @var{org-refile-use-cache}. To make the command see new possible targets, you have to clear the cache with this command. @end table -@node Archiving, , Refiling notes, Capture - Refile - Archive +@node Archiving, , Refile and copy, Capture - Refile - Archive @section Archiving @cindex archiving @@ -7084,7 +7419,7 @@ searches like the construction of agenda views fast. @orgcmd{C-c C-x C-a,org-archive-subtree-default} @vindex org-archive-default-command Archive the current entry using the command specified in the variable -@code{org-archive-default-command}. +@var{org-archive-default-command}. @end table @menu @@ -7103,7 +7438,7 @@ the archive file. @orgcmdkskc{C-c C-x C-s,C-c $,org-archive-subtree} @vindex org-archive-location Archive the subtree starting at the cursor position to the location -given by @code{org-archive-location}. +given by @var{org-archive-location}. @orgkey{C-u C-c C-x C-s} Check if any direct children of the current headline could be moved to the archive. To do this, each subtree is checked for open TODO entries. @@ -7119,7 +7454,7 @@ current file name. You can also choose what heading to file archived items under, with the possibility to add them to a datetree in a file. For information and examples on how to specify the file and the heading, see the documentation string of the variable -@code{org-archive-location}. +@var{org-archive-location}. There is also an in-buffer option for setting this variable, for example@footnote{For backward compatibility, the following also works: @@ -7145,7 +7480,7 @@ location as the value (@pxref{Properties and Columns}). When a subtree is moved, it receives a number of special properties that record context information like the file from where the entry came, its outline path the archiving time etc. Configure the variable -@code{org-archive-save-context-info} to adjust the amount of information +@var{org-archive-save-context-info} to adjust the amount of information added. @@ -7163,29 +7498,29 @@ its location in the outline tree, but behaves in the following way: It does not open when you attempt to do so with a visibility cycling command (@pxref{Visibility cycling}). You can force cycling archived subtrees with @kbd{C-@key{TAB}}, or by setting the option -@code{org-cycle-open-archived-trees}. Also normal outline commands like +@var{org-cycle-open-archived-trees}. Also normal outline commands like @code{show-all} will open archived subtrees. @item @vindex org-sparse-tree-open-archived-trees During sparse tree construction (@pxref{Sparse trees}), matches in archived subtrees are not exposed, unless you configure the option -@code{org-sparse-tree-open-archived-trees}. +@var{org-sparse-tree-open-archived-trees}. @item @vindex org-agenda-skip-archived-trees During agenda view construction (@pxref{Agenda Views}), the content of archived trees is ignored unless you configure the option -@code{org-agenda-skip-archived-trees}, in which case these trees will always +@var{org-agenda-skip-archived-trees}, in which case these trees will always be included. In the agenda you can press @kbd{v a} to get archives temporarily included. @item @vindex org-export-with-archived-trees Archived trees are not exported (@pxref{Exporting}), only the headline is. Configure the details using the variable -@code{org-export-with-archived-trees}. +@var{org-export-with-archived-trees}. @item @vindex org-columns-skip-archived-trees Archived trees are excluded from column view unless the variable -@code{org-columns-skip-archived-trees} is configured to @code{nil}. +@var{org-columns-skip-archived-trees} is configured to @code{nil}. @end itemize The following commands help manage the ARCHIVE tag: @@ -7259,8 +7594,8 @@ edit these files remotely. @vindex org-agenda-restore-windows-after-quit Two variables control how the agenda buffer is displayed and whether the window configuration is restored when the agenda exits: -@code{org-agenda-window-setup} and -@code{org-agenda-restore-windows-after-quit}. +@var{org-agenda-window-setup} and +@var{org-agenda-restore-windows-after-quit}. @menu * Agenda files:: Files being searched for agenda information @@ -7281,7 +7616,7 @@ window configuration is restored when the agenda exits: @vindex org-agenda-files The information to be shown is normally collected from all @emph{agenda files}, the files listed in the variable -@code{org-agenda-files}@footnote{If the value of that variable is not a +@var{org-agenda-files}@footnote{If the value of that variable is not a list, but a single file name, then the list of agenda files will be maintained in that external file.}. If a directory is part of this list, all files with the extension @file{.org} in this directory will be part @@ -7290,8 +7625,8 @@ of the list. Thus, even if you only work with a single Org file, that file should be put into the list@footnote{When using the dispatcher, pressing @kbd{<} before selecting a command will actually limit the command to -the current file, and ignore @code{org-agenda-files} until the next -dispatcher command.}. You can customize @code{org-agenda-files}, but +the current file, and ignore @var{org-agenda-files} until the next +dispatcher command.}. You can customize @var{org-agenda-files}, but the easiest way to maintain it is through the following commands @cindex files, adding to agenda list @@ -7308,7 +7643,7 @@ Remove current file from the list of agenda files. @itemx C-, Cycle through agenda file list, visiting one file after the other. @kindex M-x org-iswitchb -@item M-x org-iswitchb +@item M-x org-iswitchb RET Command to use an @code{iswitchb}-like interface to switch to and between Org buffers. @end table @@ -7339,6 +7674,7 @@ Remove the permanent restriction created by @kbd{C-c C-x <}. @noindent When working with @file{speedbar.el}, you can use the following commands in the Speedbar frame: + @table @kbd @orgcmdtkc{< @r{in the speedbar frame},<,org-speedbar-set-agenda-restriction} Permanently restrict the agenda to the item---either an Org file or a subtree @@ -7359,6 +7695,7 @@ following we will assume that @kbd{C-c a} is indeed how the dispatcher is accessed and list keyboard access to commands accordingly. After pressing @kbd{C-c a}, an additional letter is required to execute a command. The dispatcher offers the following default commands: + @table @kbd @item a Create the calendar-like agenda (@pxref{Weekly/daily agenda}). @@ -7375,7 +7712,7 @@ and/or regular expressions that must or must not occur in the entry. @item / @vindex org-agenda-text-search-extra-files Search for a regular expression in all agenda files and additionally in -the files listed in @code{org-agenda-text-search-extra-files}. This +the files listed in @var{org-agenda-text-search-extra-files}. This uses the Emacs command @code{multi-occur}. A prefix argument can be used to specify the number of context lines for each match, default is 1. @@ -7399,7 +7736,7 @@ Toggle sticky agenda views. By default, Org maintains only a single agenda buffer and rebuilds it each time you change the view, to make sure everything is always up to date. If you switch between views often and the build time bothers you, you can turn on sticky agenda buffers (make this the default by -customizing the variable @code{org-agenda-sticky}). With sticky agendas, the +customizing the variable @var{org-agenda-sticky}). With sticky agendas, the dispatcher only switches to the selected view, you need to update it by hand with @kbd{r} or @kbd{g}. You can toggle sticky agenda view any time with @code{org-toggle-sticky-agenda}. @@ -7447,11 +7784,16 @@ C-c a a}) you may set the number of days to be displayed. @vindex org-agenda-span @vindex org-agenda-ndays +@vindex org-agenda-start-day +@vindex org-agenda-start-on-weekday The default number of days displayed in the agenda is set by the variable -@code{org-agenda-span} (or the obsolete @code{org-agenda-ndays}). This +@var{org-agenda-span} (or the obsolete @var{org-agenda-ndays}). This variable can be set to any number of days you want to see by default in the -agenda, or to a span name, such a @code{day}, @code{week}, @code{month} or -@code{year}. +agenda, or to a span name, such as @code{day}, @code{week}, @code{month} or +@code{year}. For weekly agendas, the default is to start on the previous +monday (see @var{org-agenda-start-on-weekday}). You can also set the start +date using a date shift: @code{(setq org-agenda-start-day "+10d")} will +start the agenda ten days from today in the future. Remote editing from the agenda buffer means, for example, that you can change the dates of deadlines and appointments from the agenda buffer. @@ -7502,7 +7844,7 @@ will be made in the agenda: #+CATEGORY: Holiday %%(org-calendar-holiday) ; special function for holiday names #+CATEGORY: Ann -%%(org-anniversary 1956 5 14)@footnote{@code{org-anniversary} is just like @code{diary-anniversary}, but the argument order is always according to ISO and therefore independent of the value of @code{calendar-date-style}.} Arthur Dent is %d years old +%%(org-anniversary 1956 5 14)@footnote{@code{org-anniversary} is just like @code{diary-anniversary}, but the argument order is always according to ISO and therefore independent of the value of @var{calendar-date-style}.} Arthur Dent is %d years old %%(org-anniversary 1869 10 2) Mahatma Gandhi would be %d years old @end example @@ -7556,7 +7898,7 @@ appointments of your agenda files, use the command @code{org-agenda-to-appt}. This command lets you filter through the list of your appointments and add only those belonging to a specific category or matching a regular expression. It also reads a @code{APPT_WARNTIME} property which will then override the -value of @code{appt-message-warning-time} for this appointment. See the +value of @var{appt-message-warning-time} for this appointment. See the docstring for details. @node Global TODO list, Matching tags and properties, Weekly/daily agenda, Built-in agenda views @@ -7581,7 +7923,7 @@ Like the above, but allows selection of a specific TODO keyword. You can also do this by specifying a prefix argument to @kbd{C-c a t}. You are prompted for a keyword, and you may also specify several keywords by separating them with @samp{|} as the boolean OR operator. With a numeric -prefix, the Nth keyword in @code{org-todo-keywords} is selected. +prefix, the Nth keyword in @var{org-todo-keywords} is selected. @kindex r The @kbd{r} key in the agenda buffer regenerates it, and you can give a prefix argument to this command to change the selected TODO keyword, @@ -7607,17 +7949,17 @@ it more compact: @vindex org-agenda-todo-ignore-with-date Some people view a TODO item that has been @emph{scheduled} for execution or have a @emph{deadline} (@pxref{Timestamps}) as no longer @emph{open}. -Configure the variables @code{org-agenda-todo-ignore-scheduled}, -@code{org-agenda-todo-ignore-deadlines}, -@code{org-agenda-todo-ignore-timestamp} and/or -@code{org-agenda-todo-ignore-with-date} to exclude such items from the global +Configure the variables @var{org-agenda-todo-ignore-scheduled}, +@var{org-agenda-todo-ignore-deadlines}, +@var{org-agenda-todo-ignore-timestamp} and/or +@var{org-agenda-todo-ignore-with-date} to exclude such items from the global TODO list. @item @vindex org-agenda-todo-list-sublevels TODO items may have sublevels to break up the task into subtasks. In such cases it may be enough to list only the highest level TODO headline and omit the sublevels from the global list. Configure the variable -@code{org-agenda-todo-list-sublevels} to get this behavior. +@var{org-agenda-todo-list-sublevels} to get this behavior. @end itemize @node Matching tags and properties, Timeline, Global TODO list, Built-in agenda views @@ -7645,8 +7987,8 @@ define a custom command for it (@pxref{Agenda dispatcher}). @vindex org-agenda-tags-todo-honor-ignore-options Like @kbd{C-c a m}, but only select headlines that are also TODO items in a not-DONE state and force checking subitems (see variable -@code{org-tags-match-list-sublevels}). To exclude scheduled/deadline items, -see the variable @code{org-agenda-tags-todo-honor-ignore-options}. Matching +@var{org-tags-match-list-sublevels}). To exclude scheduled/deadline items, +see the variable @var{org-agenda-tags-todo-honor-ignore-options}. Matching specific TODO keywords together with a tags match is also possible, see @ref{Tag searches}. @end table @@ -7657,16 +7999,21 @@ commands}. @subsubheading Match syntax @cindex Boolean logic, for tag/property searches -A search string can use Boolean operators @samp{&} for AND and @samp{|} for -OR@. @samp{&} binds more strongly than @samp{|}. Parentheses are currently -not implemented. Each element in the search is either a tag, a regular -expression matching tags, or an expression like @code{PROPERTY OPERATOR -VALUE} with a comparison operator, accessing a property value. Each element -may be preceded by @samp{-}, to select against it, and @samp{+} is syntactic -sugar for positive selection. The AND operator @samp{&} is optional when -@samp{+} or @samp{-} is present. Here are some examples, using only tags. +A search string can use Boolean operators @samp{&} for @code{AND} and +@samp{|} for @code{OR}@. @samp{&} binds more strongly than @samp{|}. +Parentheses are not implemented. Each element in the search is either a +tag, a regular expression matching tags, or an expression like +@code{PROPERTY OPERATOR VALUE} with a comparison operator, accessing a +property value. Each element may be preceded by @samp{-}, to select +against it, and @samp{+} is syntactic sugar for positive selection. The +@code{AND} operator @samp{&} is optional when @samp{+} or @samp{-} is +present. Here are some examples, using only tags. @table @samp +@item work +Select headlines tagged @samp{:work:}. +@item work&boss +Select headlines tagged @samp{:work:} and @samp{:boss:}. @item +work-boss Select headlines tagged @samp{:work:}, but discard those also tagged @samp{:boss:}. @@ -7683,6 +8030,13 @@ braces. For example, @samp{work+@{^boss.*@}} matches headlines that contain the tag @samp{:work:} and any tag @i{starting} with @samp{boss}. +@cindex group tags, as regular expressions +Group tags (@pxref{Tag groups}) are expanded as regular expressions. E.g., +if @samp{:work:} is a group tag for the group @samp{:work:lab:conf:}, then +searching for @samp{work} will search for @samp{@{\(?:work\|lab\|conf\)@}} +and searching for @samp{-work} will search for all headlines but those with +one of the tag in the group (i.e., @samp{-@{\(?:work\|lab\|conf\)@}}). + @cindex TODO keyword matching, with tags search @cindex level, require for tags/property match @cindex category, require for tags/property match @@ -7694,13 +8048,14 @@ 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 +DONE@. In buffers with @var{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 searches@footnote{But @pxref{x-agenda-skip-entry-regexp, ,skipping entries based on regexp}.}. Here are more examples: + @table @samp @item work+TODO="WAITING" Select @samp{:work:}-tagged TODO lines with the specific TODO @@ -7832,7 +8187,7 @@ the docstring of the command @code{org-search-view}. @vindex org-agenda-text-search-extra-files Note that in addition to the agenda files, this command will also search -the files listed in @code{org-agenda-text-search-extra-files}. +the files listed in @var{org-agenda-text-search-extra-files}. @node Stuck projects, , Search view, Built-in agenda views @subsection Stuck projects @@ -7851,7 +8206,7 @@ List projects that are stuck. @kindex C-c a ! @item C-c a ! @vindex org-stuck-projects -Customize the variable @code{org-stuck-projects} to define what a stuck +Customize the variable @var{org-stuck-projects} to define what a stuck project is and how to find it. @end table @@ -7892,15 +8247,16 @@ Before displaying items in an agenda view, Org mode visually prepares the items and sorts them. Each item occupies a single line. The line starts with a @emph{prefix} that contains the @emph{category} (@pxref{Categories}) of the item and other important information. You can customize in which -column tags will be displayed through @code{org-agenda-tags-column}. You can -also customize the prefix using the option @code{org-agenda-prefix-format}. +column tags will be displayed through @var{org-agenda-tags-column}. You can +also customize the prefix using the option @var{org-agenda-prefix-format}. This prefix is followed by a cleaned-up version of the outline headline associated with the item. @menu * Categories:: Not all tasks are equal * Time-of-day specifications:: How the agenda knows the time -* Sorting of agenda items:: The order of things +* Sorting agenda items:: The order of things +* Filtering/limiting agenda items:: Dynamically narrow the agenda @end menu @node Categories, Time-of-day specifications, Presentation and sorting, Presentation and sorting @@ -7935,9 +8291,9 @@ longer than 10 characters. @noindent You can set up icons for category by customizing the -@code{org-agenda-category-icon-alist} variable. +@var{org-agenda-category-icon-alist} variable. -@node Time-of-day specifications, Sorting of agenda items, Categories, Presentation and sorting +@node Time-of-day specifications, Sorting agenda items, Categories, Presentation and sorting @subsection Time-of-day specifications @cindex time-of-day specification @@ -7985,11 +8341,11 @@ timed entries are embedded in a time grid, like @vindex org-agenda-use-time-grid @vindex org-agenda-time-grid The time grid can be turned on and off with the variable -@code{org-agenda-use-time-grid}, and can be configured with -@code{org-agenda-time-grid}. +@var{org-agenda-use-time-grid}, and can be configured with +@var{org-agenda-time-grid}. -@node Sorting of agenda items, , Time-of-day specifications, Presentation and sorting -@subsection Sorting of agenda items +@node Sorting agenda items, Filtering/limiting agenda items, Time-of-day specifications, Presentation and sorting +@subsection Sorting agenda items @cindex sorting, of agenda items @cindex priorities, of agenda items Before being inserted into a view, the items are sorted. How this is @@ -8001,7 +8357,7 @@ For the daily/weekly agenda, the items for each day are sorted. The default order is to first collect all items containing an explicit time-of-day specification. These entries will be shown at the beginning of the list, as a @emph{schedule} for the day. After that, items remain -grouped in categories, in the sequence given by @code{org-agenda-files}. +grouped in categories, in the sequence given by @var{org-agenda-files}. Within each category, items are sorted by priority (@pxref{Priorities}), which is composed of the base priority (2000 for priority @samp{A}, 1000 for @samp{B}, and 0 for @samp{C}), plus additional increments for @@ -8019,9 +8375,192 @@ sequence in which they are found in the agenda files. @vindex org-agenda-sorting-strategy Sorting can be customized using the variable -@code{org-agenda-sorting-strategy}, and may also include criteria based on +@var{org-agenda-sorting-strategy}, and may also include criteria based on the estimated effort of an entry (@pxref{Effort estimates}). +@node Filtering/limiting agenda items, , Sorting agenda items, Presentation and sorting +@subsection Filtering/limiting agenda items + +Agenda built-in or customized commands are statically defined. Agenda +filters and limits provide two ways of dynamically narrowing down the list of +agenda entries: @emph{fitlers} and @emph{limits}. Filters only act on the +display of the items, while limits take effect before the list of agenda +entries is built. Filter are more often used interactively, while limits are +mostly useful when defined as local variables within custom agenda commands. + +@subsubheading Filtering in the agenda +@cindex filtering, by tag, category, top headline and effort, in agenda +@cindex tag filtering, in agenda +@cindex category filtering, in agenda +@cindex top headline filtering, in agenda +@cindex effort filtering, in agenda +@cindex query editing, in agenda + +@table @kbd +@orgcmd{/,org-agenda-filter-by-tag} +@vindex org-agenda-tag-filter-preset +Filter the agenda view with respect to a tag and/or effort estimates. The +difference between this and a custom agenda command is that filtering is very +fast, so that you can switch quickly between different filters without having +to recreate the agenda.@footnote{Custom commands can preset a filter by +binding the variable @var{org-agenda-tag-filter-preset} as an option. This +filter will then be applied to the view and persist as a basic filter through +refreshes and more secondary filtering. The filter is a global property of +the entire agenda view---in a block agenda, you should only set this in the +global options section, not in the section of an individual block.} + +You will be prompted for a tag selection letter; @key{SPC} will mean any tag at +all. Pressing @key{TAB} at that prompt will offer use completion to select a +tag (including any tags that do not have a selection character). The command +then hides all entries that do not contain or inherit this tag. When called +with prefix arg, remove the entries that @emph{do} have the tag. A second +@kbd{/} at the prompt will turn off the filter and unhide any hidden entries. +If the first key you press is either @kbd{+} or @kbd{-}, the previous filter +will be narrowed by requiring or forbidding the selected additional tag. +Instead of pressing @kbd{+} or @kbd{-} after @kbd{/}, you can also +immediately use the @kbd{\} command. + +@vindex org-sort-agenda-noeffort-is-high +In order to filter for effort estimates, you should set up allowed +efforts globally, for example +@lisp +(setq org-global-properties + '(("Effort_ALL". "0 0:10 0:30 1:00 2:00 3:00 4:00"))) +@end lisp +You can then filter for an effort by first typing an operator, one of +@kbd{<}, @kbd{>}, and @kbd{=}, and then the one-digit index of an effort +estimate in your array of allowed values, where @kbd{0} means the 10th value. +The filter will then restrict to entries with effort smaller-or-equal, equal, +or larger-or-equal than the selected value. If the digits 0--9 are not used +as fast access keys to tags, you can also simply press the index digit +directly without an operator. In this case, @kbd{<} will be assumed. For +application of the operator, entries without a defined effort will be treated +according to the value of @var{org-sort-agenda-noeffort-is-high}. To filter +for tasks without effort definition, press @kbd{?} as the operator. + +Org also supports automatic, context-aware tag filtering. If the variable +@var{org-agenda-auto-exclude-function} is set to a user-defined function, +that function can decide which tags should be excluded from the agenda +automatically. Once this is set, the @kbd{/} command then accepts @kbd{RET} +as a sub-option key and runs the auto exclusion logic. For example, let's +say you use a @code{Net} tag to identify tasks which need network access, an +@code{Errand} tag for errands in town, and a @code{Call} tag for making phone +calls. You could auto-exclude these tags based on the availability of the +Internet, and outside of business hours, with something like this: + +@smalllisp +@group +(defun org-my-auto-exclude-function (tag) + (and (cond + ((string= tag "Net") + (/= 0 (call-process "/sbin/ping" nil nil nil + "-c1" "-q" "-t1" "mail.gnu.org"))) + ((or (string= tag "Errand") (string= tag "Call")) + (let ((hour (nth 2 (decode-time)))) + (or (< hour 8) (> hour 21))))) + (concat "-" tag))) + +(setq org-agenda-auto-exclude-function 'org-my-auto-exclude-function) +@end group +@end smalllisp + +@orgcmd{\\,org-agenda-filter-by-tag-refine} +Narrow the current agenda filter by an additional condition. When called with +prefix arg, remove the entries that @emph{do} have the tag, or that do match +the effort criterion. You can achieve the same effect by pressing @kbd{+} or +@kbd{-} as the first key after the @kbd{/} command. + +@c +@kindex [ +@kindex ] +@kindex @{ +@kindex @} +@item [ ] @{ @} +@table @i +@item @r{in} search view +add new search words (@kbd{[} and @kbd{]}) or new regular expressions +(@kbd{@{} and @kbd{@}}) to the query string. The opening bracket/brace will +add a positive search term prefixed by @samp{+}, indicating that this search +term @i{must} occur/match in the entry. The closing bracket/brace will add a +negative search term which @i{must not} occur/match in the entry for it to be +selected. +@end table + +@orgcmd{<,org-agenda-filter-by-category} +@vindex org-agenda-category-filter-preset + +Filter the current agenda view with respect to the category of the item at +point. Pressing @code{<} another time will remove this filter. You can add +a filter preset through the option @var{org-agenda-category-filter-preset} +(see below.) + +@orgcmd{^,org-agenda-filter-by-top-headline} +Filter the current agenda view and only display the siblings and the parent +headline of the one at point. + +@orgcmd{=,org-agenda-filter-by-regexp} +@vindex org-agenda-regexp-filter-preset + +Filter the agenda view by a regular expression: only show agenda entries +matching the regular expression the user entered. When called with a prefix +argument, it will filter @emph{out} entries matching the regexp. With two +universal prefix arguments, it will remove all the regexp filters, which can +be accumulated. You can add a filter preset through the option +@var{org-agenda-category-filter-preset} (see below.) + +@orgcmd{|,org-agenda-filter-remove-all} +Remove all filters in the current agenda view. +@end table + +@subsubheading Setting limits for the agenda +@cindex limits, in agenda +@vindex org-agenda-max-entries +@vindex org-agenda-max-effort +@vindex org-agenda-max-todos +@vindex org-agenda-max-tags + +Here is a list of options that you can set, either globally, or locally in +your custom agenda views@pxref{Custom agenda views}. + +@table @var +@item org-agenda-max-entries +Limit the number of entries. +@item org-agenda-max-effort +Limit the duration of accumulated efforts (as minutes). +@item org-agenda-max-todos +Limit the number of entries with TODO keywords. +@item org-agenda-max-tags +Limit the number of tagged entries. +@end table + +When set to a positive integer, each option will exclude entries from other +catogories: for example, @code{(setq org-agenda-max-effort 100)} will limit +the agenda to 100 minutes of effort and exclude any entry that as no effort +property. If you want to include entries with no effort property, use a +negative value for @var{org-agenda-max-effort}. + +One useful setup is to use @var{org-agenda-max-entries} locally in a custom +command. For example, this custom command will display the next five entries +with a @code{NEXT} TODO keyword. + +@smalllisp +(setq org-agenda-custom-commands + '(("n" todo "NEXT" + ((org-agenda-max-entries 5))))) +@end smalllisp + +Once you mark one of these five entry as @code{DONE}, rebuilding the agenda +will again the next five entries again, including the first entry that was +excluded so far. + +You can also dynamically set temporary limits@footnote{Those temporary limits +are lost when rebuilding the agenda.}: + +@table @kbd +@orgcmd{~,org-agenda-limit-interactively} +This prompts for the type of limit to apply and its value. +@end table + @node Agenda commands, Custom agenda views, Presentation and sorting, Agenda Views @section Commands in the agenda buffer @cindex commands, in agenda buffer @@ -8064,7 +8603,7 @@ Toggle Follow mode. In Follow mode, as you move the cursor through the agenda buffer, the other window always shows the corresponding location in the Org file. The initial setting for this mode in new agenda buffers can be set with the variable -@code{org-agenda-start-with-follow-mode}. +@var{org-agenda-start-with-follow-mode}. @c @orgcmd{C-c C-x b,org-agenda-tree-to-indirect-buffer} Display the entire subtree of the current item in an indirect buffer. With a @@ -8103,12 +8642,12 @@ month view, a year may be encoded in the prefix argument as well. For example, @kbd{200712 w} will jump to week 12 in 2007. If such a year specification has only one or two digits, it will be mapped to the interval 1938--2037. @kbd{v @key{SPC}} will reset to what is set in -@code{org-agenda-span}. +@var{org-agenda-span}. @c @orgcmd{f,org-agenda-later} -Go forward in time to display the following @code{org-agenda-current-span} days. +Go forward in time to display the following @var{org-agenda-current-span} days. For example, if the display covers a week, switch to the following week. -With prefix arg, go forward that many times @code{org-agenda-current-span} days. +With prefix arg, go forward that many times @var{org-agenda-current-span} days. @c @orgcmd{b,org-agenda-earlier} Go backward in time to display earlier dates. @@ -8130,12 +8669,12 @@ Toggle the inclusion of diary entries. See @ref{Weekly/daily agenda}. @vindex org-log-done @vindex org-agenda-log-mode-items Toggle Logbook mode. In Logbook mode, entries that were marked DONE while -logging was on (variable @code{org-log-done}) are shown in the agenda, as are +logging was on (variable @var{org-log-done}) are shown in the agenda, as are entries that have been clocked on that day. You can configure the entry types that should be included in log mode using the variable -@code{org-agenda-log-mode-items}. When called with a @kbd{C-u} prefix, show +@var{org-agenda-log-mode-items}. When called with a @kbd{C-u} prefix, show all possible logbook entries, including state changes. When called with two -prefix args @kbd{C-u C-u}, show only logging information, nothing else. +prefix arguments @kbd{C-u C-u}, show only logging information, nothing else. @kbd{v L} is equivalent to @kbd{C-u v l}. @c @orgcmdkskc{v [,[,org-agenda-manipulate-query-add} @@ -8153,20 +8692,20 @@ press @kbd{v a} again. @vindex org-agenda-start-with-clockreport-mode @vindex org-clock-report-include-clocking-task Toggle Clockreport mode. In Clockreport mode, the daily/weekly agenda will -always show a table with the clocked times for the timespan and file scope +always show a table with the clocked times for the time span and file scope covered by the current agenda view. The initial setting for this mode in new agenda buffers can be set with the variable -@code{org-agenda-start-with-clockreport-mode}. By using a prefix argument +@var{org-agenda-start-with-clockreport-mode}. By using a prefix argument when toggling this mode (i.e., @kbd{C-u R}), the clock table will not show contributions from entries that are hidden by agenda filtering@footnote{Only tags filtering will be respected here, effort filtering is ignored.}. See -also the variable @code{org-clock-report-include-clocking-task}. +also the variable @var{org-clock-report-include-clocking-task}. @c @orgkey{v c} @vindex org-agenda-clock-consistency-checks Show overlapping clock entries, clocking gaps, and other clocking problems in the current agenda range. You can then visit clocking lines and fix them -manually. See the variable @code{org-agenda-clock-consistency-checks} for +manually. See the variable @var{org-agenda-clock-consistency-checks} for information on how to customize the definition of what constituted a clocking problem. To return to normal agenda display, press @kbd{l} to exit Logbook mode. @@ -8177,14 +8716,14 @@ mode. Toggle entry text mode. In entry text mode, a number of lines from the Org outline node referenced by an agenda line will be displayed below the line. The maximum number of lines is given by the variable -@code{org-agenda-entry-text-maxlines}. Calling this command with a numeric +@var{org-agenda-entry-text-maxlines}. Calling this command with a numeric prefix argument will temporarily modify that number to the prefix value. @c @orgcmd{G,org-agenda-toggle-time-grid} @vindex org-agenda-use-time-grid @vindex org-agenda-time-grid Toggle the time grid on and off. See also the variables -@code{org-agenda-use-time-grid} and @code{org-agenda-time-grid}. +@var{org-agenda-use-time-grid} and @var{org-agenda-time-grid}. @c @orgcmd{r,org-agenda-redo} Recreate the agenda buffer, for example to reflect the changes after @@ -8206,115 +8745,46 @@ view format is taken from the entry at point, or (if there is no entry at point), from the first entry in the agenda view. So whatever the format for that entry would be in the original buffer (taken from a property, from a @code{#+COLUMNS} line, or from the default variable -@code{org-columns-default-format}), will be used in the agenda. +@var{org-columns-default-format}), will be used in the agenda. @orgcmd{C-c C-x >,org-agenda-remove-restriction-lock} Remove the restriction lock on the agenda, if it is currently restricted to a file or subtree (@pxref{Agenda files}). @tsubheading{Secondary filtering and query editing} -@cindex filtering, by tag category and effort, in agenda -@cindex tag filtering, in agenda -@cindex category filtering, in agenda -@cindex effort filtering, in agenda -@cindex query editing, in agenda + +For a detailed description of these commands, see @pxref{Filtering/limiting +agenda items}. + +@orgcmd{/,org-agenda-filter-by-tag} +@vindex org-agenda-tag-filter-preset +Filter the agenda view with respect to a tag and/or effort estimates. + +@orgcmd{\\,org-agenda-filter-by-tag-refine} +Narrow the current agenda filter by an additional condition. @orgcmd{<,org-agenda-filter-by-category} @vindex org-agenda-category-filter-preset Filter the current agenda view with respect to the category of the item at -point. Pressing @code{<} another time will remove this filter. You can add -a filter preset through the option @code{org-agenda-category-filter-preset} -(see below.) +point. Pressing @code{<} another time will remove this filter. -@orgcmd{/,org-agenda-filter-by-tag} -@vindex org-agenda-tag-filter-preset -Filter the current agenda view with respect to a tag and/or effort estimates. -The difference between this and a custom agenda command is that filtering is -very fast, so that you can switch quickly between different filters without -having to recreate the agenda.@footnote{Custom commands can preset a filter by -binding the variable @code{org-agenda-tag-filter-preset} as an option. This -filter will then be applied to the view and persist as a basic filter through -refreshes and more secondary filtering. The filter is a global property of -the entire agenda view---in a block agenda, you should only set this in the -global options section, not in the section of an individual block.} +@orgcmd{^,org-agenda-filter-by-top-headline} +Filter the current agenda view and only display the siblings and the parent +headline of the one at point. -You will be prompted for a tag selection letter; @key{SPC} will mean any tag at -all. Pressing @key{TAB} at that prompt will offer use completion to select a -tag (including any tags that do not have a selection character). The command -then hides all entries that do not contain or inherit this tag. When called -with prefix arg, remove the entries that @emph{do} have the tag. A second -@kbd{/} at the prompt will turn off the filter and unhide any hidden entries. -If the first key you press is either @kbd{+} or @kbd{-}, the previous filter -will be narrowed by requiring or forbidding the selected additional tag. -Instead of pressing @kbd{+} or @kbd{-} after @kbd{/}, you can also -immediately use the @kbd{\} command. +@orgcmd{=,org-agenda-filter-by-regexp} +@vindex org-agenda-regexp-filter-preset -@vindex org-sort-agenda-noeffort-is-high -In order to filter for effort estimates, you should set up allowed -efforts globally, for example -@lisp -(setq org-global-properties - '(("Effort_ALL". "0 0:10 0:30 1:00 2:00 3:00 4:00"))) -@end lisp -You can then filter for an effort by first typing an operator, one of -@kbd{<}, @kbd{>}, and @kbd{=}, and then the one-digit index of an effort -estimate in your array of allowed values, where @kbd{0} means the 10th value. -The filter will then restrict to entries with effort smaller-or-equal, equal, -or larger-or-equal than the selected value. If the digits 0--9 are not used -as fast access keys to tags, you can also simply press the index digit -directly without an operator. In this case, @kbd{<} will be assumed. For -application of the operator, entries without a defined effort will be treated -according to the value of @code{org-sort-agenda-noeffort-is-high}. To filter -for tasks without effort definition, press @kbd{?} as the operator. +Filter the agenda view by a regular expression: only show agenda entries +matching the regular expression the user entered. When called with a prefix +argument, it will filter @emph{out} entries matching the regexp. With two +universal prefix arguments, it will remove all the regexp filters, which can +be accumulated. You can add a filter preset through the option +@var{org-agenda-category-filter-preset} (see below.) -Org also supports automatic, context-aware tag filtering. If the variable -@code{org-agenda-auto-exclude-function} is set to a user-defined function, -that function can decide which tags should be excluded from the agenda -automatically. Once this is set, the @kbd{/} command then accepts @kbd{RET} -as a sub-option key and runs the auto exclusion logic. For example, let's -say you use a @code{Net} tag to identify tasks which need network access, an -@code{Errand} tag for errands in town, and a @code{Call} tag for making phone -calls. You could auto-exclude these tags based on the availability of the -Internet, and outside of business hours, with something like this: - -@lisp -@group -(defun org-my-auto-exclude-function (tag) - (and (cond - ((string= tag "Net") - (/= 0 (call-process "/sbin/ping" nil nil nil - "-c1" "-q" "-t1" "mail.gnu.org"))) - ((or (string= tag "Errand") (string= tag "Call")) - (let ((hour (nth 2 (decode-time)))) - (or (< hour 8) (> hour 21))))) - (concat "-" tag))) - -(setq org-agenda-auto-exclude-function 'org-my-auto-exclude-function) -@end group -@end lisp - -@orgcmd{\\,org-agenda-filter-by-tag-refine} -Narrow the current agenda filter by an additional condition. When called with -prefix arg, remove the entries that @emph{do} have the tag, or that do match -the effort criterion. You can achieve the same effect by pressing @kbd{+} or -@kbd{-} as the first key after the @kbd{/} command. - -@c -@kindex [ -@kindex ] -@kindex @{ -@kindex @} -@item [ ] @{ @} -@table @i -@item @r{in} search view -add new search words (@kbd{[} and @kbd{]}) or new regular expressions -(@kbd{@{} and @kbd{@}}) to the query string. The opening bracket/brace will -add a positive search term prefixed by @samp{+}, indicating that this search -term @i{must} occur/match in the entry. The closing bracket/brace will add a -negative search term which @i{must not} occur/match in the entry for it to be -selected. -@end table +@orgcmd{|,org-agenda-filter-remove-all} +Remove all filters in the current agenda view. @tsubheading{Remote editing} @cindex remote editing, from agenda @@ -8341,7 +8811,7 @@ Switch to the next/previous set of TODO keywords. Delete the current agenda item along with the entire subtree belonging to it in the original Org file. If the text to be deleted remotely is longer than one line, the kill needs to be confirmed by the user. See -variable @code{org-agenda-confirm-kill}. +variable @var{org-agenda-confirm-kill}. @c @orgcmd{C-c C-w,org-agenda-refile} Refile the entry at point. @@ -8349,7 +8819,7 @@ Refile the entry at point. @orgcmdkskc{C-c C-x C-a,a,org-agenda-archive-default-with-confirmation} @vindex org-archive-default-command Archive the subtree corresponding to the entry at point using the default -archiving command set in @code{org-archive-default-command}. When using the +archiving command set in @var{org-archive-default-command}. When using the @code{a} key, confirmation will be required. @c @orgcmd{C-c C-x a,org-agenda-toggle-archive-tag} @@ -8367,7 +8837,7 @@ different file. @orgcmd{T,org-agenda-show-tags} @vindex org-agenda-show-inherited-tags Show all tags associated with the current item. This is useful if you have -turned off @code{org-agenda-show-inherited-tags}, but still want to see all +turned off @var{org-agenda-show-inherited-tags}, but still want to see all tags of a headline occasionally. @c @orgcmd{:,org-agenda-set-tags} @@ -8395,7 +8865,7 @@ Decrease the priority of the current item. @vindex org-log-into-drawer Add a note to the entry. This note will be recorded, and then filed to the same location where state change notes are put. Depending on -@code{org-log-into-drawer}, this may be inside a drawer. +@var{org-log-into-drawer}, this may be inside a drawer. @c @orgcmd{C-c C-a,org-attach} Dispatcher for all command related to attachments. @@ -8446,66 +8916,102 @@ the default behavior of @code{org-capture}. @cindex capturing, from agenda @vindex org-capture-use-agenda-date +@tsubheading{Dragging agenda lines forward/backward} +@cindex dragging, agenda lines + +@orgcmd{M-,org-agenda-drag-line-backward} +Drag the line at point backward one line@footnote{Moving agenda lines does +not persist after an agenda refresh and does not modify the contributing +@file{.org} files}. With a numeric prefix argument, drag backward by that +many lines. + +@orgcmd{M-,org-agenda-drag-line-forward} +Drag the line at point forward one line. With a numeric prefix argument, +drag forward by that many lines. + @tsubheading{Bulk remote editing selected entries} @cindex remote editing, bulk, from agenda -@vindex org-agenda-bulk-persistent-marks @vindex org-agenda-bulk-custom-functions @orgcmd{m,org-agenda-bulk-mark} -Mark the entry at point for bulk action. With prefix arg, mark that many -successive entries. +Mark the entry at point for bulk action. With numeric prefix argument, mark +that many successive entries. @c -@orgcmd{%,org-agenda-bulk-mark-regexp} -Mark entries matching a regular expression for bulk action. +@orgcmd{*,org-agenda-bulk-mark-all} +Mark all visible agenda entries for bulk action. @c @orgcmd{u,org-agenda-bulk-unmark} -Unmark entry for bulk action. +Unmark entry at point for bulk action. @c @orgcmd{U,org-agenda-bulk-remove-all-marks} Unmark all marked entries for bulk action. @c +@orgcmd{M-m,org-agenda-bulk-toggle} +Toggle mark of the entry at point for bulk action. +@c +@orgcmd{M-*,org-agenda-bulk-toggle-all} +Toggle marks of all visible entries for bulk action. +@c +@orgcmd{%,org-agenda-bulk-mark-regexp} +Mark entries matching a regular expression for bulk action. +@c @orgcmd{B,org-agenda-bulk-action} Bulk action: act on all marked entries in the agenda. This will prompt for another key to select the action to be applied. The prefix arg to @kbd{B} will be passed through to the @kbd{s} and @kbd{d} commands, to bulk-remove these special timestamps. By default, marks are removed after the bulk. If -you want them to persist, set @code{org-agenda-bulk-persistent-marks} to +you want them to persist, set @var{org-agenda-bulk-persistent-marks} to @code{t} or hit @kbd{p} at the prompt. -@example -* @r{Toggle persistent marks.} -$ @r{Archive all selected entries.} -A @r{Archive entries by moving them to their respective archive siblings.} -t @r{Change TODO state. This prompts for a single TODO keyword and} - @r{changes the state of all selected entries, bypassing blocking and} - @r{suppressing logging notes (but not timestamps).} -+ @r{Add a tag to all selected entries.} -- @r{Remove a tag from all selected entries.} -s @r{Schedule all items to a new date. To shift existing schedule dates} - @r{by a fixed number of days, use something starting with double plus} - @r{at the prompt, for example @samp{++8d} or @samp{++2w}.} -d @r{Set deadline to a specific date.} -r @r{Prompt for a single refile target and move all entries. The entries} - @r{will no longer be in the agenda; refresh (@kbd{g}) to bring them back.} -S @r{Reschedule randomly into the coming N days. N will be prompted for.} - @r{With prefix arg (@kbd{C-u B S}), scatter only across weekdays.} -f @r{Apply a function@footnote{You can also create persistent custom functions through@code{org-agenda-bulk-custom-functions}.} to marked entries.} - @r{For example, the function below sets the CATEGORY property of the} - @r{entries to web.} - @r{(defun set-category ()} - @r{ (interactive "P")} - @r{ (let* ((marker (or (org-get-at-bol 'org-hd-marker)} - @r{ (org-agenda-error)))} - @r{ (buffer (marker-buffer marker)))} - @r{ (with-current-buffer buffer} - @r{ (save-excursion} - @r{ (save-restriction} - @r{ (widen)} - @r{ (goto-char marker)} - @r{ (org-back-to-heading t)} - @r{ (org-set-property "CATEGORY" "web"))))))} -@end example +@table @kbd +@item * +Toggle persistent marks. +@item $ +Archive all selected entries. +@item A +Archive entries by moving them to their respective archive siblings. +@item t +Change TODO state. This prompts for a single TODO keyword and changes the +state of all selected entries, bypassing blocking and suppressing logging +notes (but not timestamps). +@item + +Add a tag to all selected entries. +@item - +Remove a tag from all selected entries. +@item s +Schedule all items to a new date. To shift existing schedule dates by a +fixed number of days, use something starting with double plus at the prompt, +for example @samp{++8d} or @samp{++2w}. +@item d +Set deadline to a specific date. +@item r +Prompt for a single refile target and move all entries. The entries will no +longer be in the agenda; refresh (@kbd{g}) to bring them back. +@item S +Reschedule randomly into the coming N days. N will be prompted for. With +prefix arg (@kbd{C-u B S}), scatter only across weekdays. +@item f +Apply a function@footnote{You can also create persistent custom functions +through @var{org-agenda-bulk-custom-functions}.} to marked entries. For +example, the function below sets the CATEGORY property of the entries to web. +@lisp +@group +(defun set-category () + (interactive "P") + (let* ((marker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer marker))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char marker) + (org-back-to-heading t) + (org-set-property "CATEGORY" "web")))))) +@end group +@end lisp +@end table @tsubheading{Calendar commands} @cindex calendar commands, from agenda @@ -8523,17 +9029,17 @@ date at the cursor. Insert a new entry into the diary, using the date at the cursor and (for block entries) the date at the mark. This will add to the Emacs diary file@footnote{This file is parsed for the agenda when -@code{org-agenda-include-diary} is set.}, in a way similar to the @kbd{i} +@var{org-agenda-include-diary} is set.}, in a way similar to the @kbd{i} command in the calendar. The diary file will pop up in another window, where you can add the entry. -If you configure @code{org-agenda-diary-file} to point to an Org mode file, +If you configure @var{org-agenda-diary-file} to point to an Org mode file, Org will create entries (in Org mode syntax) in that file instead. Most entries will be stored in a date-based outline tree that will later make it easy to archive appointments from previous months/years. The tree will be built under an entry with a @code{DATE_TREE} property, or else with years as top-level entries. Emacs will prompt you for the entry text---if you specify -it, the entry will be created in @code{org-agenda-diary-file} without further +it, the entry will be created in @var{org-agenda-diary-file} without further interaction. If you directly press @key{RET} at the prompt without typing text, the target file will be shown in another window for you to finish the entry there. See also the @kbd{k r} command. @@ -8552,7 +9058,7 @@ calendars. @orgcmd{H,org-agenda-holidays} Show holidays for three months around the cursor date. -@item M-x org-export-icalendar-combine-agenda-files +@item M-x org-icalendar-combine-agenda-files RET Export a single iCalendar file containing entries from all agenda files. This is a globally available command, and also available in the agenda menu. @@ -8562,12 +9068,13 @@ This is a globally available command, and also available in the agenda menu. @cindex agenda views, exporting @vindex org-agenda-exporter-settings Write the agenda view to a file. Depending on the extension of the selected -file name, the view will be exported as HTML (extension @file{.html} or -@file{.htm}), Postscript (extension @file{.ps}), PDF (extension @file{.pdf}), -and plain text (any other extension). When called with a @kbd{C-u} prefix -argument, immediately open the newly created file. Use the variable -@code{org-agenda-exporter-settings} to set options for @file{ps-print} and -for @file{htmlize} to be used during export. +file name, the view will be exported as HTML (@file{.html} or @file{.htm}), +Postscript (@file{.ps}), PDF (@file{.pdf}), Org (@file{.org}) and plain text +(any other extension). When exporting to Org, only the body of original +headlines are exported, not subtrees or inherited tags. When called with a +@kbd{C-u} prefix argument, immediately open the newly created file. Use the +variable @var{org-agenda-exporter-settings} to set options for +@file{ps-print} and for @file{htmlize} to be used during export. @tsubheading{Quit and Exit} @orgcmd{q,org-agenda-quit} @@ -8607,6 +9114,8 @@ buffer). @kindex C-c a C @vindex org-agenda-custom-commands @cindex agenda views, main example +@cindex agenda, as an agenda views +@cindex agenda*, as an agenda views @cindex tags, as an agenda view @cindex todo, as an agenda view @cindex tags-todo @@ -8615,15 +9124,17 @@ buffer). @cindex tags-tree Custom commands are configured in the variable -@code{org-agenda-custom-commands}. You can customize this variable, for +@var{org-agenda-custom-commands}. You can customize this variable, for example by pressing @kbd{C-c a C}. You can also directly set it with Emacs -Lisp in @file{.emacs}. The following example contains all valid search -types: +Lisp in @file{.emacs}. The following example contains all valid agenda +views: @lisp @group (setq org-agenda-custom-commands - '(("w" todo "WAITING") + '(("x" agenda) + ("y" agenda*) + ("w" todo "WAITING") ("W" todo-tree "WAITING") ("u" tags "+boss-urgent") ("v" tags-todo "+boss-urgent") @@ -8649,6 +9160,15 @@ expression to be used for the matching. The example above will therefore define: @table @kbd +@item C-c a x +as a global search for agenda entries planned@footnote{@emph{Planned} means +here that these entries have some planning information attached to them, like +a time-stamp, a scheduled or a deadline string. See +@var{org-agenda-entry-types} on how to set what planning information will be +taken into account.} this week/day. +@item C-c a y +as a global search for agenda entries planned this week/day, but only those +with an hour specification like @code{[h]h:mm}---think of them as appointments. @item C-c a w as a global search for TODO entries with @samp{WAITING} as the TODO keyword @@ -8720,7 +9240,7 @@ and display. The global variables define the behavior for all agenda commands, including the custom commands. However, if you want to change some settings just for a single custom view, you can do so. Setting options requires inserting a list of variable names and values at the -right spot in @code{org-agenda-custom-commands}. For example: +right spot in @var{org-agenda-custom-commands}. For example: @lisp @group @@ -8748,7 +9268,7 @@ to only a single file. @vindex org-agenda-custom-commands For command sets creating a block agenda, -@code{org-agenda-custom-commands} has two separate spots for setting +@var{org-agenda-custom-commands} has two separate spots for setting options. You can add options that should be valid for just a single command in the set, and options that should be valid for all commands in the set. The former are just added to the command entry; the latter @@ -8788,18 +9308,18 @@ say for example that you have an agenda commands @code{"o"} displaying a view that you only need when reading emails. Then you would configure this option like this: -@example +@lisp (setq org-agenda-custom-commands-contexts '(("o" (in-mode . "message-mode")))) -@end example +@end lisp You can also tell that the command key @code{"o"} should refer to another command key @code{"r"}. In that case, add this command key like this: -@example +@lisp (setq org-agenda-custom-commands-contexts '(("o" "r" (in-mode . "message-mode")))) -@end example +@end lisp See the docstring of the variable for more information. @@ -8824,7 +9344,7 @@ Write the agenda view to a file. Depending on the extension of the selected file name, the view will be exported as HTML (extension @file{.html} or @file{.htm}), Postscript (extension @file{.ps}), iCalendar (extension @file{.ics}), or plain text (any other extension). Use the variable -@code{org-agenda-exporter-settings} to set options for @file{ps-print} and +@var{org-agenda-exporter-settings} to set options for @file{ps-print} and for @file{htmlize} to be used during export, for example @vindex org-agenda-add-entry-text-maxlines @@ -8874,7 +9394,7 @@ or absolute. The extension of the file name determines the type of export. If it is @file{.html}, Org mode will use the @file{htmlize.el} package to convert the buffer to HTML and save it to this file name. If the extension is -@file{.ps}, @code{ps-print-buffer-with-faces} is used to produce +@file{.ps}, @var{ps-print-buffer-with-faces} is used to produce Postscript output. If the extension is @file{.ics}, iCalendar export is run export over all files that were used to construct the agenda, and limit the export to entries listed in the agenda. Any other @@ -8913,8 +9433,8 @@ the agenda prefix to omit category and scheduling information, and instead include a checkbox to check off items. We also remove the tags to make the lines compact, and we don't want to use colors for the black-and-white printer. Settings specified in -@code{org-agenda-exporter-settings} will also apply, but the settings -in @code{org-agenda-custom-commands} take precedence. +@var{org-agenda-exporter-settings} will also apply, but the settings +in @var{org-agenda-custom-commands} take precedence. @noindent From the command line you may also use @@ -8968,11 +9488,11 @@ This causes the following issues: Org needs to make a decision which @code{COLUMNS} format to use. Since the entries in the agenda are collected from different files, and different files may have different @code{COLUMNS} formats, this is a non-trivial problem. -Org first checks if the variable @code{org-agenda-overriding-columns-format} is +Org first checks if the variable @var{org-agenda-overriding-columns-format} is currently set, and if so, takes the format from there. Otherwise it takes the format associated with the first item in the agenda, or, if that item does not have a specific format (defined in a property, or in its file), it -uses @code{org-columns-default-format}. +uses @var{org-columns-default-format}. @item @cindex property, special, CLOCKSUM If any of the columns has a summary type defined (@pxref{Column attributes}), @@ -9010,19 +9530,20 @@ spent (via @code{CLOCKSUM}) and with the planned total effort for it. @chapter Markup for rich export When exporting Org mode documents, the exporter tries to reflect the -structure of the document as accurately as possible in the backend. Since -export targets like HTML, @LaTeX{}, or DocBook allow much richer formatting, -Org mode has rules on how to prepare text for rich export. This section -summarizes the markup rules used in an Org mode buffer. +structure of the document as accurately as possible in the back-end. Since +export targets like HTML, @LaTeX{} allow much richer formatting, Org mode has +rules on how to prepare text for rich export. This section summarizes the +markup rules used in an Org mode buffer. @menu * Structural markup elements:: The basic structure as seen by the exporter -* Images and tables:: Tables and Images will be included +* Images and tables:: Images, tables and caption mechanism * Literal examples:: Source code examples with special formatting * Include files:: Include additional files into a document * Index entries:: Making an index -* Macro replacement:: Use macros to create complex output +* Macro replacement:: Use macros to create templates * Embedded @LaTeX{}:: LaTeX can be freely used inside Org documents +* Special blocks:: Containers targeted at export back-ends @end menu @node Structural markup elements, Images and tables, Markup, Markup @@ -9032,7 +9553,6 @@ summarizes the markup rules used in an Org mode buffer. * Document title:: Where the title is taken from * Headings and sections:: The document structure as seen by the exporter * Table of contents:: The if and where of the table of contents -* Initial text:: Text before the first heading? * Lists:: Lists * Paragraphs:: Paragraphs * Footnote markup:: Footnotes @@ -9054,10 +9574,8 @@ The title of the exported document is taken from the special line @end example @noindent -If this line does not exist, the title is derived from the first non-empty, -non-comment line in the buffer. If no such line exists, or if you have -turned off exporting of the text before the first headline (see below), the -title will be the file name without extension. +If this line does not exist, the title will be the name of the file +associated to buffer, without extension, or the buffer name. @cindex property, EXPORT_TITLE If you are exporting only a subtree by marking is as the region, the heading @@ -9074,7 +9592,7 @@ Structure}, forms the basis for defining sections of the exported document. However, since the outline structure is also used for (for example) lists of tasks, only the first three outline levels will be used as headings. Deeper levels will become itemized lists. You can change the location of this -switch globally by setting the variable @code{org-export-headline-levels}, or on a +switch globally by setting the variable @var{org-export-headline-levels}, or on a per-file basis with a line @cindex #+OPTIONS @@ -9082,58 +9600,46 @@ per-file basis with a line #+OPTIONS: H:4 @end example -@node Table of contents, Initial text, Headings and sections, Structural markup elements +@node Table of contents, Lists, Headings and sections, Structural markup elements @subheading Table of contents @cindex table of contents, markup rules +@cindex #+TOC @vindex org-export-with-toc The table of contents is normally inserted directly before the first headline -of the file. If you would like to get it to a different location, insert the -string @code{[TABLE-OF-CONTENTS]} on a line by itself at the desired -location. The depth of the table of contents is by default the same as the -number of headline levels, but you can choose a smaller number, or turn off -the table of contents entirely, by configuring the variable -@code{org-export-with-toc}, or on a per-file basis with a line like +of the file. If you would like to get it to a different location, insert +@code{#+TOC: headlines} at the desired location. The depth of the table of +contents is by default the same as the number of headline levels, but you can +choose a smaller number, or turn off the table of contents entirely, by +configuring the variable @var{org-export-with-toc}, or on a per-file basis +with a line like @example #+OPTIONS: toc:2 (only to two levels in TOC) +#+TOC: headlines 2 (the same, at a specific location) #+OPTIONS: toc:nil (no TOC at all) @end example -@node Initial text, Lists, Table of contents, Structural markup elements -@subheading Text before the first headline -@cindex text before first headline, markup rules -@cindex #+TEXT - -Org mode normally exports the text before the first headline, and even uses -the first line as the document title. The text will be fully marked up. If -you need to include literal HTML, @LaTeX{}, or DocBook code, use the special -constructs described below in the sections for the individual exporters. - -@vindex org-export-skip-text-before-1st-heading -Some people like to use the space before the first headline for setup and -internal links and therefore would like to control the exported text before -the first headline in a different way. You can do so by setting the variable -@code{org-export-skip-text-before-1st-heading} to @code{t}. On a per-file -basis, you can get the same effect with @samp{#+OPTIONS: skip:t}. - -@noindent -If you still want to have some text before the first headline, use the -@code{#+TEXT} construct: +The same @code{TOC} keyword can also generate a list of all tables (resp.@: +all listings) with a caption in the buffer. @example -#+OPTIONS: skip:t -#+TEXT: This text will go before the *first* headline. -#+TEXT: [TABLE-OF-CONTENTS] -#+TEXT: This goes between the table of contents and the *first* headline +#+TOC: listings (build a list of listings) +#+TOC: tables (build a list of tables) @end example -@node Lists, Paragraphs, Initial text, Structural markup elements +@cindex property, ALT_TITLE +The headline's title usually determines its corresponding entry in a table of +contents. However, it is possible to specify an alternative title by +setting @code{ALT_TITLE} property accordingly. It will then be used when +building the table. + +@node Lists, Paragraphs, Table of contents, Structural markup elements @subheading Lists @cindex lists, markup rules -Plain lists as described in @ref{Plain lists}, are translated to the backend's -syntax for such lists. Most backends support unordered, ordered, and +Plain lists as described in @ref{Plain lists}, are translated to the back-end's +syntax for such lists. Most back-ends support unordered, ordered, and description lists. @node Paragraphs, Footnote markup, Lists, Structural markup elements @@ -9185,7 +9691,7 @@ but not any simpler @cindex @file{footnote.el} Footnotes defined in the way described in @ref{Footnotes}, will be exported -by all backends. Org allows multiple references to the same note, and +by all back-ends. Org allows multiple references to the same note, and multiple footnotes side by side. @node Emphasis and monospace, Horizontal rules, Footnote markup, Structural markup elements @@ -9197,10 +9703,21 @@ multiple footnotes side by side. @cindex verbatim text, markup rules @cindex code text, markup rules @cindex strike-through text, markup rules +@vindex org-fontify-emphasized-text +@vindex org-emphasis-regexp-components +@vindex org-emphasis-alist You can make words @b{*bold*}, @i{/italic/}, _underlined_, @code{=code=} and @code{~verbatim~}, and, if you must, @samp{+strike-through+}. Text in the code and verbatim string is not processed for Org mode specific -syntax; it is exported verbatim. +syntax, it is exported verbatim. + +To turn off fontification for marked up text, you can set +@var{org-fontify-emphasized-text} to @code{nil}. To narrow down the list of +available markup syntax, you can customize @var{org-emphasis-alist}. To fine +tune what characters are allowed before and after the markup characters, you +can tweak @var{org-emphasis-regexp-components}. Beware that changing one of +the above variables will no take effect until you reload Org, for which you +may need to restart Emacs. @node Horizontal rules, Comment lines, Emphasis and monospace, Structural markup elements @subheading Horizontal rules @@ -9232,45 +9749,48 @@ Toggle the COMMENT keyword at the beginning of an entry. @cindex tables, markup rules @cindex #+CAPTION -@cindex #+LABEL +@cindex #+NAME Both the native Org mode tables (@pxref{Tables}) and tables formatted with the @file{table.el} package will be exported properly. For Org mode tables, the lines before the first horizontal separator line will become table header lines. You can use the following lines somewhere before the table to assign a caption and a label for cross references, and in the text you can refer to -the object with @code{\ref@{tab:basic-data@}}: +the object with @code{[[tab:basic-data]]} (@pxref{Internal links}): @example #+CAPTION: This is the caption for the next table (or link) -#+LABEL: tab:basic-data +#+NAME: tab:basic-data | ... | ...| |-----|----| @end example Optionally, the caption can take the form: @example -#+CAPTION: [Caption for list of figures]@{Caption for table (or link).@} +#+CAPTION[Caption for list of tables]: Caption for table. @end example @cindex inlined images, markup rules -Some backends (HTML, @LaTeX{}, and DocBook) allow you to directly include -images into the exported document. Org does this, if a link to an image -files does not have a description part, for example @code{[[./img/a.jpg]]}. -If you wish to define a caption for the image and maybe a label for internal -cross references, make sure that the link is on a line by itself and precede -it with @code{#+CAPTION} and @code{#+LABEL} as follows: +Some back-ends allow you to directly include images into the exported +document. Org does this, if a link to an image files does not have +a description part, for example @code{[[./img/a.jpg]]}. If you wish to +define a caption for the image and maybe a label for internal cross +references, make sure that the link is on a line by itself and precede it +with @code{#+CAPTION} and @code{#+NAME} as follows: @example #+CAPTION: This is the caption for the next figure link (or table) -#+LABEL: fig:SED-HR4049 +#+NAME: fig:SED-HR4049 [[./img/a.jpg]] @end example -You may also define additional attributes for the figure. As this is -backend-specific, see the sections about the individual backends for more -information. +@noindent +Such images can be displayed within the buffer. @xref{Handling links,the +discussion of image links}. -@xref{Handling links,the discussion of image links}. +Even though images and tables are prominent examples of captioned structures, +the same caption mechanism can apply to many others (e.g., @LaTeX{} +equations, source code blocks). Depending on the export back-end, those may +or may not be handled. @node Literal examples, Include files, Images and tables, Markup @section Literal examples @@ -9303,11 +9823,11 @@ Here is an example If the example is source code from a programming language, or any other text that can be marked up by font-lock in Emacs, you can ask for the example to look like the fontified Emacs buffer@footnote{This works automatically for -the HTML backend (it requires version 1.34 of the @file{htmlize.el} package, +the HTML back-end (it requires version 1.34 of the @file{htmlize.el} package, which is distributed with Org). Fontified code chunks in @LaTeX{} can be achieved using either the listings or the @url{http://code.google.com/p/minted, minted,} package. Refer to -@code{org-export-latex-listings} documentation for details.}. This is done +@var{org-latex-listings} documentation for details.}. This is done with the @samp{src} block, where you also need to specify the name of the major mode that should be used to fontify the example@footnote{Code in @samp{src} blocks may also be evaluated either interactively or on export. @@ -9354,7 +9874,7 @@ jumps to point-min. @vindex org-coderef-label-format If the syntax for the label format conflicts with the language syntax, use a @code{-l} switch to change the format, for example @samp{#+BEGIN_SRC pascal --n -r -l "((%s))"}. See also the variable @code{org-coderef-label-format}. +-n -r -l "((%s))"}. See also the variable @var{org-coderef-label-format}. HTML export also allows examples to be published as text areas (@pxref{Text areas in HTML export}). @@ -9375,7 +9895,7 @@ commas will be stripped for editing with @kbd{C-c '}, and also for export.}. The edited version will then replace the old version in the Org buffer. Fixed-width regions (where each line starts with a colon followed by a space) will be edited using @code{artist-mode}@footnote{You may select -a different-mode with the variable @code{org-edit-fixed-width-region-mode}.} +a different-mode with the variable @var{org-edit-fixed-width-region-mode}.} to allow creating ASCII drawings easily. Using this command in an empty line will create a new fixed-width region. @kindex C-c l @@ -9399,20 +9919,24 @@ include your @file{.emacs} file, you could use: @example #+INCLUDE: "~/.emacs" src emacs-lisp @end example + @noindent The optional second and third parameter are the markup (e.g., @samp{quote}, @samp{example}, or @samp{src}), and, if the markup is @samp{src}, the language for formatting the contents. The markup is optional; if it is not given, the text will be assumed to be in Org mode format and will be -processed normally. The include line will also allow additional keyword -parameters @code{:prefix1} and @code{:prefix} to specify prefixes for the -first line and for each following line, @code{:minlevel} in order to get -Org mode content demoted to a specified level, as well as any options -accepted by the selected markup. For example, to include a file as an item, -use +processed normally. + +Contents of the included file will belong to the same structure (headline, +item) containing the @code{INCLUDE} keyword. In particular, headlines within +the file will become children of the current section. That behaviour can be +changed by providing an additional keyword parameter, @code{:minlevel}. In +that case, all headlines in the included file will be shifted so the one with +the lowest level reaches that specified level. For example, to make a file +become a sibling of the current top-level headline, use @example -#+INCLUDE: "~/snippets/xx" :prefix1 " + " :prefix " " +#+INCLUDE: "~/my-book/chapter2.org" :minlevel 1 @end example You can also include a portion of a file by specifying a lines range using @@ -9461,21 +9985,24 @@ You can define text snippets with #+MACRO: name replacement text $1, $2 are arguments @end example -@noindent which can be referenced anywhere in the document (even in -code examples) with @code{@{@{@{name(arg1,arg2)@}@}@}}. 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 +@noindent which can be referenced in +paragraphs, verse blocks, table cells and some keywords with +@code{@{@{@{name(arg1,arg2)@}@}@}}@footnote{Since commas separate arguments, +commas within arguments have to be escaped with a backslash character. +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 @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 @code{format-time-string}. -Macro expansion takes place during export, and some people use it to -construct complex HTML code. +Macro expansion takes place during export. -@node Embedded @LaTeX{}, , Macro replacement, Markup +@node Embedded @LaTeX{}, Special blocks, Macro replacement, Markup @section Embedded @LaTeX{} @cindex @TeX{} interpretation @cindex @LaTeX{} interpretation @@ -9488,7 +10015,7 @@ Donald E. Knuth's @TeX{} system. Many of the features described here as distinction.} is widely used to typeset scientific documents. Org mode supports embedding @LaTeX{} code into its files, because many academics are used to writing and reading @LaTeX{} source code, and because it can be -readily processed to produce pretty output for a number of export backends. +readily processed to produce pretty output for a number of export back-ends. @menu * Special symbols:: Greek letters and other symbols @@ -9507,11 +10034,11 @@ readily processed to produce pretty output for a number of export backends. @cindex HTML entities @cindex @LaTeX{} entities -You can use @LaTeX{} macros to insert special symbols like @samp{\alpha} to -indicate the Greek letter, or @samp{\to} to indicate an arrow. Completion -for these macros is available, just type @samp{\} and maybe a few letters, +You can use @LaTeX{}-like syntax to insert special symbols like @samp{\alpha} +to indicate the Greek letter, or @samp{\to} to indicate an arrow. Completion +for these symbols is available, just type @samp{\} and maybe a few letters, and press @kbd{M-@key{TAB}} to see possible completions. Unlike @LaTeX{} -code, Org mode allows these macros to be present without surrounding math +code, Org mode allows these symbols to be present without surrounding math delimiters, for example: @example @@ -9520,24 +10047,25 @@ Angles are written as Greek letters \alpha, \beta and \gamma. @vindex org-entities During export, these symbols will be transformed into the native format of -the exporter backend. Strings like @code{\alpha} will be exported as +the exporter back-end. Strings like @code{\alpha} will be exported as @code{α} in the HTML output, and as @code{$\alpha$} in the @LaTeX{} output. Similarly, @code{\nbsp} will become @code{ } in HTML and @code{~} in @LaTeX{}. If you need such a symbol inside a word, terminate it like this: @samp{\Aacute@{@}stor}. A large number of entities is provided, with names taken from both HTML and -@LaTeX{}; see the variable @code{org-entities} for the complete list. +@LaTeX{}; see the variable @var{org-entities} for the complete list. @samp{\-} is treated as a shy hyphen, and @samp{--}, @samp{---}, and @samp{...} are all converted into special commands creating hyphens of different lengths or a compact set of dots. -If you would like to see entities displayed as UTF8 characters, use the +If you would like to see entities displayed as UTF-8 characters, use the following command@footnote{You can turn this on by default by setting the -variable @code{org-pretty-entities}, or on a per-file base with the +variable @var{org-pretty-entities}, or on a per-file base with the @code{#+STARTUP} option @code{entitiespretty}.}: @table @kbd +@cindex @code{entitiespretty}, STARTUP keyword @kindex C-c C-x \ @item C-c C-x \ Toggle display of entities as UTF-8 characters. This does not change the @@ -9550,31 +10078,25 @@ for display purposes only. @cindex subscript @cindex superscript -Just like in @LaTeX{}, @samp{^} and @samp{_} are used to indicate super- -and subscripts. Again, these can be used without embedding them in -math-mode delimiters. To increase the readability of ASCII text, it is -not necessary (but OK) to surround multi-character sub- and superscripts -with curly braces. For example +Just like in @LaTeX{}, @samp{^} and @samp{_} are used to indicate super- and +subscripts. Again, these can be used without embedding them in math-mode +delimiters. To increase the readability of ASCII text, it is not necessary +(but OK) to surround multi-character sub- and superscripts with curly braces. +For example @example The mass of the sun is M_sun = 1.989 x 10^30 kg. The radius of the sun is R_@{sun@} = 6.96 x 10^8 m. @end example -@vindex org-export-with-sub-superscripts +@vindex org-use-sub-superscripts To avoid interpretation as raised or lowered text, you can quote @samp{^} and @samp{_} with a backslash: @samp{\^} and @samp{\_}. If you write a text where the underscore is often used in a different context, Org's convention to always interpret these as subscripts can get in your way. Configure the -variable @code{org-export-with-sub-superscripts} to globally change this -convention, or use, on a per-file basis: - -@example -#+OPTIONS: ^:@{@} -@end example - -@noindent With this setting, @samp{a_b} will not be interpreted as a -subscript, but @samp{a_@{b@}} will. +variable @var{org-use-sub-superscripts} to change this convention. For +example, when setting this variable to @code{@{@}}, @samp{a_b} will not be +interpreted as a subscript, but @samp{a_@{b@}} will. @table @kbd @kindex C-c C-x \ @@ -9590,31 +10112,31 @@ format sub- and superscripts in a WYSIWYM way. @vindex org-format-latex-header Going beyond symbols and sub- and superscripts, a full formula language is needed. Org mode can contain @LaTeX{} math fragments, and it supports ways -to process these for several export backends. When exporting to @LaTeX{}, +to process these for several export back-ends. When exporting to @LaTeX{}, the code is obviously left as it is. When exporting to HTML, Org invokes the @uref{http://www.mathjax.org, MathJax library} (@pxref{Math formatting in HTML export}) to process and display the math@footnote{If you plan to use this regularly or on pages with significant page views, you should install -@file{MathJax} on your own -server in order to limit the load of our server.}. Finally, it can also -process the mathematical expressions into images@footnote{For this to work -you need to be on a system with a working @LaTeX{} installation. You also -need the @file{dvipng} program or the @file{convert}, respectively available -at @url{http://sourceforge.net/projects/dvipng/} and from the -@file{imagemagick} suite. The @LaTeX{} header that will be used when -processing a fragment can be configured with the variable -@code{org-format-latex-header}.} that can be displayed in a browser or in -DocBook documents. +@file{MathJax} on your own server in order to limit the load of our server.}. +Finally, it can also process the mathematical expressions into +images@footnote{For this to work you need to be on a system with a working +@LaTeX{} installation. You also need the @file{dvipng} program or the +@file{convert}, respectively available at +@url{http://sourceforge.net/projects/dvipng/} and from the @file{imagemagick} +suite. The @LaTeX{} header that will be used when processing a fragment can +be configured with the variable @var{org-format-latex-header}.} that can be +displayed in a browser. @LaTeX{} fragments don't need any special marking at all. The following snippets will be identified as @LaTeX{} source code: @itemize @bullet @item Environments of any kind@footnote{When @file{MathJax} is used, only the -environment recognized by @file{MathJax} will be processed. When -@file{dvipng} is used to create images, any @LaTeX{} environments will be -handled.}. The only requirement is that the @code{\begin} statement appears -on a new line, preceded by only whitespace. +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. @item Text within the usual @LaTeX{} math delimiters. To avoid conflicts with currency specifications, single @samp{$} characters are only recognized as @@ -9628,40 +10150,45 @@ For the other delimiters, there is no such restriction, so when in doubt, use @noindent For example: @example -\begin@{equation@} % arbitrary environments, -x=\sqrt@{b@} % even tables, figures -\end@{equation@} % etc +\begin@{equation@} +x=\sqrt@{b@} +\end@{equation@} If $a^2=b$ and \( b=2 \), then the solution must be either $$ a=+\sqrt@{2@} $$ or \[ a=-\sqrt@{2@} \]. @end example -@noindent -@vindex org-format-latex-options -If you need any of the delimiter ASCII sequences for other purposes, you -can configure the option @code{org-format-latex-options} to deselect the -ones you do not wish to have interpreted by the @LaTeX{} converter. +@c FIXME +@c @noindent +@c @vindex org-format-latex-options +@c If you need any of the delimiter ASCII sequences for other purposes, you +@c can configure the option @code{org-format-latex-options} to deselect the +@c ones you do not wish to have interpreted by the @LaTeX{} converter. -@vindex org-export-with-LaTeX-fragments +@vindex org-export-with-latex @LaTeX{} processing can be configured with the variable -@code{org-export-with-LaTeX-fragments}. The default setting is @code{t} -which means @file{MathJax} for HTML, and no processing for DocBook, ASCII and -@LaTeX{} backends. You can also set this variable on a per-file basis using one -of these lines: +@var{org-export-with-latex}. The default setting is @code{t} which means +@file{MathJax} for HTML, and no processing for ASCII and @LaTeX{} back-ends. +You can also set this variable on a per-file basis using one of these +lines: @example -#+OPTIONS: LaTeX:t @r{Do the right thing automatically (MathJax)} -#+OPTIONS: LaTeX:dvipng @r{Force using dvipng images} -#+OPTIONS: LaTeX:nil @r{Do not process @LaTeX{} fragments at all} -#+OPTIONS: LaTeX:verbatim @r{Verbatim export, for jsMath or so} +#+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 @node Previewing @LaTeX{} fragments, CDLaTeX mode, @LaTeX{} fragments, Embedded @LaTeX{} @subsection Previewing @LaTeX{} fragments @cindex @LaTeX{} fragments, preview -If you have @file{dvipng} installed, @LaTeX{} fragments can be processed to -produce preview images of the typeset expressions: +@vindex org-latex-create-formula-image-program +If you have @file{dvipng} or @file{imagemagick} installed@footnote{Choose the +converter by setting the variable +@var{org-latex-create-formula-image-program} accordingly.}, @LaTeX{} +fragments can be processed to produce preview images of the typeset +expressions: @table @kbd @kindex C-c C-x C-l @@ -9678,11 +10205,24 @@ Remove the overlay preview images. @end table @vindex org-format-latex-options -You can customize the variable @code{org-format-latex-options} to influence +You can customize the variable @var{org-format-latex-options} to influence some aspects of the preview. In particular, the @code{:scale} (and for HTML export, @code{:html-scale}) property can be used to adjust the size of the preview images. +@vindex org-startup-with-latex-preview +You can turn on the previewing of all @LaTeX{} fragments in a file with + +@example +#+STARTUP: latexpreview +@end example + +To disable it, simply use + +@example +#+STARTUP: nolatexpreview +@end example + @node CDLaTeX mode, , Previewing @LaTeX{} fragments, Embedded @LaTeX{} @subsection Using CD@LaTeX{} to enter math @cindex CD@LaTeX{} @@ -9694,8 +10234,8 @@ some of the features of CD@LaTeX{} mode. You need to install @file{cdlatex.el} and @file{texmathp.el} (the latter comes also with AUC@TeX{}) from @url{http://www.astro.uva.nl/~dominik/Tools/cdlatex}. Don't use CD@LaTeX{} mode itself under Org mode, but use the light -version @code{org-cdlatex-mode} that comes as part of Org mode. Turn it -on for the current buffer with @code{M-x org-cdlatex-mode}, or for all +version @var{org-cdlatex-mode} that comes as part of Org mode. Turn it +on for the current buffer with @kbd{M-x org-cdlatex-mode RET}, or for all Org files with @lisp @@ -9713,14 +10253,14 @@ Environment templates can be inserted with @kbd{C-c @{}. The @key{TAB} key will do template expansion if the cursor is inside a @LaTeX{} fragment@footnote{Org mode has a method to test if the cursor is inside such a fragment, see the documentation of the function -@code{org-inside-LaTeX-fragment-p}.}. For example, @key{TAB} will +@var{org-inside-LaTeX-fragment-p}.}. For example, @key{TAB} will expand @code{fr} to @code{\frac@{@}@{@}} and position the cursor correctly inside the first brace. Another @key{TAB} will get you into the second brace. Even outside fragments, @key{TAB} will expand environment abbreviations at the beginning of a line. For example, if you write @samp{equ} at the beginning of a line and press @key{TAB}, this abbreviation will be expanded to an @code{equation} environment. -To get a list of all abbreviations, type @kbd{M-x cdlatex-command-help}. +To get a list of all abbreviations, type @kbd{M-x cdlatex-command-help RET}. @item @kindex _ @kindex ^ @@ -9729,7 +10269,7 @@ Pressing @kbd{_} and @kbd{^} inside a @LaTeX{} fragment will insert these characters together with a pair of braces. If you use @key{TAB} to move out of the braces, and if the braces surround only a single character or macro, they are removed again (depending on the variable -@code{cdlatex-simplify-sub-super-scripts}). +@var{cdlatex-simplify-sub-super-scripts}). @item @kindex ` Pressing the backquote @kbd{`} followed by a character inserts math @@ -9744,235 +10284,393 @@ modification will work only inside @LaTeX{} fragments; outside the quote is normal. @end itemize +@node Special blocks, , Embedded @LaTeX{}, Markup +@section Special blocks +@cindex Special blocks + +Org syntax includes pre-defined blocks (@pxref{Paragraphs} and @ref{Literal +examples}). It is also possible to create blocks containing raw code +targeted at a specific back-ends (e.g., @samp{#+BEGIN_LATEX}). + +Any other block is a @emph{special block}. Each export back-end decides if +they should be exported, and how. When the block is ignored, its contents +are still exported, as if the block were not there. For example, when +exporting a @samp{#+BEGIN_TEST} block, HTML back-end wraps its contents +within @samp{
    } tag. Refer to back-end specific +documentation for more information. + @node Exporting, Publishing, Markup, Top @chapter Exporting @cindex exporting -Org mode documents can be exported into a variety of other formats. For -printing and sharing of notes, ASCII export produces a readable and simple -version of an Org file. HTML export allows you to publish a notes file on -the web, while the XOXO format provides a solid base for exchange with a -broad range of other applications. @LaTeX{} export lets you use Org mode and -its structured editing functions to easily create @LaTeX{} files. DocBook -export makes it possible to convert Org files to many other formats using -DocBook tools. OpenDocument Text (ODT) export allows seamless -collaboration across organizational boundaries. For project management you -can create gantt and resource charts by using TaskJuggler export. To -incorporate entries with associated times like deadlines or appointments into -a desktop calendar program like iCal, Org mode can also produce extracts in -the iCalendar format. Currently, Org mode only supports export, not import of -these different formats. +The Org mode export facilities can be used to export Org documents or parts +of Org documents to a variety of other formats. In addition, these +facilities can be used with @code{orgtbl-mode} and/or @code{orgstruct-mode} +in foreign buffers so you can author tables and lists in Org syntax and +convert them in place to the target language. -Org supports export of selected regions when @code{transient-mark-mode} is -enabled (default in Emacs 23). +ASCII export produces a readable and simple version of an Org file for +printing and sharing notes. HTML export allows you to easily publish notes +on the web, or to build full-fledged websites. @LaTeX{} export lets you use +Org mode and its structured editing functions to create arbitrarily complex +@LaTeX{} files for any kind of document. OpenDocument Text (ODT) export +allows seamless collaboration across organizational boundaries. Markdown +export lets you seamlessly collaborate with other developers. Finally, iCal +export can extract entries with deadlines or appointments to produce a file +in the iCalendar format. @menu -* Selective export:: Using tags to select and exclude trees -* Export options:: Per-file export settings -* The export dispatcher:: How to access exporter commands +* The Export Dispatcher:: The main exporter interface +* Export back-ends:: Built-in export formats +* Export settings:: Generic export settings * ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding +* Beamer export:: Exporting as a Beamer presentation * HTML export:: Exporting to HTML * @LaTeX{} and PDF export:: Exporting to @LaTeX{}, and processing to PDF -* DocBook export:: Exporting to DocBook +* Markdown export:: Exporting to Markdown * OpenDocument Text export:: Exporting to OpenDocument Text -* TaskJuggler export:: Exporting to TaskJuggler -* Freemind export:: Exporting to Freemind mind maps -* XOXO export:: Exporting to XOXO -* iCalendar export:: Exporting in iCalendar format +* iCalendar export:: Exporting to iCalendar +* Other built-in back-ends:: Exporting to @code{Texinfo}, a man page, or Org +* Export in foreign buffers:: Author tables in lists in Org syntax +* Advanced configuration:: Fine-tuning the export output @end menu -@node Selective export, Export options, Exporting, Exporting -@section Selective export -@cindex export, selective by tags or TODO keyword +@node The Export Dispatcher, Export back-ends, Exporting, Exporting +@section The Export Dispatcher +@vindex org-export-dispatch-use-expert-ui +@cindex Export, dispatcher -@vindex org-export-select-tags -@vindex org-export-exclude-tags -@cindex org-export-with-tasks -You may use tags to select the parts of a document that should be exported, -or to exclude parts from export. This behavior is governed by two variables: -@code{org-export-select-tags} and @code{org-export-exclude-tags}, -respectively defaulting to @code{'(:export:)} and @code{'(:noexport:)}. +The main entry point for export related tasks is the dispatcher, a +hierarchical menu from which it is possible to select an export format and +toggle export options@footnote{It is also possible to use a less intrusive +interface by setting @var{org-export-dispatch-use-expert-ui} to a +non-@code{nil} value. In that case, only a prompt is visible from the +minibuffer. From there one can still switch back to regular menu by pressing +@key{?}.} from which it is possible to select an export format and to toggle +export options. -@enumerate -@item -Org first checks if any of the @emph{select} tags is present in the -buffer. If yes, all trees that do not carry one of these tags will be -excluded. If a selected tree is a subtree, the heading hierarchy above it -will also be selected for export, but not the text below those headings. +@c @quotation +@table @asis +@orgcmd{C-c C-e,org-export-dispatch} -@item -If none of the select tags is found, the whole buffer will be selected for -export. +Dispatch for export and publishing commands. When called with a @kbd{C-u} +prefix argument, repeat the last export command on the current buffer while +preserving toggled options. If the current buffer hasn't changed and subtree +export was activated, the command will affect that same subtree. +@end table +@c @end quotation -@item -Finally, all subtrees that are marked by any of the @emph{exclude} tags will -be removed from the export buffer. -@end enumerate +Normally the entire buffer is exported, but if there is an active region +only that part of the buffer will be exported. -The variable @code{org-export-with-tasks} can be configured to select which -kind of tasks should be included for export. See the docstring of the -variable for more information. - -@node Export options, The export dispatcher, Selective export, Exporting -@section Export options -@cindex options, for export - -@cindex completion, of option keywords -The exporter recognizes special lines in the buffer which provide -additional information. These lines may be put anywhere in the file. -The whole set of lines can be inserted into the buffer with @kbd{C-c -C-e t}. For individual lines, a good way to make sure the keyword is -correct is to type @samp{#+} and then use @kbd{M-@key{TAB}} completion -(@pxref{Completion}). For a summary of other in-buffer settings not -specifically related to export, see @ref{In-buffer settings}. -In particular, note that you can place commonly-used (export) options in -a separate file which can be included using @code{#+SETUPFILE}. +Several export options (@pxref{Export settings}) can be toggled from the +export dispatcher with the following key combinations: @table @kbd -@orgcmd{C-c C-e t,org-insert-export-options-template} -Insert template with export options, see example below. +@item C-a +@vindex org-export-async-init-file +Toggle asynchronous export. Asynchronous export uses an external Emacs +process that is configured with a specified initialization file. + +While exporting asynchronously, the output is not displayed. It is stored in +a list called ``the export stack'', and can be viewed from there. The stack +can be reached by calling the dispatcher with a double @kbd{C-u} prefix +argument, or with @kbd{&} key from the dispatcher. + +@vindex org-export-in-background +To make this behaviour the default, customize the variable +@var{org-export-in-background}. + +@item C-b +Toggle body-only export. Its effect depends on the back-end used. +Typically, if the back-end has a header section (like @code{...} +in the HTML back-end), a body-only export will not include this header. + +@item C-s +@vindex org-export-initial-scope +Toggle subtree export. The top heading becomes the document title. + +You can change the default state of this option by setting +@var{org-export-initial-scope}. + +@item C-v +Toggle visible-only export. Only export the text that is currently +visible, i.e. not hidden by outline visibility in the buffer. + @end table -@cindex #+TITLE -@cindex #+AUTHOR -@cindex #+DATE -@cindex #+EMAIL -@cindex #+DESCRIPTION -@cindex #+KEYWORDS -@cindex #+LANGUAGE -@cindex #+TEXT -@cindex #+OPTIONS -@cindex #+BIND -@cindex #+LINK_UP -@cindex #+LINK_HOME -@cindex #+EXPORT_SELECT_TAGS -@cindex #+EXPORT_EXCLUDE_TAGS -@cindex #+XSLT -@cindex #+LaTeX_HEADER +@vindex org-export-copy-to-kill-ring +With the exception of asynchronous export, a successful export process writes +its output to the kill-ring. You can configure this behavior by altering the +option @var{org-export-copy-to-kill-ring}. + +@node Export back-ends, Export settings, The Export Dispatcher, Exporting +@section Export back-ends +@cindex Export, back-ends + +An export back-end is a library that translates Org syntax into a foreign +format. An export format is not available until the proper back-end has been +loaded. + +@vindex org-export-backends +By default, the following four back-ends are loaded: @code{ascii}, +@code{html}, @code{icalendar} and @code{latex}. It is possible to add more +(or remove some) by customizing @var{org-export-backends}. + +Built-in back-ends include: + +@itemize +@item ascii (ASCII format) +@item beamer (@LaTeX{} Beamer format) +@item html (HTML format) +@item icalendar (iCalendar format) +@item latex (@LaTeX{} format) +@item man (Man page format) +@item md (Markdown format) +@item odt (OpenDocument Text format) +@item texinfo (Texinfo format) +@end itemize + +Other back-ends might be found in the @code{contrib/} directory +(@pxref{Installation}). + +@node Export settings, ASCII/Latin-1/UTF-8 export, Export back-ends, Exporting +@section Export settings +@cindex Export, settings + +Export options can be set: globally with variables; for an individual file by +making variables buffer-local with in-buffer settings (@pxref{In-buffer +settings}), by setting individual keywords, or by specifying them in a +compact form with the @code{#+OPTIONS} keyword; or for a tree by setting +properties (@pxref{Properties and Columns}). Options set at a specific level +override options set at a more general level. + +@cindex #+SETUPFILE +In-buffer settings may appear anywhere in the file, either directly or +indirectly through a file included using @samp{#+SETUPFILE: filename} syntax. +Option keyword sets tailored to a particular back-end can be inserted from +the export dispatcher (@pxref{The Export Dispatcher}) using the @code{Insert +template} command by pressing @key{#}. To insert keywords individually, +a good way to make sure the keyword is correct is to type @code{#+} and then +to use @kbd{M-} for completion. + +The export keywords available for every back-end, and their equivalent global +variables, include: + +@table @samp +@item AUTHOR @vindex user-full-name -@vindex user-mail-address -@vindex org-export-default-language +The document author (@var{user-full-name}). + +@item CREATOR +@vindex org-export-creator-string +Entity responsible for output generation (@var{org-export-creator-string}). + +@item DATE @vindex org-export-date-timestamp-format -@example -#+TITLE: the title to be shown (default is the buffer name) -#+AUTHOR: the author (default taken from @code{user-full-name}) -#+DATE: a date, an Org timestamp@footnote{@code{org-export-date-timestamp-format} defines how this timestamp will be exported.}, or a format string for @code{format-time-string} -#+EMAIL: his/her email address (default from @code{user-mail-address}) -#+DESCRIPTION: the page description, e.g., for the XHTML meta tag -#+KEYWORDS: the page keywords, e.g., for the XHTML meta tag -#+LANGUAGE: language for HTML, e.g., @samp{en} (@code{org-export-default-language}) -#+TEXT: Some descriptive text to be inserted at the beginning. -#+TEXT: Several lines may be given. -#+OPTIONS: H:2 num:t toc:t \n:nil @@:t ::t |:t ^:t f:t TeX:t ... -#+BIND: lisp-var lisp-val, e.g., @code{org-export-latex-low-levels itemize} - @r{You need to confirm using these, or configure @code{org-export-allow-BIND}} -#+LINK_UP: the ``up'' link of an exported page -#+LINK_HOME: the ``home'' link of an exported page -#+LaTeX_HEADER: extra line(s) for the @LaTeX{} header, like \usepackage@{xyz@} -#+EXPORT_SELECT_TAGS: Tags that select a tree for export -#+EXPORT_EXCLUDE_TAGS: Tags that exclude a tree from export -#+XSLT: the XSLT stylesheet used by DocBook exporter to generate FO file -@end example +A date or a time-stamp@footnote{The variable +@var{org-export-date-timestamp-format} defines how this time-stamp will be +exported.}. -@noindent -The @code{#+OPTIONS} line is a compact@footnote{If you want to configure many options -this way, you can use several @code{#+OPTIONS} lines.} form to specify export -settings. Here you can: -@cindex headline levels -@cindex section-numbers -@cindex table of contents -@cindex line-break preservation -@cindex quoted HTML tags -@cindex fixed-width sections -@cindex tables -@cindex @TeX{}-like syntax for sub- and superscripts -@cindex footnotes -@cindex special strings -@cindex emphasized text -@cindex @TeX{} macros -@cindex @LaTeX{} fragments -@cindex author info, in export -@cindex time info, in export -@vindex org-export-plist-vars -@vindex org-export-author-info -@vindex org-export-creator-info -@vindex org-export-email-info -@vindex org-export-time-stamp-file -@example -H: @r{set the number of headline levels for export} -num: @r{turn on/off section-numbers} -toc: @r{turn on/off table of contents, or set level limit (integer)} -\n: @r{turn on/off line-break-preservation (DOES NOT WORK)} -@@: @r{turn on/off quoted HTML tags} -:: @r{turn on/off fixed-width sections} -|: @r{turn on/off tables} -^: @r{turn on/off @TeX{}-like syntax for sub- and superscripts. If} - @r{you write "^:@{@}", @code{a_@{b@}} will be interpreted, but} - @r{the simple @code{a_b} will be left as it is.} --: @r{turn on/off conversion of special strings.} -f: @r{turn on/off footnotes like this[1].} -todo: @r{turn on/off inclusion of TODO keywords into exported text} -tasks: @r{turn on/off inclusion of tasks (TODO items), can be nil to remove} - @r{all tasks, @code{todo} to remove DONE tasks, or list of kwds to keep} -pri: @r{turn on/off priority cookies} -tags: @r{turn on/off inclusion of tags, may also be @code{not-in-toc}} -<: @r{turn on/off inclusion of any time/date stamps like DEADLINES} -*: @r{turn on/off emphasized text (bold, italic, underlined)} -TeX: @r{turn on/off simple @TeX{} macros in plain text} -LaTeX: @r{configure export of @LaTeX{} fragments. Default @code{auto}} -skip: @r{turn on/off skipping the text before the first heading} -author: @r{turn on/off inclusion of author name/email into exported file} -email: @r{turn on/off inclusion of author email into exported file} -creator: @r{turn on/off inclusion of creator info into exported file} -timestamp: @r{turn on/off inclusion creation time into exported file} -d: @r{turn on/off inclusion of drawers, or list drawers to include} -@end example -@noindent -These options take effect in both the HTML and @LaTeX{} export, except for -@code{TeX} and @code{LaTeX} options, which are respectively @code{t} and -@code{nil} for the @LaTeX{} export. +@item DESCRIPTION +The document description. Back-ends handle it as they see fit (e.g., for the +XHTML meta tag), if at all. You can use several such keywords for long +descriptions. -The default values for these and many other options are given by a set of -variables. For a list of such variables, the corresponding OPTIONS keys and -also the publishing keys (@pxref{Project alist}), see the constant -@code{org-export-plist-vars}. +@item EMAIL +@vindex user-mail-address +The email address (@var{user-mail-address}). -When exporting only a single subtree by selecting it with @kbd{C-c @@} before -calling an export command, the subtree can overrule some of the file's export -settings with properties @code{EXPORT_FILE_NAME}, @code{EXPORT_TITLE}, -@code{EXPORT_TEXT}, @code{EXPORT_AUTHOR}, @code{EXPORT_DATE}, and -@code{EXPORT_OPTIONS}. +@item KEYWORDS +The keywords defining the contents of the document. Back-ends handle it as +they see fit (e.g., for the XHTML meta tag), if at all. You can use several +such keywords if the list is long. -@node The export dispatcher, ASCII/Latin-1/UTF-8 export, Export options, Exporting -@section The export dispatcher -@cindex dispatcher, for export commands +@item LANGUAGE +@vindex org-export-default-language +The language used for translating some strings +(@var{org-export-default-language}). E.g., @samp{#+LANGUAGE: fr} will tell +Org to translate @emph{File} (english) into @emph{Fichier} (french) in the +clocktable. -All export commands can be reached using the export dispatcher, which is a -prefix key that prompts for an additional key specifying the command. -Normally the entire file is exported, but if there is an active region that -contains one outline tree, the first heading is used as document title and -the subtrees are exported. +@item SELECT_TAGS +@vindex org-export-select-tags +The tags that select a tree for export (@var{org-export-select-tags}). The +default value is @code{:export:}. Within a subtree tagged with +@code{:export:}, you can still exclude entries with @code{:noexport:} (see +below). -@table @kbd -@orgcmd{C-c C-e,org-export} -@vindex org-export-run-in-background -Dispatcher for export and publishing commands. Displays a help-window -listing the additional key(s) needed to launch an export or publishing -command. The prefix arg is passed through to the exporter. A double prefix -@kbd{C-u C-u} causes most commands to be executed in the background, in a -separate Emacs process@footnote{To make this behavior the default, customize -the variable @code{org-export-run-in-background}.}. -@orgcmd{C-c C-e v,org-export-visible} -Like @kbd{C-c C-e}, but only export the text that is currently visible -(i.e., not hidden by outline visibility). -@orgcmd{C-u C-u C-c C-e,org-export} -@vindex org-export-run-in-background -Call the exporter, but reverse the setting of -@code{org-export-run-in-background}, i.e., request background processing if -not set, or force processing in the current Emacs process if set. +@item EXCLUDE_TAGS +The tags that exclude a tree from export (@var{org-export-exclude-tags}). +The default value is @code{:noexport:}. Entries with the @code{:noexport:} +tag will be unconditionally excluded from the export, even if they have an +@code{:export:} tag. + +@item TITLE +The title to be shown (otherwise derived from buffer's name). You can use +several such keywords for long titles. @end table -@node ASCII/Latin-1/UTF-8 export, HTML export, The export dispatcher, Exporting +The @code{#+OPTIONS} keyword is a compact@footnote{If you want to configure +many options this way, you can use several @code{#+OPTIONS} lines.} form that +recognizes the following arguments: + +@table @code +@item ': +@vindex org-export-with-smart-quotes +Toggle smart quotes (@var{org-export-with-smart-quotes}). + +@item *: +Toggle emphasized text (@var{org-export-with-emphasize}). + +@item -: +@vindex org-export-with-special-strings +Toggle conversion of special strings +(@var{org-export-with-special-strings}). + +@item :: +@vindex org-export-with-fixed-width +Toggle fixed-width sections +(@var{org-export-with-fixed-width}). + +@item <: +@vindex org-export-with-timestamps +Toggle inclusion of any time/date active/inactive stamps +(@var{org-export-with-timestamps}). + +@item : +@vindex org-export-preserve-breaks +Toggle line-break-preservation (@var{org-export-preserve-breaks}). + +@item ^: +@vindex org-export-with-sub-superscripts +Toggle @TeX{}-like syntax for sub- and superscripts. If you write "^:@{@}", +@samp{a_@{b@}} will be interpreted, but the simple @samp{a_b} will be left as +it is (@var{org-export-with-sub-superscripts}). + +@item arch: +@vindex org-export-with-archived-trees +Configure export of archived trees. Can be set to @code{headline} to only +process the headline, skipping its contents +(@var{org-export-with-archived-trees}). + +@item author: +@vindex org-export-with-author +Toggle inclusion of author name into exported file +(@var{org-export-with-author}). + +@item c: +@vindex org-export-with-clocks +Toggle inclusion of CLOCK keywords (@var{org-export-with-clocks}). + +@item creator: +@vindex org-export-with-creator +Configure inclusion of creator info into exported file. It may be set to +@code{comment} (@var{org-export-with-creator}). + +@item d: +@vindex org-export-with-drawers +Toggle inclusion of drawers, or list drawers to include +(@var{org-export-with-drawers}). + +@item e: +@vindex org-export-with-entities +Toggle inclusion of entities (@var{org-export-with-entities}). + +@item email: +@vindex org-export-with-email +Toggle inclusion of the author's e-mail into exported file +(@var{org-export-with-email}). + +@item f: +@vindex org-export-with-footnotes +Toggle the inclusion of footnotes (@var{org-export-with-footnotes}). + +@item H: +@vindex org-export-headline-levels +Set the number of headline levels for export +(@var{org-export-headline-levels}). Below that level, headlines are treated +differently. In most back-ends, they become list items. + +@item inline: +@vindex org-export-with-inlinetasks +Toggle inclusion of inlinetasks (@var{org-export-with-inlinetasks}). + +@item num: +@vindex org-export-with-section-numbers +Toggle section-numbers (@var{org-export-with-section-numbers}). It can also +be set to a number @samp{n}, so only headlines at that level or above will be +numbered. + +@item p: +@vindex org-export-with-planning +Toggle export of planning information (@var{org-export-with-planning}). +``Planning information'' is the line containing the @code{SCHEDULED:}, the +@code{DEADLINE:} or the @code{CLOSED:} cookies or a combination of them. + +@item pri: +@vindex org-export-with-priority +Toggle inclusion of priority cookies (@var{org-export-with-priority}). + +@item stat: +@vindex org-export-with-statistics-cookies +Toggle inclusion of statistics cookies +(@var{org-export-with-statistics-cookies}). + +@item tags: +@vindex org-export-with-tags +Toggle inclusion of tags, may also be @code{not-in-toc} +(@var{org-export-with-tags}). + +@item tasks: +@vindex org-export-with-tasks +Toggle inclusion of tasks (TODO items), can be @code{nil} to remove all +tasks, @code{todo} to remove DONE tasks, or a list of keywords to keep +(@var{org-export-with-tasks}). + +@item tex: +@vindex org-export-with-latex +Configure export of @LaTeX{} fragments and environments. It may be set to +@code{verbatim} (@var{org-export-with-latex}). + +@item timestamp: +@vindex org-export-time-stamp-file +Toggle inclusion of the creation time into exported file +(@var{org-export-time-stamp-file}). + +@item toc: +@vindex org-export-with-toc +Toggle inclusion of the table of contents, or set the level limit +(@var{org-export-with-toc}). + +@item todo: +@vindex org-export-with-todo-keywords +Toggle inclusion of TODO keywords into exported text +(@var{org-export-with-todo-keywords}). + +@item |: +@vindex org-export-with-tables +Toggle inclusion of tables (@var{org-export-with-tables}). +@end table + +@cindex property, EXPORT_FILE_NAME +When exporting only a subtree, each of the previous keywords@footnote{With +the exception of @samp{SETUPFILE}.} can be overriden locally by special node +properties. These begin with @samp{EXPORT_}, followed by the name of the +keyword they supplant. For example, @samp{DATE} and @samp{OPTIONS} keywords +become, respectively, @samp{EXPORT_DATE} and @samp{EXPORT_OPTIONS} +properties. Subtree export also supports the self-explicit +@samp{EXPORT_FILE_NAME} property@footnote{There is no buffer-wide equivalent +for this property. The file name in this case is derived from the file +associated to the buffer, if possible, or asked to the user otherwise.}. + +@cindex #+BIND +Eventually, Emacs variables can become buffer-local during export by using +the BIND keyword. Its syntax is @samp{#+BIND: variable value}. This is +particularly useful for in-buffer settings that cannot be changed using +specific keywords. + +@node ASCII/Latin-1/UTF-8 export, Beamer export, Export settings, Exporting @section ASCII/Latin-1/UTF-8 export @cindex ASCII export @cindex Latin-1 export @@ -9982,58 +10680,276 @@ ASCII export produces a simple and very readable version of an Org mode file, containing only plain ASCII@. Latin-1 and UTF-8 export augment the file with special characters and symbols available in these encodings. -@cindex region, active -@cindex active region -@cindex transient-mark-mode +@vindex org-ascii-links-to-notes +Links are exported in a footnote-like style, with the descriptive part in the +text and the link in a note before the next heading. See the variable +@var{org-ascii-links-to-notes} for details and other options. + +@subheading ASCII export commands + @table @kbd -@orgcmd{C-c C-e a,org-export-as-ascii} -@cindex property, EXPORT_FILE_NAME +@orgcmd{C-c C-e t a/l/u,org-ascii-export-to-ascii} Export as an ASCII file. For an Org file, @file{myfile.org}, the ASCII file -will be @file{myfile.txt}. The file will be overwritten without -warning. If there is an active region@footnote{This requires -@code{transient-mark-mode} be turned on.}, only the region will be -exported. If the selected region is a single tree@footnote{To select the -current subtree, use @kbd{C-c @@}.}, the tree head will -become the document title. If the tree head entry has or inherits an -@code{EXPORT_FILE_NAME} property, that name will be used for the -export. -@orgcmd{C-c C-e A,org-export-as-ascii-to-buffer} +will be @file{myfile.txt}. The file will be overwritten without warning. +When the original file is @file{myfile.txt}, the resulting file becomes +@file{myfile.txt.txt} in order to prevent data loss. +@orgcmd{C-c C-e t A/L/U,org-ascii-export-as-ascii} Export to a temporary buffer. Do not create a file. -@orgcmd{C-c C-e n,org-export-as-latin1} -@xorgcmd{C-c C-e N,org-export-as-latin1-to-buffer} -Like the above commands, but use Latin-1 encoding. -@orgcmd{C-c C-e u,org-export-as-utf8} -@xorgcmd{C-c C-e U,org-export-as-utf8-to-buffer} -Like the above commands, but use UTF-8 encoding. -@item C-c C-e v a/n/u -Export only the visible part of the document. @end table -@cindex headline levels, for exporting -In the exported version, the first 3 outline levels will become -headlines, defining a general document structure. Additional levels -will be exported as itemized lists. If you want that transition to occur -at a different level, specify it with a prefix argument. For example, +@subheading Header and sectioning structure +In the exported version, the first three outline levels become headlines, +defining a general document structure. Additional levels are exported as +lists. The transition can also occur at a different level (@pxref{Export +settings}). + +@subheading Quoting ASCII text + +You can insert text that will only appear when using @code{ASCII} back-end +with the following constructs: + +@cindex #+ASCII +@cindex #+BEGIN_ASCII @example -@kbd{C-1 C-c C-e a} +Text @@@@ascii:and additional text@@@@ within a paragraph. + +#+ASCII: Some text + +#+BEGIN_ASCII +All lines in this block will appear only when using this back-end. +#+END_ASCII @end example -@noindent -creates only top level headlines and exports the rest as items. When -headlines are converted to items, the indentation of the text following -the headline is changed to fit nicely under the item. This is done with -the assumption that the first body line indicates the base indentation of -the body text. Any indentation larger than this is adjusted to preserve -the layout relative to the first line. Should there be lines with less -indentation than the first one, these are left alone. +@subheading ASCII specific attributes +@cindex #+ATTR_ASCII +@cindex horizontal rules, in ASCII export -@vindex org-export-ascii-links-to-notes -Links will be exported in a footnote-like style, with the descriptive part in -the text and the link in a note before the next heading. See the variable -@code{org-export-ascii-links-to-notes} for details and other options. +@code{ASCII} back-end only understands one attribute, @code{:width}, which +specifies the length, in characters, of a given horizontal rule. It must be +specified using an @code{ATTR_ASCII} line, directly preceding the rule. -@node HTML export, @LaTeX{} and PDF export, ASCII/Latin-1/UTF-8 export, Exporting +@example +#+ATTR_ASCII: :width 10 +----- +@end example + +@node Beamer export, HTML export, ASCII/Latin-1/UTF-8 export, Exporting +@section Beamer export +@cindex Beamer export + +The @LaTeX{} class @emph{Beamer} allows production of high quality +presentations using @LaTeX{} and pdf processing. Org mode has special +support for turning an Org mode file or tree into a Beamer presentation. + +@subheading Beamer export commands + +@table @kbd +@orgcmd{C-c C-e l b,org-beamer-export-to-latex} +Export as a @LaTeX{} file. For an Org file @file{myfile.org}, the @LaTeX{} +file will be @file{myfile.tex}. The file will be overwritten without +warning. +@orgcmd{C-c C-e l B,org-beamer-export-as-latex} +Export to a temporary buffer. Do not create a file. +@orgcmd{C-c C-e l P,org-beamer-export-to-pdf} +Export as @LaTeX{} and then process to PDF. +@item C-c C-e l O +Export as @LaTeX{} and then process to PDF, then open the resulting PDF file. +@end table + +@subheading Sectioning, Frames and Blocks + +Any tree with not-too-deep level nesting should in principle be exportable as +a Beamer presentation. Headlines fall into three categories: sectioning +elements, frames and blocks. + +@itemize @minus +@item +@vindex org-beamer-frame-level +Headlines become frames when their level is equal to +@var{org-beamer-frame-level} or @code{H} value in an @code{OPTIONS} line +(@pxref{Export settings}). + +@cindex property, BEAMER_ENV +Though, if a headline in the current tree has a @code{BEAMER_ENV} property +set to either to @code{frame} or @code{fullframe}, its level overrides the +variable. A @code{fullframe} is a frame with an empty (ignored) title. + +@item +@vindex org-beamer-environments-default +@vindex org-beamer-environments-extra +All frame's children become @code{block} environments. Special block types +can be enforced by setting headline's @code{BEAMER_ENV} property@footnote{If +this property is set, the entry will also get a @code{:B_environment:} tag to +make this visible. This tag has no semantic meaning, it is only a visual +aid.} to an appropriate value (see @var{org-beamer-environments-default} for +supported values and @var{org-beamer-environments-extra} for adding more). + +@item +@cindex property, BEAMER_REF +As a special case, if the @code{BEAMER_ENV} property is set to either +@code{appendix}, @code{note}, @code{noteNH} or @code{againframe}, the +headline will become, respectively, an appendix, a note (within frame or +between frame, depending on its level), a note with its title ignored or an +@code{\againframe} command. In the latter case, a @code{BEAMER_REF} property +is mandatory in order to refer to the frame being resumed, and contents are +ignored. + +Also, a headline with an @code{ignoreheading} environment will have its +contents only inserted in the output. This special value is useful to have +data between frames, or to properly close a @code{column} environment. +@end itemize + +@cindex property, BEAMER_ACT +@cindex property, BEAMER_OPT +Headlines also support @code{BEAMER_ACT} and @code{BEAMER_OPT} properties. +The former is translated as an overlay/action specification, or a default +overlay specification when enclosed within square brackets. The latter +specifies options for the current frame. Though, @code{fragile} option is +added automatically if it contains source code that uses any verbatim +environment. + +@cindex property, BEAMER_COL +Moreover, headlines handle the @code{BEAMER_COL} property. Its value should +be a decimal number representing the width of the column as a fraction of the +total text width. If the headline has no specific environment, its title +will be ignored and its contents will fill the column created. Otherwise, +the block will fill the whole column and the title will be preserved. Two +contiguous headlines with a non-@code{nil} @code{BEAMER_COL} value share the same +@code{columns} @LaTeX{} environment. It will end before the next headline +without such a property. This environment is generated automatically. +Although, it can also be explicitly created, with a special @code{columns} +value for @code{BEAMER_ENV} property (if it needs to be set up with some +specific options, for example). + +@subheading Beamer specific syntax + +Beamer back-end is an extension of @LaTeX{} back-end. As such, all @LaTeX{} +specific syntax (e.g., @samp{#+LATEX:} or @samp{#+ATTR_LATEX:}) is +recognized. See @ref{@LaTeX{} and PDF export} for more information. + +@cindex #+BEAMER_THEME +@cindex #+BEAMER_COLOR_THEME +@cindex #+BEAMER_FONT_THEME +@cindex #+BEAMER_INNER_THEME +@cindex #+BEAMER_OUTER_THEME +Beamer export introduces a number of keywords to insert code in the +document's header. Four control appearance of the presentantion: +@code{#+BEAMER_THEME}, @code{#+BEAMER_COLOR_THEME}, +@code{#+BEAMER_FONT_THEME}, @code{#+BEAMER_INNER_THEME} and +@code{#+BEAMER_OUTER_THEME}. All of them accept optional arguments +within square brackets. The last one, @code{#+BEAMER_HEADER}, is more +generic and allows you to append any line of code in the header. + +@example +#+BEAMER_THEME: Rochester [height=20pt] +#+BEAMER_COLOR_THEME: spruce +@end example + +Table of contents generated from @code{toc:t} @code{OPTION} keyword are +wrapped within a @code{frame} environment. Those generated from a @code{TOC} +keyword (@pxref{Table of contents}) are not. In that case, it is also +possible to specify options, enclosed within square brackets. + +@example +#+TOC: headlines [currentsection] +@end example + +Beamer specific code can be inserted with the following constructs: + +@cindex #+BEAMER +@cindex #+BEGIN_BEAMER +@example +#+BEAMER: \pause + +#+BEGIN_BEAMER +All lines in this block will appear only when using this back-end. +#+END_BEAMER + +Text @@@@beamer:some code@@@@ within a paragraph. +@end example + +In particular, this last example can be used to add overlay specifications to +objects whose type is among @code{bold}, @code{item}, @code{link}, +@code{radio-target} and @code{target}, when the value is enclosed within +angular brackets and put at the beginning the object. + +@example +A *@@@@beamer:<2->@@@@useful* feature +@end example + +@cindex #+ATTR_BEAMER +Eventually, every plain list has support for @code{:environment}, +@code{:overlay} and @code{:options} attributes through +@code{ATTR_BEAMER} affiliated keyword. The first one allows the use +of a different environment, the second sets overlay specifications and +the last one inserts optional arguments in current list environment. + +@example +#+ATTR_BEAMER: :overlay +- +- item 1 +- item 2 +@end example + +@subheading Editing support + +You can turn on a special minor mode @code{org-beamer-mode} for faster +editing with: + +@example +#+STARTUP: beamer +@end example + +@table @kbd +@orgcmd{C-c C-b,org-beamer-select-environment} +In @code{org-beamer-mode}, this key offers fast selection of a Beamer +environment or the @code{BEAMER_COL} property. +@end table + +Also, a template for useful in-buffer settings or properties can be inserted +into the buffer with @kbd{M-x org-beamer-insert-options-template}. Among +other things, this will install a column view format which is very handy for +editing special properties used by Beamer. + +@subheading An example + +Here is a simple example Org document that is intended for Beamer export. + +@smallexample +#+TITLE: Example Presentation +#+AUTHOR: Carsten Dominik +#+OPTIONS: H:2 +#+LATEX_CLASS: beamer +#+LATEX_CLASS_OPTIONS: [presentation] +#+BEAMER_THEME: Madrid +#+COLUMNS: %45ITEM %10BEAMER_ENV(Env) %10BEAMER_ACT(Act) %4BEAMER_COL(Col) %8BEAMER_OPT(Opt) + +* This is the first structural section + +** Frame 1 +*** Thanks to Eric Fraga :B_block:BMCOL: + :PROPERTIES: + :BEAMER_COL: 0.48 + :BEAMER_ENV: block + :END: + for the first viable Beamer setup in Org +*** Thanks to everyone else :B_block:BMCOL: + :PROPERTIES: + :BEAMER_COL: 0.48 + :BEAMER_ACT: <2-> + :BEAMER_ENV: block + :END: + for contributing to the discussion +**** This will be formatted as a beamer note :B_note: + :PROPERTIES: + :BEAMER_env: note + :END: +** Frame 2 (where we will not use columns) +*** Request + Please test this stuff! +@end smallexample + +@node HTML export, @LaTeX{} and PDF export, Beamer export, Exporting @section HTML export @cindex HTML export @@ -10057,87 +10973,58 @@ language, but with additional support for tables. @node HTML Export commands, HTML preamble and postamble, HTML export, HTML export @subsection HTML export commands -@cindex region, active -@cindex active region -@cindex transient-mark-mode @table @kbd -@orgcmd{C-c C-e h,org-export-as-html} -@cindex property, EXPORT_FILE_NAME +@orgcmd{C-c C-e h h,org-html-export-to-html} Export as a HTML file. For an Org file @file{myfile.org}, the HTML file will be @file{myfile.html}. The file will be overwritten -without warning. If there is an active region@footnote{This requires -@code{transient-mark-mode} be turned on.}, only the region will be -exported. If the selected region is a single tree@footnote{To select the -current subtree, use @kbd{C-c @@}.}, the tree head will become the document -title. If the tree head entry has, or inherits, an @code{EXPORT_FILE_NAME} -property, that name will be used for the export. -@orgcmd{C-c C-e b,org-export-as-html-and-open} +without warning. +@kbd{C-c C-e h o} Export as a HTML file and immediately open it with a browser. -@orgcmd{C-c C-e H,org-export-as-html-to-buffer} +@orgcmd{C-c C-e h H,org-html-export-as-html} Export to a temporary buffer. Do not create a file. -@orgcmd{C-c C-e R,org-export-region-as-html} -Export the active region to a temporary buffer. With a prefix argument, do -not produce the file header and footer, but just the plain HTML section for -the region. This is good for cut-and-paste operations. -@item C-c C-e v h/b/H/R -Export only the visible part of the document. -@item M-x org-export-region-as-html -Convert the region to HTML under the assumption that it was in Org mode -syntax before. This is a global command that can be invoked in any -buffer. -@item M-x org-replace-region-by-HTML -Replace the active region (assumed to be in Org mode syntax) by HTML -code. @end table -@cindex headline levels, for exporting -In the exported version, the first 3 outline levels will become headlines, -defining a general document structure. Additional levels will be exported as -itemized lists. If you want that transition to occur at a different level, -specify it with a numeric prefix argument. For example, +@c FIXME Exporting sublevels +@c @cindex headline levels, for exporting +@c In the exported version, the first 3 outline levels will become headlines, +@c defining a general document structure. Additional levels will be exported as +@c itemized lists. If you want that transition to occur at a different level, +@c specify it with a numeric prefix argument. For example, -@example -@kbd{C-2 C-c C-e b} -@end example - -@noindent -creates two levels of headings and does the rest as items. +@c @example +@c @kbd{C-2 C-c C-e b} +@c @end example +@c @noindent +@c creates two levels of headings and does the rest as items. @node HTML preamble and postamble, Quoting HTML tags, HTML Export commands, HTML export @subsection HTML preamble and postamble -@vindex org-export-html-preamble -@vindex org-export-html-postamble -@vindex org-export-html-preamble-format -@vindex org-export-html-postamble-format -@vindex org-export-html-validation-link -@vindex org-export-author-info -@vindex org-export-email-info -@vindex org-export-creator-info +@vindex org-html-preamble +@vindex org-html-postamble +@vindex org-html-preamble-format +@vindex org-html-postamble-format +@vindex org-html-validation-link +@vindex org-export-creator-string @vindex org-export-time-stamp-file The HTML exporter lets you define a preamble and a postamble. -The default value for @code{org-export-html-preamble} is @code{t}, which -means that the preamble is inserted depending on the relevant format string -in @code{org-export-html-preamble-format}. +The default value for @var{org-html-preamble} is @code{t}, which means +that the preamble is inserted depending on the relevant format string in +@var{org-html-preamble-format}. -Setting @code{org-export-html-preamble} to a string will override the default -format string. Setting it to a function, will insert the output of the -function, which must be a string; such a function takes no argument but you -can check against the value of @code{opt-plist}, which contains the list of -publishing properties for the current file. Setting to @code{nil} will not -insert any preamble. +Setting @var{org-html-preamble} to a string will override the default format +string. If you set it to a function, it will insert the output of the +function, which must be a string. Setting to @code{nil} will not insert any +preamble. -The default value for @code{org-export-html-postamble} is @code{'auto}, which -means that the HTML exporter will look for the value of -@code{org-export-author-info}, @code{org-export-email-info}, -@code{org-export-creator-info} and @code{org-export-time-stamp-file}, -@code{org-export-html-validation-link} and build the postamble from these -values. Setting @code{org-export-html-postamble} to @code{t} will insert the -postamble from the relevant format string found in -@code{org-export-html-postamble-format}. Setting it to @code{nil} will not -insert any postamble. +The default value for @var{org-html-postamble} is @code{'auto}, which means +that the HTML exporter will look for information about the author, the email, +the creator and the date, and build the postamble from these values. Setting +@var{org-html-postamble} to @code{t} will insert the postamble from the +relevant format string found in @var{org-html-postamble-format}. Setting it +to @code{nil} will not insert any postamble. @node Quoting HTML tags, Links in HTML export, HTML preamble and postamble, HTML export @subsection Quoting HTML tags @@ -10188,37 +11075,42 @@ and @code{style} attributes for a link: @cindex #+ATTR_HTML @example -#+ATTR_HTML: title="The Org mode homepage" style="color:red;" +#+ATTR_HTML: :title The Org mode homepage :style color:red; [[http://orgmode.org]] @end example @node Tables in HTML export, Images in HTML export, Links in HTML export, HTML export @subsection Tables @cindex tables, in HTML -@vindex org-export-html-table-tag +@vindex org-html-table-default-attributes -Org mode tables are exported to HTML using the table tag defined in -@code{org-export-html-table-tag}. The default setting makes tables without -cell borders and frame. If you would like to change this for individual -tables, place something like the following before the table: +Org mode tables are exported to HTML using the table attributes defined in +@var{org-html-table-default-attributes}. The default setting makes tables +without cell borders and frame. If you would like to change this for +individual tables, place something like the following before the table: @cindex #+CAPTION @cindex #+ATTR_HTML @example #+CAPTION: This is a table with lines around and between cells -#+ATTR_HTML: border="2" rules="all" frame="border" +#+ATTR_HTML: :border 2 :rules all :frame border @end example +@vindex org-html-table-row-tags +You can also modify the default tags used for each row by setting +@var{org-html-table-row-tags}. See the docstring for an example on +how to use this option. + @node Images in HTML export, Math formatting in HTML export, Tables in HTML export, HTML export @subsection Images in HTML export @cindex images, inline in HTML @cindex inlining images in HTML -@vindex org-export-html-inline-images +@vindex org-html-inline-images HTML export can inline images given as links in the Org file, and it can make an image the clickable part of a link. By default@footnote{But see the variable -@code{org-export-html-inline-images}.}, images are inlined if a link does +@var{org-html-inline-images}.}, images are inlined if a link does not have a description. So @samp{[[file:myimg.jpg]]} will be inlined, while @samp{[[file:myimg.jpg][the image]]} will just produce a link @samp{the image} that points to the image. If the description part @@ -10239,7 +11131,7 @@ support text viewers and accessibility, and align it to the right. @cindex #+ATTR_HTML @example #+CAPTION: A black cat stalking a spider -#+ATTR_HTML: alt="cat/spider image" title="Action!" align="right" +#+ATTR_HTML: :alt cat/spider image :title Action! :align right [[./img/a.jpg]] @end example @@ -10254,22 +11146,22 @@ You could use @code{http} addresses just as well. @LaTeX{} math snippets (@pxref{@LaTeX{} fragments}) can be displayed in two different ways on HTML pages. The default is to use the @uref{http://www.mathjax.org, MathJax system} which should work out of the -box with Org mode installation because @code{http://orgmode.org} serves +box with Org mode installation because @uref{http://orgmode.org} serves @file{MathJax} for Org mode users for small applications and for testing purposes. @b{If you plan to use this regularly or on pages with significant page views, you should install@footnote{Installation instructions can be found on the MathJax website, see @uref{http://www.mathjax.org/resources/docs/?installation.html}.} MathJax on your own server in order to limit the load of our server.} To configure -@file{MathJax}, use the variable @code{org-export-html-mathjax-options} or +@file{MathJax}, use the variable @var{org-html-mathjax-options} or insert something like the following into the buffer: @example -#+MATHJAX: align:"left" mathml:t path:"/MathJax/MathJax.js" +#+HTML_MATHJAX: align:"left" mathml:t path:"/MathJax/MathJax.js" @end example @noindent See the docstring of the variable -@code{org-export-html-mathjax-options} for the meaning of the parameters in +@var{org-html-mathjax-options} for the meaning of the parameters in this line. If you prefer, you can also request that @LaTeX{} fragments are processed @@ -10279,7 +11171,7 @@ method requires that the @file{dvipng} program is available on your system. You can still get this processing with @example -#+OPTIONS: LaTeX:dvipng +#+OPTIONS: tex:dvipng @end example @node Text areas in HTML export, CSS support, Math formatting in HTML export, HTML export @@ -10288,15 +11180,16 @@ You can still get this processing with @cindex text areas, in HTML An alternative way to publish literal code examples in HTML is to use text areas, where the example can even be edited before pasting it into an -application. It is triggered by a @code{-t} switch at an @code{example} or -@code{src} block. Using this switch disables any options for syntax and -label highlighting, and line numbering, which may be present. You may also -use @code{-h} and @code{-w} switches to specify the height and width of the -text area, which default to the number of lines in the example, and 80, -respectively. For example +application. It is triggered by @code{:textarea} attribute at an +@code{example} or @code{src} block. + +You may also use @code{:height} and @code{:width} attributes to specify the +height and width of the text area, which default to the number of lines in +the example, and 80, respectively. For example @example -#+BEGIN_EXAMPLE -t -w 40 +#+ATTR_HTML: :textarea t :width 40 +#+BEGIN_EXAMPLE (defun org-xor (a b) "Exclusive or." (if a (not b) b)) @@ -10309,13 +11202,13 @@ respectively. For example @cindex CSS, for HTML export @cindex HTML export, CSS -@vindex org-export-html-todo-kwd-class-prefix -@vindex org-export-html-tag-class-prefix +@vindex org-html-todo-kwd-class-prefix +@vindex org-html-tag-class-prefix You can also give style information for the exported file. The HTML exporter assigns the following special CSS classes@footnote{If the classes on TODO keywords and tags lead to conflicts, use the variables -@code{org-export-html-todo-kwd-class-prefix} and -@code{org-export-html-tag-class-prefix} to make them unique.} to appropriate +@var{org-html-todo-kwd-class-prefix} and +@var{org-html-tag-class-prefix} to make them unique.} to appropriate parts of the document---your style specifications may change these, in addition to any of the standard classes like for headlines, tables, etc. @example @@ -10347,24 +11240,26 @@ p.footnote @r{footnote definition paragraph, containing a footnote} .footnum @r{footnote number in footnote definition (always )} @end example -@vindex org-export-html-style-default -@vindex org-export-html-style-include-default -@vindex org-export-html-style -@vindex org-export-html-extra -@vindex org-export-html-style-default +@vindex org-html-style-default +@vindex org-html-head-include-default-style +@vindex org-html-head +@vindex org-html-head-extra +@cindex #+HTML_INCLUDE_STYLE Each exported file contains a compact default style that defines these classes in a basic way@footnote{This style is defined in the constant -@code{org-export-html-style-default}, which you should not modify. To turn +@var{org-html-style-default}, which you should not modify. To turn inclusion of these defaults off, customize -@code{org-export-html-style-include-default}}. You may overwrite these -settings, or add to them by using the variables @code{org-export-html-style} -(for Org-wide settings) and @code{org-export-html-style-extra} (for more -fine-grained settings, like file-local settings). To set the latter variable -individually for each file, you can use +@var{org-html-head-include-default-style} or set @code{#+HTML_INCLUDE_STYLE} +to @code{nil} on a per-file basis.}. You may overwrite these settings, or add to +them by using the variables @var{org-html-head} and +@var{org-html-head-extra}. You can override the global values of these +variables for each file by using these keywords: -@cindex #+STYLE +@cindex #+HTML_HEAD +@cindex #+HTML_HEAD_EXTRA @example -#+STYLE: +#+HTML_HEAD: +#+HTML_HEAD_EXTRA: @end example @noindent @@ -10393,15 +11288,12 @@ as well, press @kbd{?} for an overview of the available keys). The second view type is a @emph{folding} view much like Org provides inside Emacs. The script is available at @url{http://orgmode.org/org-info.js} and you can find the documentation for it at @url{http://orgmode.org/worg/code/org-info-js/}. -We host the script at our site, but if you use it a lot, you might -not want to be dependent on @url{orgmode.org} and prefer to install a local +We host the script at our site, but if you use it a lot, you might not want +to be dependent on @url{http://orgmode.org} and prefer to install a local copy on your own web server. -To use the script, you need to make sure that the @file{org-jsinfo.el} module -gets loaded. It should be loaded by default, but you can try @kbd{M-x -customize-variable @key{RET} org-modules @key{RET}} to convince yourself that -this is indeed the case. All it then takes to make use of the program is -adding a single line to the Org file: +All it then takes to use this program is adding a single line to the Org +file: @cindex #+INFOJS_OPT @example @@ -10424,13 +11316,13 @@ view: @r{Initial view when the website is first shown. Possible values are:} showall @r{Folding interface, all headlines and text visible.} sdepth: @r{Maximum headline level that will still become an independent} @r{section for info and folding modes. The default is taken from} - @r{@code{org-export-headline-levels} (= the @code{H} switch in @code{#+OPTIONS}).} - @r{If this is smaller than in @code{org-export-headline-levels}, each} + @r{@var{org-export-headline-levels} (= the @code{H} switch in @code{#+OPTIONS}).} + @r{If this is smaller than in @var{org-export-headline-levels}, each} @r{info/folding section can still contain child headlines.} toc: @r{Should the table of contents @emph{initially} be visible?} @r{Even when @code{nil}, you can always get to the "toc" with @kbd{i}.} tdepth: @r{The depth of the table of contents. The defaults are taken from} - @r{the variables @code{org-export-headline-levels} and @code{org-export-with-toc}.} + @r{the variables @var{org-export-headline-levels} and @var{org-export-with-toc}.} ftoc: @r{Does the CSS of the page specify a fixed position for the "toc"?} @r{If yes, the toc will never be displayed as a section.} ltoc: @r{Should there be short contents (children) in each section?} @@ -10441,92 +11333,61 @@ buttons: @r{Should view-toggle buttons be everywhere? When @code{nil} (the} @r{default), only one such button will be present.} @end example @noindent -@vindex org-infojs-options -@vindex org-export-html-use-infojs +@vindex org-html-infojs-options +@vindex org-html-use-infojs You can choose default values for these options by customizing the variable -@code{org-infojs-options}. If you always want to apply the script to your -pages, configure the variable @code{org-export-html-use-infojs}. +@var{org-html-infojs-options}. If you always want to apply the script to your +pages, configure the variable @var{org-html-use-infojs}. -@node @LaTeX{} and PDF export, DocBook export, HTML export, Exporting +@node @LaTeX{} and PDF export, Markdown export, HTML export, Exporting @section @LaTeX{} and PDF export @cindex @LaTeX{} export @cindex PDF export -@cindex Guerry, Bastien -Org mode contains a @LaTeX{} exporter written by Bastien Guerry. With -further processing@footnote{The default @LaTeX{} output is designed for -processing with @code{pdftex} or @LaTeX{}. It includes packages that are not -compatible with @code{xetex} and possibly @code{luatex}. See the variables -@code{org-export-latex-default-packages-alist} and -@code{org-export-latex-packages-alist}.}, this backend is also used to -produce PDF output. Since the @LaTeX{} output uses @file{hyperref} to -implement links and cross references, the PDF output file will be fully -linked. Beware of the fact that your @code{org} file has to be properly -structured in order to be correctly exported: respect the hierarchy of -sections. +@LaTeX{} export can produce an arbitrarily complex LaTeX document of any +standard or custom document class. With further processing@footnote{The +default @LaTeX{} output is designed for processing with @code{pdftex} or +@LaTeX{}. It includes packages that are not compatible with @code{xetex} and +possibly @code{luatex}. The @LaTeX{} exporter can be configured to support +alternative TeX engines, see the options +@var{org-latex-default-packages-alist} and @var{org-latex-packages-alist}.}, +which the @LaTeX{} exporter is able to control, this back-end is able to +produce PDF output. Because the @LaTeX{} exporter can be configured to use +the @code{hyperref} package, the default setup produces fully-linked PDF +output. + +As in @LaTeX{}, blank lines are meaningful for this back-end: a paragraph +will not be started if two contiguous syntactical elements are not separated +by an empty line. + +This back-end also offers enhanced support for footnotes. Thus, it handles +nested footnotes, footnotes in tables and footnotes in a list item's +description. @menu -* @LaTeX{}/PDF export commands:: +* @LaTeX{} export commands:: How to export to LaTeX and PDF * Header and sectioning:: Setting up the export file structure * Quoting @LaTeX{} code:: Incorporating literal @LaTeX{} code -* Tables in @LaTeX{} export:: Options for exporting tables to @LaTeX{} -* Images in @LaTeX{} export:: How to insert figures into @LaTeX{} output -* Beamer class export:: Turning the file into a presentation +* @LaTeX{} specific attributes:: Controlling @LaTeX{} output @end menu -@node @LaTeX{}/PDF export commands, Header and sectioning, @LaTeX{} and PDF export, @LaTeX{} and PDF export +@node @LaTeX{} export commands, Header and sectioning, @LaTeX{} and PDF export, @LaTeX{} and PDF export @subsection @LaTeX{} export commands -@cindex region, active -@cindex active region -@cindex transient-mark-mode @table @kbd -@orgcmd{C-c C-e l,org-export-as-latex} -@cindex property EXPORT_FILE_NAME -Export as a @LaTeX{} file. For an Org file -@file{myfile.org}, the @LaTeX{} file will be @file{myfile.tex}. The file will -be overwritten without warning. If there is an active region@footnote{This -requires @code{transient-mark-mode} be turned on.}, only the region will be -exported. If the selected region is a single tree@footnote{To select the -current subtree, use @kbd{C-c @@}.}, the tree head will become the document -title. If the tree head entry has or inherits an @code{EXPORT_FILE_NAME} -property, that name will be used for the export. -@orgcmd{C-c C-e L,org-export-as-latex-to-buffer} +@orgcmd{C-c C-e l l,org-latex-export-to-latex} +Export as a @LaTeX{} file. For an Org file @file{myfile.org}, the @LaTeX{} +file will be @file{myfile.tex}. The file will be overwritten without +warning. +@orgcmd{C-c C-e l L,org-latex-export-as-latex} Export to a temporary buffer. Do not create a file. -@item C-c C-e v l/L -Export only the visible part of the document. -@item M-x org-export-region-as-latex -Convert the region to @LaTeX{} under the assumption that it was in Org mode -syntax before. This is a global command that can be invoked in any -buffer. -@item M-x org-replace-region-by-latex -Replace the active region (assumed to be in Org mode syntax) by @LaTeX{} -code. -@orgcmd{C-c C-e p,org-export-as-pdf} +@orgcmd{C-c C-e l p,org-latex-export-to-pdf} Export as @LaTeX{} and then process to PDF. -@orgcmd{C-c C-e d,org-export-as-pdf-and-open} +@item C-c C-e l o Export as @LaTeX{} and then process to PDF, then open the resulting PDF file. @end table -@cindex headline levels, for exporting -@vindex org-latex-low-levels -In the exported version, the first 3 outline levels will become -headlines, defining a general document structure. Additional levels -will be exported as description lists. The exporter can ignore them or -convert them to a custom string depending on -@code{org-latex-low-levels}. - -If you want that transition to occur at a different level, specify it -with a numeric prefix argument. For example, - -@example -@kbd{C-2 C-c C-e l} -@end example - -@noindent -creates two levels of headings and does the rest as items. - -@node Header and sectioning, Quoting @LaTeX{} code, @LaTeX{}/PDF export commands, @LaTeX{} and PDF export +@node Header and sectioning, Quoting @LaTeX{} code, @LaTeX{} export commands, @LaTeX{} and PDF export @subsection Header and sectioning structure @cindex @LaTeX{} class @cindex @LaTeX{} sectioning structure @@ -10534,493 +11395,314 @@ creates two levels of headings and does the rest as items. @cindex header, for @LaTeX{} files @cindex sectioning structure, for @LaTeX{} export +By default, the first three outline levels become headlines, defining a +general document structure. Additional levels are exported as @code{itemize} +or @code{enumerate} lists. The transition can also occur at a different +level (@pxref{Export settings}). + By default, the @LaTeX{} output uses the class @code{article}. -@vindex org-export-latex-default-class -@vindex org-export-latex-classes -@vindex org-export-latex-default-packages-alist -@vindex org-export-latex-packages-alist -@cindex #+LaTeX_HEADER -@cindex #+LaTeX_CLASS -@cindex #+LaTeX_CLASS_OPTIONS -@cindex property, LaTeX_CLASS -@cindex property, LaTeX_CLASS_OPTIONS +@vindex org-latex-default-class +@vindex org-latex-classes +@vindex org-latex-default-packages-alist +@vindex org-latex-packages-alist You can change this globally by setting a different value for -@code{org-export-latex-default-class} or locally by adding an option like -@code{#+LaTeX_CLASS: myclass} in your file, or with a @code{:LaTeX_CLASS:} -property that applies when exporting a region containing only this (sub)tree. -The class must be listed in @code{org-export-latex-classes}. This variable -defines a header template for each class@footnote{Into which the values of -@code{org-export-latex-default-packages-alist} and -@code{org-export-latex-packages-alist} are spliced.}, and allows you to -define the sectioning structure for each class. You can also define your own -classes there. @code{#+LaTeX_CLASS_OPTIONS} or a @code{:LaTeX_CLASS_OPTIONS:} -property can specify the options for the @code{\documentclass} macro. The -options to documentclass have to be provided, as expected by @LaTeX{}, within -square brackets. You can also use @code{#+LaTeX_HEADER: \usepackage@{xyz@}} -to add lines to the header. See the docstring of -@code{org-export-latex-classes} for more information. An example is shown -below. +@var{org-latex-default-class} or locally by adding an option like +@code{#+LATEX_CLASS: myclass} in your file, or with +a @code{EXPORT_LATEX_CLASS} property that applies when exporting a region +containing only this (sub)tree. The class must be listed in +@var{org-latex-classes}. This variable defines a header template for each +class@footnote{Into which the values of +@var{org-latex-default-packages-alist} and @var{org-latex-packages-alist} +are spliced.}, and allows you to define the sectioning structure for each +class. You can also define your own classes there. + +@cindex #+LATEX_CLASS +@cindex #+LATEX_CLASS_OPTIONS +@cindex property, EXPORT_LATEX_CLASS +@cindex property, EXPORT_LATEX_CLASS_OPTIONS +The @code{LATEX_CLASS_OPTIONS} keyword or @code{EXPORT_LATEX_CLASS_OPTIONS} +property can specify the options for the @code{\documentclass} macro. These +options have to be provided, as expected by @LaTeX{}, within square brackets. + +@cindex #+LATEX_HEADER +@cindex #+LATEX_HEADER_EXTRA +You can also use the @code{LATEX_HEADER} and +@code{LATEX_HEADER_EXTRA}@footnote{Unlike @code{LATEX_HEADER}, contents +from @code{LATEX_HEADER_EXTRA} keywords will not be loaded when previewing +@LaTeX{} snippets (@pxref{Previewing @LaTeX{} fragments}).} keywords in order +to add lines to the header. See the docstring of @var{org-latex-classes} for +more information. + +An example is shown below. @example -#+LaTeX_CLASS: article -#+LaTeX_CLASS_OPTIONS: [a4paper] -#+LaTeX_HEADER: \usepackage@{xyz@} +#+LATEX_CLASS: article +#+LATEX_CLASS_OPTIONS: [a4paper] +#+LATEX_HEADER: \usepackage@{xyz@} * Headline 1 some text @end example -@node Quoting @LaTeX{} code, Tables in @LaTeX{} export, Header and sectioning, @LaTeX{} and PDF export +@node Quoting @LaTeX{} code, @LaTeX{} specific attributes, Header and sectioning, @LaTeX{} and PDF export @subsection Quoting @LaTeX{} code Embedded @LaTeX{} as described in @ref{Embedded @LaTeX{}}, will be correctly -inserted into the @LaTeX{} file. This includes simple macros like -@samp{\ref@{LABEL@}} to create a cross reference to a figure. Furthermore, -you can add special code that should only be present in @LaTeX{} export with -the following constructs: +inserted into the @LaTeX{} file. Furthermore, you can add special code that +should only be present in @LaTeX{} export with the following constructs: -@cindex #+LaTeX -@cindex #+BEGIN_LaTeX +@cindex #+LATEX +@cindex #+BEGIN_LATEX @example -#+LaTeX: Literal @LaTeX{} code for export -@end example +Code within @@@@latex:some code@@@@ a paragraph. -@noindent or -@cindex #+BEGIN_LaTeX +#+LATEX: Literal @LaTeX{} code for export -@example -#+BEGIN_LaTeX +#+BEGIN_LATEX All lines between these markers are exported literally -#+END_LaTeX +#+END_LATEX @end example +@node @LaTeX{} specific attributes, , Quoting @LaTeX{} code, @LaTeX{} and PDF export +@subsection @LaTeX{} specific attributes +@cindex #+ATTR_LATEX -@node Tables in @LaTeX{} export, Images in @LaTeX{} export, Quoting @LaTeX{} code, @LaTeX{} and PDF export -@subsection Tables in @LaTeX{} export +@LaTeX{} understands attributes specified in an @code{ATTR_LATEX} line. They +affect tables, images, plain lists, special blocks and source blocks. + +@subsubheading Tables in @LaTeX{} export @cindex tables, in @LaTeX{} export -For @LaTeX{} export of a table, you can specify a label, a caption and -placement options (@pxref{Images and tables}). You can also use the -@code{ATTR_LaTeX} line to request a @code{longtable} environment for the -table, so that it may span several pages, or to change the default table -environment from @code{table} to @code{table*} or to change the default inner -tabular environment to @code{tabularx} or @code{tabulary}. Finally, you can -set the alignment string, and (with @code{tabularx} or @code{tabulary}) the -width: +For @LaTeX{} export of a table, you can specify a label and a caption +(@pxref{Images and tables}). You can also use attributes to control table +layout and contents. Valid @LaTeX{} attributes include: + +@table @code +@item :mode +@vindex org-latex-default-table-mode +Nature of table's contents. It can be set to @code{table}, @code{math}, +@code{inline-math} or @code{verbatim}. In particular, when in @code{math} or +@code{inline-math} mode, every cell is exported as-is, horizontal rules are +ignored and the table will be wrapped in a math environment. Also, +contiguous tables sharing the same math mode will be wrapped within the same +environment. Default mode is determined in +@var{org-latex-default-table-mode}. +@item :environment +@vindex org-latex-default-table-environment +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 +@var{org-latex-default-table-environment} value. +@item :float +Float environment for the table. Possible values are @code{sidewaystable}, +@code{multicolumn} and @code{table}. If unspecified, a table with a caption +will have a @code{table} environment. Moreover, @code{:placement} attribute +can specify the positioning of the float. +@item :align +@itemx :font +@itemx :width +Set, respectively, the alignment string of the table, its font size and its +width. They only apply on regular tables. +@item :spread +Boolean specific to the @code{tabu} and @code{longtabu} environments, and +only takes effect when used in conjunction with the @code{:width} attribute. +When @code{:spread} is non-@code{nil}, the table will be spread or shrunk by the +value of @code{:width}. +@item :booktabs +@itemx :center +@itemx :rmlines +@vindex org-latex-tables-booktabs +@vindex org-latex-tables-centered +They toggle, respectively, @code{booktabs} usage (assuming the package is +properly loaded), table centering and removal of every horizontal rule but +the first one (in a "table.el" table only). In particular, +@var{org-latex-tables-booktabs} (respectively @var{org-latex-tables-centered}) +activates the first (respectively second) attribute globally. +@item :math-prefix +@itemx :math-suffix +@itemx :math-arguments +A string that will be inserted, respectively, before the table within the +math environment, after the table within the math environment, and between +the macro name and the contents of the table. The @code{:math-arguments} +attribute is used for matrix macros that require more than one argument +(e.g., @code{qbordermatrix}). +@end table + +Thus, attributes can be used in a wide array of situations, like writing +a table that will span over multiple pages, or a matrix product: -@cindex #+CAPTION -@cindex #+LABEL -@cindex #+ATTR_LaTeX @example -#+CAPTION: A long table -#+LABEL: tbl:long -#+ATTR_LaTeX: longtable align=l|lp@{3cm@}r|l +#+ATTR_LATEX: :environment longtable :align l|lp@{3cm@}r|l | ..... | ..... | | ..... | ..... | + +#+ATTR_LATEX: :mode math :environment bmatrix :math-suffix \times +| a | b | +| c | d | +#+ATTR_LATEX: :mode math :environment bmatrix +| 1 | 2 | +| 3 | 4 | @end example -or to specify a multicolumn table with @code{tabulary} - -@cindex #+CAPTION -@cindex #+LABEL -@cindex #+ATTR_LaTeX -@example -#+CAPTION: A wide table with tabulary -#+LABEL: tbl:wide -#+ATTR_LaTeX: table* tabulary width=\textwidth -| ..... | ..... | -| ..... | ..... | -@end example - -@node Images in @LaTeX{} export, Beamer class export, Tables in @LaTeX{} export, @LaTeX{} and PDF export -@subsection Images in @LaTeX{} export +@subsubheading Images in @LaTeX{} export @cindex images, inline in @LaTeX{} @cindex inlining images in @LaTeX{} Images that are linked to without a description part in the link, like @samp{[[file:img.jpg]]} or @samp{[[./img.jpg]]} will be inserted into the PDF output file resulting from @LaTeX{} processing. Org will use an -@code{\includegraphics} macro to insert the image. If you have specified a -caption and/or a label as described in @ref{Images and tables}, the figure -will be wrapped into a @code{figure} environment and thus become a floating -element. You can use an @code{#+ATTR_LaTeX:} line to specify various other -options. You can ask org to export an image as a float without specifying -a label or a caption by using the keyword @code{float} in this line. Various -optional arguments to the @code{\includegraphics} macro can also be specified -in this fashion. To modify the placement option of the floating environment, -add something like @samp{placement=[h!]} to the attributes. It is to be noted -this option can be used with tables as well@footnote{One can also take -advantage of this option to pass other, unrelated options into the figure or -table environment. For an example see the section ``Exporting org files'' in -@url{http://orgmode.org/worg/org-hacks.html}}. +@code{\includegraphics} macro to insert the image@footnote{In the case of +TikZ (@url{http://sourceforge.net/projects/pgf/}) images, it will become an +@code{\input} macro wrapped within a @code{tikzpicture} environment.}. -If you would like to let text flow around the image, add the word @samp{wrap} -to the @code{#+ATTR_LaTeX:} line, which will make the figure occupy the left -half of the page. To fine-tune, the @code{placement} field will be the set -of additional arguments needed by the @code{wrapfigure} environment. Note -that if you change the size of the image, you need to use compatible settings -for @code{\includegraphics} and @code{wrapfigure}. +You can specify specify image width or height with, respectively, +@code{:width} and @code{:height} attributes. It is also possible to add any +other option with the @code{:options} attribute, as shown in the following +example: -@cindex #+CAPTION -@cindex #+LABEL -@cindex #+ATTR_LaTeX @example -#+CAPTION: The black-body emission of the disk around HR 4049 -#+LABEL: fig:SED-HR4049 -#+ATTR_LaTeX: width=5cm,angle=90 +#+ATTR_LATEX: :width 5cm :options angle=90 [[./img/sed-hr4049.pdf]] +@end example -#+ATTR_LaTeX: width=0.38\textwidth wrap placement=@{r@}@{0.4\textwidth@} +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 +without specifying caption by setting the @code{:float} attribute. You may +also set it to: +@itemize @minus +@item +@code{wrap}: if you would like to let text flow around the image. It will +make the figure occupy the left half of the page. +@item +@code{multicolumn}: if you wish to include an image which spans multiple +columns in a page. This will export the image wrapped in a @code{figure*} +environment. +@end itemize +@noindent +To modify the placement option of any floating environment, set the +@code{placement} attribute. + +@example +#+ATTR_LATEX: :float wrap :width 0.38\textwidth :placement @{r@}@{0.4\textwidth@} [[./img/hst.png]] @end example -If you wish to include an image which spans multiple columns in a page, you -can use the keyword @code{multicolumn} in the @code{#+ATTR_LaTeX} line. This -will export the image wrapped in a @code{figure*} environment. +If the @code{:comment-include} attribute is set to a non-@code{nil} value, +the @LaTeX{} @code{\includegraphics} macro will be commented out. -If you need references to a label created in this way, write -@samp{\ref@{fig:SED-HR4049@}} just like in @LaTeX{}. +@subsubheading Plain lists in @LaTeX{} export +@cindex plain lists, in @LaTeX{} export -@node Beamer class export, , Images in @LaTeX{} export, @LaTeX{} and PDF export -@subsection Beamer class export - -The @LaTeX{} class @file{beamer} allows production of high quality presentations -using @LaTeX{} and pdf processing. Org mode has special support for turning an -Org mode file or tree into a @file{beamer} presentation. - -When the @LaTeX{} class for the current buffer (as set with @code{#+LaTeX_CLASS: -beamer}) or subtree (set with a @code{LaTeX_CLASS} property) is -@code{beamer}, a special export mode will turn the file or tree into a beamer -presentation. Any tree with not-too-deep level nesting should in principle be -exportable as a beamer presentation. By default, the top-level entries (or -the first level below the selected subtree heading) will be turned into -frames, and the outline structure below this level will become itemize lists. -You can also configure the variable @code{org-beamer-frame-level} to a -different level---then the hierarchy above frames will produce the sectioning -structure of the presentation. - -A template for useful in-buffer settings or properties can be inserted into -the buffer with @kbd{M-x org-insert-beamer-options-template}. Among other -things, this will install a column view format which is very handy for -editing special properties used by beamer. - -You can influence the structure of the presentation using the following -properties: - -@table @code -@item BEAMER_env -The environment that should be used to format this entry. Valid environments -are defined in the constant @code{org-beamer-environments-default}, and you -can define more in @code{org-beamer-environments-extra}. If this property is -set, the entry will also get a @code{:B_environment:} tag to make this -visible. This tag has no semantic meaning, it is only a visual aid. -@item BEAMER_envargs -The beamer-special arguments that should be used for the environment, like -@code{[t]} or @code{[<+->]} of @code{<2-3>}. If the @code{BEAMER_col} -property is also set, something like @code{C[t]} can be added here as well to -set an options argument for the implied @code{columns} environment. -@code{c[t]} or @code{c<2->} will set an options for the implied @code{column} -environment. -@item BEAMER_col -The width of a column that should start with this entry. If this property is -set, the entry will also get a @code{:BMCOL:} property to make this visible. -Also this tag is only a visual aid. When this is a plain number, it will be -interpreted as a fraction of @code{\textwidth}. Otherwise it will be assumed -that you have specified the units, like @samp{3cm}. The first such property -in a frame will start a @code{columns} environment to surround the columns. -This environment is closed when an entry has a @code{BEAMER_col} property -with value 0 or 1, or automatically at the end of the frame. -@item BEAMER_extra -Additional commands that should be inserted after the environment has been -opened. For example, when creating a frame, this can be used to specify -transitions. -@end table - -Frames will automatically receive a @code{fragile} option if they contain -source code that uses the verbatim environment. Special @file{beamer} -specific code can be inserted using @code{#+BEAMER:} and -@code{#+BEGIN_BEAMER...#+END_BEAMER} constructs, similar to other export -backends, but with the difference that @code{#+LaTeX:} stuff will be included -in the presentation as well. - -Outline nodes with @code{BEAMER_env} property value @samp{note} or -@samp{noteNH} will be formatted as beamer notes, i,e, they will be wrapped -into @code{\note@{...@}}. The former will include the heading as part of the -note text, the latter will ignore the heading of that node. To simplify note -generation, it is actually enough to mark the note with a @emph{tag} (either -@code{:B_note:} or @code{:B_noteNH:}) instead of creating the -@code{BEAMER_env} property. - -You can turn on a special minor mode @code{org-beamer-mode} for editing -support with +Plain lists accept two optional attributes: @code{:environment} and +@code{:options}. The first one allows the use of a non-standard +environment (e.g., @samp{inparaenum}). The second one specifies +optional arguments for that environment (square brackets may be +omitted). @example -#+STARTUP: beamer +#+ATTR_LATEX: :environment compactitem :options $\circ$ +- you need ``paralist'' package to reproduce this example. @end example +@subsubheading Source blocks in @LaTeX{} export +@cindex source blocks, in @LaTeX{} export + +In addition to syntax defined in @ref{Literal examples}, names and +captions (@pxref{Images and tables}), source blocks also accept a +@code{:long-listing} attribute, which prevents the block from floating +when non-@code{nil}. + +@example +#+ATTR_LATEX: :long-listing t +#+BEGIN_SRC emacs-lisp +Code that may not fit in a single page. +#+END_SRC +@end example + +@subsubheading Special blocks in @LaTeX{} export +@cindex special blocks, in @LaTeX{} export + +In @LaTeX{} back-end, special blocks become environments of the same name. +Value of @code{:options} attribute will be appended as-is to that +environment's opening string. For example: + +@example +#+ATTR_LATEX: :options [Proof of important theorem] +#+BEGIN_PROOF +... +Therefore, any natural number above 4 is the sum of two primes. +#+END_PROOF +@end example + +@noindent +becomes + +@example +\begin@{proof@}[Proof of important theorem] +... +Therefore, any natural number above 4 is the sum of two primes. +\end@{proof@} +@end example + +@subsubheading Horizontal rules +@cindex horizontal rules, in @LaTeX{} export + +Width and thickness of a given horizontal rule can be controlled with, +respectively, @code{:width} and @code{:thickness} attributes: + +@example +#+ATTR_LATEX: :width .6\textwidth :thickness 0.8pt +----- +@end example + +@node Markdown export, OpenDocument Text export, @LaTeX{} and PDF export, Exporting +@section Markdown export +@cindex Markdown export + +@code{md} export back-end generates Markdown syntax@footnote{Vanilla flavour, +as defined at @url{http://daringfireball.net/projects/markdown/}.} for an Org +mode buffer. + +It is built over HTML back-end: any construct not supported by Markdown +syntax (e.g., tables) will be controlled and translated by @code{html} +back-end (@pxref{HTML export}). + +@subheading Markdown export commands + @table @kbd -@orgcmd{C-c C-b,org-beamer-select-environment} -In @code{org-beamer-mode}, this key offers fast selection of a beamer -environment or the @code{BEAMER_col} property. +@orgcmd{C-c C-e m m,org-md-export-to-markdown} +Export as a text file written in Markdown syntax. For an Org file, +@file{myfile.org}, the resulting file will be @file{myfile.md}. The file +will be overwritten without warning. +@orgcmd{C-c C-e m M,org-md-export-as-markdown} +Export to a temporary buffer. Do not create a file. +@item C-c C-e m o +Export as a text file with Markdown syntax, then open it. @end table -Column view provides a great way to set the environment of a node and other -important parameters. Make sure you are using a COLUMN format that is geared -toward this special purpose. The command @kbd{M-x -org-insert-beamer-options-template} defines such a format. +@subheading Header and sectioning structure -Here is a simple example Org document that is intended for beamer export. - -@smallexample -#+LaTeX_CLASS: beamer -#+TITLE: Example Presentation -#+AUTHOR: Carsten Dominik -#+LaTeX_CLASS_OPTIONS: [presentation] -#+BEAMER_FRAME_LEVEL: 2 -#+BEAMER_HEADER_EXTRA: \usetheme@{Madrid@}\usecolortheme@{default@} -#+COLUMNS: %35ITEM %10BEAMER_env(Env) %10BEAMER_envargs(Args) %4BEAMER_col(Col) %8BEAMER_extra(Ex) - -* This is the first structural section - -** Frame 1 \\ with a subtitle -*** Thanks to Eric Fraga :BMCOL:B_block: - :PROPERTIES: - :BEAMER_env: block - :BEAMER_envargs: C[t] - :BEAMER_col: 0.5 - :END: - for the first viable beamer setup in Org -*** Thanks to everyone else :BMCOL:B_block: - :PROPERTIES: - :BEAMER_col: 0.5 - :BEAMER_env: block - :BEAMER_envargs: <2-> - :END: - for contributing to the discussion -**** This will be formatted as a beamer note :B_note: -** Frame 2 \\ where we will not use columns -*** Request :B_block: - Please test this stuff! - :PROPERTIES: - :BEAMER_env: block - :END: -@end smallexample - -For more information, see the documentation on Worg. - -@node DocBook export, OpenDocument Text export, @LaTeX{} and PDF export, Exporting -@section DocBook export -@cindex DocBook export -@cindex PDF export -@cindex Cui, Baoqiu - -Org contains a DocBook exporter written by Baoqiu Cui. Once an Org file is -exported to DocBook format, it can be further processed to produce other -formats, including PDF, HTML, man pages, etc., using many available DocBook -tools and stylesheets. - -Currently DocBook exporter only supports DocBook V5.0. - -@menu -* DocBook export commands:: How to invoke DocBook export -* Quoting DocBook code:: Incorporating DocBook code in Org files -* Recursive sections:: Recursive sections in DocBook -* Tables in DocBook export:: Tables are exported as HTML tables -* Images in DocBook export:: How to insert figures into DocBook output -* Special characters:: How to handle special characters -@end menu - -@node DocBook export commands, Quoting DocBook code, DocBook export, DocBook export -@subsection DocBook export commands - -@cindex region, active -@cindex active region -@cindex transient-mark-mode -@table @kbd -@orgcmd{C-c C-e D,org-export-as-docbook} -@cindex property EXPORT_FILE_NAME -Export as a DocBook file. For an Org file, @file{myfile.org}, the DocBook XML -file will be @file{myfile.xml}. The file will be overwritten without -warning. If there is an active region@footnote{This requires -@code{transient-mark-mode} to be turned on}, only the region will be -exported. If the selected region is a single tree@footnote{To select the -current subtree, use @kbd{C-c @@}.}, the tree head will become the document -title. If the tree head entry has, or inherits, an @code{EXPORT_FILE_NAME} -property, that name will be used for the export. -@orgcmd{C-c C-e V,org-export-as-docbook-pdf-and-open} -Export as a DocBook file, process to PDF, then open the resulting PDF file. - -@vindex org-export-docbook-xslt-proc-command -@vindex org-export-docbook-xsl-fo-proc-command -Note that, in order to produce PDF output based on an exported DocBook file, -you need to have XSLT processor and XSL-FO processor software installed on your -system. Check variables @code{org-export-docbook-xslt-proc-command} and -@code{org-export-docbook-xsl-fo-proc-command}. - -@vindex org-export-docbook-xslt-stylesheet -The stylesheet argument @code{%s} in variable -@code{org-export-docbook-xslt-proc-command} is replaced by the value of -variable @code{org-export-docbook-xslt-stylesheet}, which needs to be set by -the user. You can also overrule this global setting on a per-file basis by -adding an in-buffer setting @code{#+XSLT:} to the Org file. - -@orgkey{C-c C-e v D} -Export only the visible part of the document. -@end table - -@node Quoting DocBook code, Recursive sections, DocBook export commands, DocBook export -@subsection Quoting DocBook code - -You can quote DocBook code in Org files and copy it verbatim into exported -DocBook file with the following constructs: - -@cindex #+DOCBOOK -@cindex #+BEGIN_DOCBOOK -@example -#+DOCBOOK: Literal DocBook code for export -@end example - -@noindent or -@cindex #+BEGIN_DOCBOOK - -@example -#+BEGIN_DOCBOOK -All lines between these markers are exported by DocBook exporter -literally. -#+END_DOCBOOK -@end example - -For example, you can use the following lines to include a DocBook warning -admonition. As to what this warning says, you should pay attention to the -document context when quoting DocBook code in Org files. You may make -exported DocBook XML files invalid by not quoting DocBook code correctly. - -@example -#+BEGIN_DOCBOOK - - You should know what you are doing when quoting DocBook XML code - in your Org file. Invalid DocBook XML may be generated by - DocBook exporter if you are not careful! - -#+END_DOCBOOK -@end example - -@node Recursive sections, Tables in DocBook export, Quoting DocBook code, DocBook export -@subsection Recursive sections -@cindex DocBook recursive sections - -DocBook exporter exports Org files as articles using the @code{article} -element in DocBook. Recursive sections, i.e., @code{section} elements, are -used in exported articles. Top level headlines in Org files are exported as -top level sections, and lower level headlines are exported as nested -sections. The entire structure of Org files will be exported completely, no -matter how many nested levels of headlines there are. - -Using recursive sections makes it easy to port and reuse exported DocBook -code in other DocBook document types like @code{book} or @code{set}. - -@node Tables in DocBook export, Images in DocBook export, Recursive sections, DocBook export -@subsection Tables in DocBook export -@cindex tables, in DocBook export - -Tables in Org files are exported as HTML tables, which have been supported since -DocBook V4.3. - -If a table does not have a caption, an informal table is generated using the -@code{informaltable} element; otherwise, a formal table will be generated -using the @code{table} element. - -@node Images in DocBook export, Special characters, Tables in DocBook export, DocBook export -@subsection Images in DocBook export -@cindex images, inline in DocBook -@cindex inlining images in DocBook - -Images that are linked to without a description part in the link, like -@samp{[[file:img.jpg]]} or @samp{[[./img.jpg]]}, will be exported to DocBook -using @code{mediaobject} elements. Each @code{mediaobject} element contains -an @code{imageobject} that wraps an @code{imagedata} element. If you have -specified a caption for an image as described in @ref{Images and tables}, a -@code{caption} element will be added in @code{mediaobject}. If a label is -also specified, it will be exported as an @code{xml:id} attribute of the -@code{mediaobject} element. - -@vindex org-export-docbook-default-image-attributes -Image attributes supported by the @code{imagedata} element, like @code{align} -or @code{width}, can be specified in two ways: you can either customize -variable @code{org-export-docbook-default-image-attributes} or use the -@code{#+ATTR_DOCBOOK:} line. Attributes specified in variable -@code{org-export-docbook-default-image-attributes} are applied to all inline -images in the Org file to be exported (unless they are overridden by image -attributes specified in @code{#+ATTR_DOCBOOK:} lines). - -The @code{#+ATTR_DOCBOOK:} line can be used to specify additional image -attributes or override default image attributes for individual images. If -the same attribute appears in both the @code{#+ATTR_DOCBOOK:} line and -variable @code{org-export-docbook-default-image-attributes}, the former -takes precedence. Here is an example about how image attributes can be -set: - -@cindex #+CAPTION -@cindex #+LABEL -@cindex #+ATTR_DOCBOOK -@example -#+CAPTION: The logo of Org mode -#+LABEL: unicorn-svg -#+ATTR_DOCBOOK: scalefit="1" width="100%" depth="100%" -[[./img/org-mode-unicorn.svg]] -@end example - -@vindex org-export-docbook-inline-image-extensions -By default, DocBook exporter recognizes the following image file types: -@file{jpeg}, @file{jpg}, @file{png}, @file{gif}, and @file{svg}. You can -customize variable @code{org-export-docbook-inline-image-extensions} to add -more types to this list as long as DocBook supports them. - -@node Special characters, , Images in DocBook export, DocBook export -@subsection Special characters in DocBook export -@cindex Special characters in DocBook export - -@vindex org-export-docbook-doctype -@vindex org-entities -Special characters that are written in @TeX{}-like syntax, such as @code{\alpha}, -@code{\Gamma}, and @code{\Zeta}, are supported by DocBook exporter. These -characters are rewritten to XML entities, like @code{α}, -@code{Γ}, and @code{Ζ}, based on the list saved in variable -@code{org-entities}. As long as the generated DocBook file includes the -corresponding entities, these special characters are recognized. - -You can customize variable @code{org-export-docbook-doctype} to include the -entities you need. For example, you can set variable -@code{org-export-docbook-doctype} to the following value to recognize all -special characters included in XHTML entities: - -@example -" -%xhtml1-symbol; -]> -" -@end example +@vindex org-md-headline-style +Markdown export can generate both @code{atx} and @code{setext} types for +headlines, according to @var{org-md-headline-style}. The former introduces +a hard limit of two levels, whereas the latter pushes it to six. Headlines +below that limit are exported as lists. You can also set a soft limit before +that one (@pxref{Export settings}). @c begin opendocument -@node OpenDocument Text export, TaskJuggler export, DocBook export, Exporting +@node OpenDocument Text export, iCalendar export, Markdown export, Exporting @section OpenDocument Text export -@cindex K, Jambunathan @cindex ODT @cindex OpenDocument @cindex export, OpenDocument @cindex LibreOffice -@cindex org-odt.el -@cindex org-modules -Org Mode@footnote{Versions 7.8 or later} supports export to OpenDocument Text -(ODT) format using the @file{org-odt.el} module. Documents created -by this exporter use the @cite{OpenDocument-v1.2 +Org mode@footnote{Versions 7.8 or later} supports export to OpenDocument Text +(ODT) format. Documents created by this exporter use the +@cite{OpenDocument-v1.2 specification}@footnote{@url{http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html, Open Document Format for Office Applications (OpenDocument) Version 1.2}} and are compatible with LibreOffice 3.4. @@ -11055,32 +11737,32 @@ output. Check the availability of this program before proceeding further. @cindex active region @cindex transient-mark-mode @table @kbd -@orgcmd{C-c C-e o,org-export-as-odt} +@orgcmd{C-c C-e o o,org-odt-export-to-odt} @cindex property EXPORT_FILE_NAME Export as OpenDocument Text file. -@vindex org-export-odt-preferred-output-format -If @code{org-export-odt-preferred-output-format} is specified, automatically -convert the exported file to that format. @xref{x-export-to-other-formats, , +@vindex org-odt-preferred-output-format +If @var{org-odt-preferred-output-format} is specified, automatically convert +the exported file to that format. @xref{x-export-to-other-formats, , Automatically exporting to other formats}. For an Org file @file{myfile.org}, the ODT file will be @file{myfile.odt}. The file will be overwritten without warning. If there -is an active region,@footnote{This requires @code{transient-mark-mode} to be +is an active region,@footnote{This requires @var{transient-mark-mode} to be turned on} only the region will be exported. If the selected region is a single tree,@footnote{To select the current subtree, use @kbd{C-c @@}} the tree head will become the document title. If the tree head entry has, or inherits, an @code{EXPORT_FILE_NAME} property, that name will be used for the export. -@orgcmd{C-c C-e O,org-export-as-odt-and-open} +@kbd{C-c C-e o O} Export as an OpenDocument Text file and open the resulting file. -@vindex org-export-odt-preferred-output-format -If @code{org-export-odt-preferred-output-format} is specified, open the -converted file instead. @xref{x-export-to-other-formats, , Automatically -exporting to other formats}. +@vindex org-odt-preferred-output-format +If @var{org-odt-preferred-output-format} is specified, open the converted +file instead. @xref{x-export-to-other-formats, , Automatically exporting to +other formats}. @end table @node Extending ODT export, Applying custom styles, ODT export commands, OpenDocument Text export @@ -11096,7 +11778,7 @@ one format (say @samp{csv}) to another format (say @samp{ods} or @samp{xls}). If you have a working installation of LibreOffice, a document converter is pre-configured for you and you can use it right away. If you would like to use @file{unoconv} as your preferred converter, customize the variable -@code{org-export-odt-convert-process} to point to @code{unoconv}. You can +@var{org-odt-convert-process} to point to @code{unoconv}. You can also use your own favorite converter or tweak the default settings of the @file{LibreOffice} and @samp{unoconv} converters. @xref{Configuring a document converter}. @@ -11104,12 +11786,12 @@ document converter}. @subsubsection Automatically exporting to other formats @anchor{x-export-to-other-formats} -@vindex org-export-odt-preferred-output-format +@vindex org-odt-preferred-output-format Very often, you will find yourself exporting to ODT format, only to immediately save the exported document to other formats like @samp{doc}, @samp{docx}, @samp{rtf}, @samp{pdf} etc. In such cases, you can specify your preferred output format by customizing the variable -@code{org-export-odt-preferred-output-format}. This way, the export commands +@var{org-odt-preferred-output-format}. This way, the export commands (@pxref{x-export-to-odt,,Exporting to ODT}) can be extended to export to a format that is of immediate interest to you. @@ -11122,10 +11804,10 @@ ODT format. LibreOffice converter, mentioned above, is one such converter. Once a converter is configured, you can interact with it using the following command. -@vindex org-export-odt-convert +@vindex org-odt-convert @table @kbd -@item M-x org-export-odt-convert +@item M-x org-odt-convert RET Convert an existing document from one format to another. With a prefix argument, also open the newly produced file. @end table @@ -11162,8 +11844,8 @@ OpenDocument Text (@file{.odt}) or OpenDocument Template (@file{.ott}) file. @item @cindex #+ODT_STYLES_FILE -@vindex org-export-odt-styles-file -Customize the variable @code{org-export-odt-styles-file} and point it to the +@vindex org-odt-styles-file +Customize the variable @var{org-odt-styles-file} and point it to the newly created file. For additional configuration options @pxref{x-overriding-factory-styles,,Overriding factory styles}. @@ -11193,7 +11875,7 @@ the factory settings. @node Links in ODT export, Tables in ODT export, Applying custom styles, OpenDocument Text export @subsection Links in ODT export -@cindex tables, in DocBook export +@cindex links, in ODT export ODT exporter creates native cross-references for internal links. It creates Internet-style links for all other links. @@ -11207,7 +11889,7 @@ with a cross-reference and sequence number of the labeled entity. @node Tables in ODT export, Images in ODT export, Links in ODT export, OpenDocument Text export @subsection Tables in ODT export -@cindex tables, in DocBook export +@cindex tables, in ODT export Export of native Org mode tables (@pxref{Tables}) and simple @file{table.el} tables is supported. However, export of complex @file{table.el} tables---tables @@ -11286,17 +11968,17 @@ You can control the size and scale of the embedded images using the @code{#+ATTR_ODT} attribute. @cindex identify, ImageMagick -@vindex org-export-odt-pixels-per-inch +@vindex org-odt-pixels-per-inch The exporter specifies the desired size of the image in the final document in units of centimeters. In order to scale the embedded images, the exporter queries for pixel dimensions of the images using one of a) ImageMagick's @file{identify} program or b) Emacs `create-image' and `image-size' -APIs.@footnote{Use of @file{ImageMagick} is only desirable. However, if you +APIs@footnote{Use of @file{ImageMagick} is only desirable. However, if you routinely produce documents that have large images or you export your Org files that has images using a Emacs batch script, then the use of -@file{ImageMagick} is mandatory.} The pixel dimensions are subsequently +@file{ImageMagick} is mandatory.}. The pixel dimensions are subsequently converted in to units of centimeters using -@code{org-export-odt-pixels-per-inch}. The default value of this variable is +@var{org-odt-pixels-per-inch}. The default value of this variable is set to @code{display-pixels-per-inch}. You can tweak this variable to achieve the best results. @@ -11387,8 +12069,8 @@ the exported document. @vindex org-latex-to-mathml-jar-file You can specify the @LaTeX{}-to-MathML converter by customizing the variables -@code{org-latex-to-mathml-convert-command} and -@code{org-latex-to-mathml-jar-file}. +@var{org-latex-to-mathml-convert-command} and +@var{org-latex-to-mathml-jar-file}. If you prefer to use @file{MathToWeb}@footnote{See @uref{http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl, MathToWeb}} as your @@ -11405,11 +12087,10 @@ You can use the following commands to quickly verify the reliability of the @LaTeX{}-to-MathML converter. @table @kbd - -@item M-x org-export-as-odf +@item M-x org-odt-export-as-odf RET Convert a @LaTeX{} math snippet to an OpenDocument formula (@file{.odf}) file. -@item M-x org-export-as-odf-and-open +@item M-x org-odt-export-as-odf-and-open RET Convert a @LaTeX{} math snippet to an OpenDocument formula (@file{.odf}) file and open the formula file with the system-registered application. @end table @@ -11472,15 +12153,15 @@ It could be rendered as shown below in the exported document. Figure 2: Bell curve @end example -@vindex org-export-odt-category-strings +@vindex org-odt-category-map-alist You can modify the category component of the caption by customizing the -variable @code{org-export-odt-category-strings}. For example, to tag all -embedded images with the string @samp{Illustration} (instead of the default -@samp{Figure}) use the following setting. +option @var{org-odt-category-map-alist}. For example, to tag all embedded +images with the string @samp{Illustration} (instead of the default +@samp{Figure}) use the following setting: @lisp -(setq org-export-odt-category-strings - '(("en" "Table" "Illustration" "Equation" "Equation"))) +(setq org-odt-category-map-alist + (("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p))) @end lisp With this, previous image will be captioned as below in the exported @@ -11501,14 +12182,14 @@ fontification to be turned on.} The auto-generated styles have @samp{OrgSrc} as prefix and inherit their color from the faces used by Emacs @code{font-lock} library for the source language. -@vindex org-export-odt-fontify-srcblocks -If you prefer to use your own custom styles for fontification, you can do so -by customizing the variable -@code{org-export-odt-create-custom-styles-for-srcblocks}. +@vindex org-odt-fontify-srcblocks +If you prefer to use your own custom styles for fontification, you can do +so by customizing the option +@var{org-odt-create-custom-styles-for-srcblocks}. -@vindex org-export-odt-create-custom-styles-for-srcblocks +@vindex org-odt-create-custom-styles-for-srcblocks You can turn off fontification of literal examples by customizing the -variable @code{org-export-odt-fontify-srcblocks}. +option @var{org-odt-fontify-srcblocks}. @node Advanced topics in ODT export, , Literal examples in ODT export, OpenDocument Text export @subsection Advanced topics in ODT export @@ -11539,27 +12220,27 @@ like to tweak the default converter settings, proceed as below. @enumerate @item Register the converter -@vindex org-export-odt-convert-processes -Name your converter and add it to the list of known converters by customizing -the variable @code{org-export-odt-convert-processes}. Also specify how the -converter can be invoked via command-line to effect the conversion. +@vindex org-odt-convert-processes +Name your converter and add it to the list of known converters by +customizing the option @var{org-odt-convert-processes}. Also specify how +the converter can be invoked via command-line to effect the conversion. @item Configure its capabilities -@vindex org-export-odt-convert-capabilities -@anchor{x-odt-converter-capabilities} -Specify the set of formats the converter can handle by customizing the -variable @code{org-export-odt-convert-capabilities}. Use the default value -for this variable as a guide for configuring your converter. As suggested by -the default setting, you can specify the full set of formats supported by the +@vindex org-odt-convert-capabilities +@anchor{x-odt-converter-capabilities} Specify the set of formats the +converter can handle by customizing the variable +@var{org-odt-convert-capabilities}. Use the default value for this +variable as a guide for configuring your converter. As suggested by the +default setting, you can specify the full set of formats supported by the converter and not limit yourself to specifying formats that are related to just the OpenDocument Text format. @item Choose the converter -@vindex org-export-odt-convert-process +@vindex org-odt-convert-process Select the newly added converter as the preferred one by customizing the -variable @code{org-export-odt-convert-process}. +option @var{org-odt-convert-process}. @end enumerate @node Working with OpenDocument style files, Creating one-off styles, Configuring a document converter, Advanced topics in ODT export @@ -11577,7 +12258,7 @@ the exporter. The ODT exporter relies on two files for generating its output. These files are bundled with the distribution under the directory pointed to -by the variable @code{org-odt-styles-dir}. The two files are: +by the variable @var{org-odt-styles-dir}. The two files are: @itemize @anchor{x-orgodtstyles-xml} @@ -11627,9 +12308,9 @@ customize these variables to override the factory styles used by the exporter. @itemize -@anchor{x-org-export-odt-styles-file} +@anchor{x-org-odt-styles-file} @item -@code{org-export-odt-styles-file} +@var{org-odt-styles-file} Use this variable to specify the @file{styles.xml} that will be used in the final output. You can specify one of the following values: @@ -11658,9 +12339,9 @@ like header and footer images. Use the default @file{styles.xml} @end enumerate -@anchor{x-org-export-odt-content-template-file} +@anchor{x-org-odt-content-template-file} @item -@code{org-export-odt-content-template-file} +@var{org-odt-content-template-file} Use this variable to specify the blank @file{content.xml} that will be used in the final output. @@ -11710,7 +12391,7 @@ custom @samp{PageBreak} style as shown below. @example + style:parent-style-name="Text_20_body"> @end example @@ -11747,22 +12428,21 @@ OpenDocument-v1.2 specification.@footnote{@url{http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html, OpenDocument-v1.2 Specification}} - - @subsubheading Custom table styles: an illustration -To have a quick preview of this feature, install the below setting and export -the table that follows. +@vindex org-odt-table-styles +To have a quick preview of this feature, install the below setting and +export the table that follows: @lisp -(setq org-export-odt-table-styles - (append org-export-odt-table-styles - '(("TableWithHeaderRowAndColumn" "Custom" - ((use-first-row-styles . t) - (use-first-column-styles . t))) - ("TableWithFirstRowandLastRow" "Custom" - ((use-first-row-styles . t) - (use-last-row-styles . t)))))) +(setq org-odt-table-styles + (append org-odt-table-styles + '(("TableWithHeaderRowAndColumn" "Custom" + ((use-first-row-styles . t) + (use-first-column-styles . t))) + ("TableWithFirstRowandLastRow" "Custom" + ((use-first-row-styles . t) + (use-last-row-styles . t)))))) @end lisp @example @@ -11775,9 +12455,9 @@ the table that follows. In the above example, you used a template named @samp{Custom} and installed two table styles with the names @samp{TableWithHeaderRowAndColumn} and @samp{TableWithFirstRowandLastRow}. (@strong{Important:} The OpenDocument -styles needed for producing the above template have been pre-defined for you. -These styles are available under the section marked @samp{Custom Table -Template} in @file{OrgOdtContentTemplate.xml} +styles needed for producing the above template have been pre-defined for +you. These styles are available under the section marked @samp{Custom +Table Template} in @file{OrgOdtContentTemplate.xml} (@pxref{x-orgodtcontenttemplate-xml,,Factory styles}). If you need additional templates you have to define these styles yourselves. @@ -11861,9 +12541,9 @@ Define a table style@footnote{See the attributes @code{table:template-name}, @code{table:use-banding-column-styles} of the @code{} element in the OpenDocument-v1.2 specification} -@vindex org-export-odt-table-styles +@vindex org-odt-table-styles To define a table style, create an entry for the style in the variable -@code{org-export-odt-table-styles} and specify the following: +@code{org-odt-table-styles} and specify the following: @itemize @minus @item the name of the table template created in step (1) @@ -11876,14 +12556,14 @@ based on the same template @samp{Custom}. The styles achieve their intended effect by selectively activating the individual cell styles in that template. @lisp -(setq org-export-odt-table-styles - (append org-export-odt-table-styles - '(("TableWithHeaderRowAndColumn" "Custom" - ((use-first-row-styles . t) - (use-first-column-styles . t))) - ("TableWithFirstRowandLastRow" "Custom" - ((use-first-row-styles . t) - (use-last-row-styles . t)))))) +(setq org-odt-table-styles + (append org-odt-table-styles + '(("TableWithHeaderRowAndColumn" "Custom" + ((use-first-row-styles . t) + (use-first-column-styles . t))) + ("TableWithFirstRowandLastRow" "Custom" + ((use-first-row-styles . t) + (use-last-row-styles . t)))))) @end lisp @item @@ -11914,173 +12594,15 @@ nothing but @samp{zip} archives}: @inforef{File Archives,,emacs}. For general help with validation (and schema-sensitive editing) of XML files: @inforef{Introduction,,nxml-mode}. -@vindex org-export-odt-schema-dir +@vindex org-odt-schema-dir If you have ready access to OpenDocument @file{.rnc} files and the needed schema-locating rules in a single folder, you can customize the variable -@code{org-export-odt-schema-dir} to point to that directory. The -ODT exporter will take care of updating the -@code{rng-schema-locating-files} for you. +@var{org-odt-schema-dir} to point to that directory. The ODT exporter +will take care of updating the @code{rng-schema-locating-files} for you. @c end opendocument -@node TaskJuggler export, Freemind export, OpenDocument Text export, Exporting -@section TaskJuggler export -@cindex TaskJuggler export -@cindex Project management - -@uref{http://www.taskjuggler.org/, TaskJuggler} is a project management tool. -It provides an optimizing scheduler that computes your project time lines and -resource assignments based on the project outline and the constraints that -you have provided. - -The TaskJuggler exporter is a bit different from other exporters, such as the -@code{HTML} and @LaTeX{} exporters for example, in that it does not export all the -nodes of a document or strictly follow the order of the nodes in the -document. - -Instead the TaskJuggler exporter looks for a tree that defines the tasks and -a optionally tree that defines the resources for this project. It then -creates a TaskJuggler file based on these trees and the attributes defined in -all the nodes. - -@subsection TaskJuggler export commands - -@table @kbd -@orgcmd{C-c C-e j,org-export-as-taskjuggler} -Export as a TaskJuggler file. - -@orgcmd{C-c C-e J,org-export-as-taskjuggler-and-open} -Export as a TaskJuggler file and then open the file with TaskJugglerUI. -@end table - -@subsection Tasks - -@vindex org-export-taskjuggler-project-tag -Create your tasks as you usually do with Org mode. Assign efforts to each -task using properties (it is easiest to do this in the column view). You -should end up with something similar to the example by Peter Jones in -@url{http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org}. -Now mark the top node of your tasks with a tag named -@code{:taskjuggler_project:} (or whatever you customized -@code{org-export-taskjuggler-project-tag} to). You are now ready to export -the project plan with @kbd{C-c C-e J} which will export the project plan and -open a gantt chart in TaskJugglerUI. - -@subsection Resources - -@vindex org-export-taskjuggler-resource-tag -Next you can define resources and assign those to work on specific tasks. You -can group your resources hierarchically. Tag the top node of the resources -with @code{:taskjuggler_resource:} (or whatever you customized -@code{org-export-taskjuggler-resource-tag} to). You can optionally assign an -identifier (named @samp{resource_id}) to the resources (using the standard -Org properties commands, @pxref{Property syntax}) or you can let the exporter -generate identifiers automatically (the exporter picks the first word of the -headline as the identifier as long as it is unique---see the documentation of -@code{org-taskjuggler-get-unique-id}). Using that identifier you can then -allocate resources to tasks. This is again done with the @samp{allocate} -property on the tasks. Do this in column view or when on the task type -@kbd{C-c C-x p allocate @key{RET} @key{RET}}. - -Once the allocations are done you can again export to TaskJuggler and check -in the Resource Allocation Graph which person is working on what task at what -time. - -@subsection Export of properties - -The exporter also takes TODO state information into consideration, i.e., if a -task is marked as done it will have the corresponding attribute in -TaskJuggler (@samp{complete 100}). Also it will export any property on a task -resource or resource node which is known to TaskJuggler, such as -@samp{limits}, @samp{vacation}, @samp{shift}, @samp{booking}, -@samp{efficiency}, @samp{journalentry}, @samp{rate} for resources or -@samp{account}, @samp{start}, @samp{note}, @samp{duration}, @samp{end}, -@samp{journalentry}, @samp{milestone}, @samp{reference}, @samp{responsible}, -@samp{scheduling}, etc.@: for tasks. - -@subsection Dependencies - -The exporter will handle dependencies that are defined in the tasks either -with the @samp{ORDERED} attribute (@pxref{TODO dependencies}), with the -@samp{BLOCKER} attribute (see @file{org-depend.el}) or alternatively with a -@samp{depends} attribute. Both the @samp{BLOCKER} and the @samp{depends} -attribute can be either @samp{previous-sibling} or a reference to an -identifier (named @samp{task_id}) which is defined for another task in the -project. @samp{BLOCKER} and the @samp{depends} attribute can define multiple -dependencies separated by either space or comma. You can also specify -optional attributes on the dependency by simply appending it. The following -examples should illustrate this: - -@example -* Preparation - :PROPERTIES: - :task_id: preparation - :ORDERED: t - :END: -* Training material - :PROPERTIES: - :task_id: training_material - :ORDERED: t - :END: -** Markup Guidelines - :PROPERTIES: - :Effort: 2d - :END: -** Workflow Guidelines - :PROPERTIES: - :Effort: 2d - :END: -* Presentation - :PROPERTIES: - :Effort: 2d - :BLOCKER: training_material @{ gapduration 1d @} preparation - :END: -@end example - -@subsection Reports - -@vindex org-export-taskjuggler-default-reports -TaskJuggler can produce many kinds of reports (e.g., gantt chart, resource -allocation, etc). The user defines what kind of reports should be generated -for a project in the TaskJuggler file. The exporter will automatically insert -some default reports in the file. These defaults are defined in -@code{org-export-taskjuggler-default-reports}. They can be modified using -customize along with a number of other options. For a more complete list, see -@kbd{M-x customize-group @key{RET} org-export-taskjuggler @key{RET}}. - -For more information and examples see the Org-taskjuggler tutorial at -@uref{http://orgmode.org/worg/org-tutorials/org-taskjuggler.html}. - -@node Freemind export, XOXO export, TaskJuggler export, Exporting -@section Freemind export -@cindex Freemind export -@cindex mind map - -The Freemind exporter was written by Lennart Borgman. - -@table @kbd -@orgcmd{C-c C-e m,org-export-as-freemind} -Export as a Freemind mind map. For an Org file @file{myfile.org}, the Freemind -file will be @file{myfile.mm}. -@end table - -@node XOXO export, iCalendar export, Freemind export, Exporting -@section XOXO export -@cindex XOXO export - -Org mode contains an exporter that produces XOXO-style output. -Currently, this exporter only handles the general outline structure and -does not interpret any additional Org mode features. - -@table @kbd -@orgcmd{C-c C-e x,org-export-as-xoxo} -Export as an XOXO file. For an Org file @file{myfile.org}, the XOXO file will be -@file{myfile.html}. -@orgkey{C-c C-e v x} -Export only the visible part of the document. -@end table - -@node iCalendar export, , XOXO export, Exporting +@node iCalendar export, Other built-in back-ends, OpenDocument Text export, Exporting @section iCalendar export @cindex iCalendar export @@ -12095,22 +12617,22 @@ case it can be useful to show deadlines and other time-stamped items in Org files in the calendar application. Org mode can export calendar information in the standard iCalendar format. If you also want to have TODO entries included in the export, configure the variable -@code{org-icalendar-include-todo}. Plain timestamps are exported as VEVENT, +@var{org-icalendar-include-todo}. Plain timestamps are exported as VEVENT, and TODO items as VTODO@. It will also create events from deadlines that are in non-TODO items. Deadlines and scheduling dates in TODO items will be used to set the start and due dates for the TODO entry@footnote{See the variables -@code{org-icalendar-use-deadline} and @code{org-icalendar-use-scheduled}.}. +@var{org-icalendar-use-deadline} and @var{org-icalendar-use-scheduled}.}. As categories, it will use the tags locally defined in the heading, and the file/tree category@footnote{To add inherited tags or the TODO state, -configure the variable @code{org-icalendar-categories}.}. See the variable -@code{org-icalendar-alarm-time} for a way to assign alarms to entries with a +configure the variable @var{org-icalendar-categories}.}. See the variable +@var{org-icalendar-alarm-time} for a way to assign alarms to entries with a time. @vindex org-icalendar-store-UID @cindex property, ID The iCalendar standard requires each entry to have a globally unique identifier (UID). Org creates these identifiers during export. If you set -the variable @code{org-icalendar-store-UID}, the UID will be stored in the +the variable @var{org-icalendar-store-UID}, the UID will be stored in the @code{:ID:} property of the entry and re-used next time you report this entry. Since a single entry can give rise to multiple iCalendar entries (as a timestamp, a deadline, a scheduled item, and as a TODO item), Org adds @@ -12119,19 +12641,19 @@ In this way the UID remains unique, but a synchronization program can still figure out from which entry all the different instances originate. @table @kbd -@orgcmd{C-c C-e i,org-export-icalendar-this-file} -Create iCalendar entries for the current file and store them in the same +@orgcmd{C-c C-e c f,org-icalendar-export-to-ics} +Create iCalendar entries for the current buffer and store them in the same directory, using a file extension @file{.ics}. -@orgcmd{C-c C-e I, org-export-icalendar-all-agenda-files} +@orgcmd{C-c C-e c a, org-icalendar-export-agenda-files} @vindex org-agenda-files -Like @kbd{C-c C-e i}, but do this for all files in -@code{org-agenda-files}. For each of these files, a separate iCalendar +Like @kbd{C-c C-e c f}, but do this for all files in +@var{org-agenda-files}. For each of these files, a separate iCalendar file will be written. -@orgcmd{C-c C-e c,org-export-icalendar-combine-agenda-files} -@vindex org-combined-agenda-icalendar-file +@orgcmd{C-c C-e c c,org-icalendar-combine-agenda-files} +@vindex org-icalendar-combined-agenda-file Create a single large iCalendar file from all files in -@code{org-agenda-files} and write it to the file given by -@code{org-combined-agenda-icalendar-file}. +@var{org-agenda-files} and write it to the file given by +@var{org-icalendar-combined-agenda-file}. @end table @vindex org-use-property-inheritance @@ -12141,14 +12663,241 @@ Create a single large iCalendar file from all files in @cindex property, LOCATION The export will honor SUMMARY, DESCRIPTION and LOCATION@footnote{The LOCATION property can be inherited from higher in the hierarchy if you configure -@code{org-use-property-inheritance} accordingly.} properties if the selected +@var{org-use-property-inheritance} accordingly.} properties if the selected entries have them. If not, the summary will be derived from the headline, and the description from the body (limited to -@code{org-icalendar-include-body} characters). +@var{org-icalendar-include-body} characters). How this calendar is best read and updated, depends on the application you are using. The FAQ covers this issue. +@node Other built-in back-ends, Export in foreign buffers, iCalendar export, Exporting +@section Other built-in back-ends +@cindex export back-ends, built-in +@vindex org-export-backends + +On top of the aforemetioned back-ends, Org comes with other built-in ones: + +@itemize +@item @file{ox-man.el}: export to a man page. +@item @file{ox-texinfo.el}: export to @code{Texinfo} format. +@item @file{ox-org.el}: export to an Org document. +@end itemize + +To activate these export back-end, customize @var{org-export-backends} or +load them directly with e.g., @code{(require 'ox-texinfo)}. This will add +new keys in the export dispatcher (@pxref{The Export Dispatcher}). + +See the comment section of these files for more information on how to use +them. + +@node Export in foreign buffers, Advanced configuration, Other built-in back-ends, Exporting +@section Export in foreign buffers + +Most built-in back-ends come with a command to convert the selected region +into a selected format and replace this region by the exported output. Here +is a list of such conversion commands: + +@table @code +@item org-html-convert-region-to-html +Convert the selected region into HTML. +@item org-latex-convert-region-to-latex +Convert the selected region into @LaTeX{}. +@item org-texinfo-convert-region-to-texinfo +Convert the selected region into @code{Texinfo}. +@item org-md-convert-region-to-md +Convert the selected region into @code{MarkDown}. +@end table + +This is particularily useful for converting tables and lists in foreign +buffers. E.g., in a HTML buffer, you can turn on @code{orgstruct-mode}, then +use Org commands for editing a list, and finally select and convert the list +with @code{M-x org-html-convert-region-to-html RET}. + +@node Advanced configuration, , Export in foreign buffers, Exporting +@section Advanced configuration + +@subheading Hooks + +@vindex org-export-before-processing-hook +@vindex org-export-before-parsing-hook +Two hooks are run during the first steps of the export process. The first +one, @var{org-export-before-processing-hook} is called before expanding +macros, Babel code and include keywords in the buffer. The second one, +@var{org-export-before-parsing-hook}, as its name suggests, happens just +before parsing the buffer. Their main use is for heavy duties, that is +duties involving structural modifications of the document. For example, one +may want to remove every headline in the buffer during export. The following +code can achieve this: + +@lisp +@group +(defun my-headline-removal (backend) + "Remove all headlines in the current buffer. +BACKEND is the export back-end being used, as a symbol." + (org-map-entries + (lambda () (delete-region (point) (progn (forward-line) (point)))))) + +(add-hook 'org-export-before-parsing-hook 'my-headline-removal) +@end group +@end lisp + +Note that functions used in these hooks require a mandatory argument, +a symbol representing the back-end used. + +@subheading Filters + +@cindex Filters, exporting +Filters are lists of functions applied on a specific part of the output from +a given back-end. More explicitly, each time a back-end transforms an Org +object or element into another language, all functions within a given filter +type are called in turn on the string produced. The string returned by the +last function will be the one used in the final output. + +There are filters sets for each type of element or object, for plain text, +for the parse tree, for the export options and for the final output. They +are all named after the same scheme: @code{org-export-filter-TYPE-functions}, +where @code{TYPE} is the type targeted by the filter. Valid types are: + +@multitable @columnfractions .33 .33 .33 +@item bold +@tab babel-call +@tab center-block +@item clock +@tab code +@tab comment +@item comment-block +@tab diary-sexp +@tab drawer +@item dynamic-block +@tab entity +@tab example-block +@item export-block +@tab export-snippet +@tab final-output +@item fixed-width +@tab footnote-definition +@tab footnote-reference +@item headline +@tab horizontal-rule +@tab inline-babel-call +@item inline-src-block +@tab inlinetask +@tab italic +@item item +@tab keyword +@tab latex-environment +@item latex-fragment +@tab line-break +@tab link +@item node-property +@tab options +@tab paragraph +@item parse-tree +@tab plain-list +@tab plain-text +@item planning +@tab property-drawer +@tab quote-block +@item quote-section +@tab radio-target +@tab section +@item special-block +@tab src-block +@tab statistics-cookie +@item strike-through +@tab subscript +@tab superscript +@item table +@tab table-cell +@tab table-row +@item target +@tab timestamp +@tab underline +@item verbatim +@tab verse-block +@tab +@end multitable + +For example, the following snippet allows me to use non-breaking spaces in +the Org buffer and get them translated into @LaTeX{} without using the +@code{\nbsp} macro (where @code{_} stands for the non-breaking space): + +@lisp +@group +(defun my-latex-filter-nobreaks (text backend info) + "Ensure \" \" are properly handled in LaTeX export." + (when (org-export-derived-backend-p backend 'latex) + (replace-regexp-in-string " " "~" text))) + +(add-to-list 'org-export-filter-plain-text-functions + 'my-latex-filter-nobreaks) +@end group +@end lisp + +Three arguments must be provided to a fiter: 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 +@var{org-export-derived-backend-p}, which ensures that the filter will only +be applied when using @code{latex} back-end or any other back-end derived +from it (e.g., @code{beamer}). + +@subheading Extending an existing back-end + +This is obviously the most powerful customization, since the changes happen +at the parser level. Indeed, some export back-ends are built as extensions +of other ones (e.g. Markdown back-end an extension of HTML back-end). + +Extending a back-end means that if an element type is not transcoded by the +new back-end, it will be handled by the original one. Hence you can extend +specific parts of a back-end without too much work. + +As an example, imagine we want the @code{ascii} back-end to display the +language used in a source block, when it is available, but only when some +attribute is non-@code{nil}, like the following: + +@example +#+ATTR_ASCII: :language t +@end example + +Because that back-end is lacking in that area, we are going to create a new +back-end, @code{my-ascii} that will do the job. + +@lisp +@group +(defun my-ascii-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to ASCII. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (if (not (org-export-read-attribute :attr_ascii src-block :language)) + (org-export-with-backend 'ascii src-block contents info) + (concat + (format ",--[ %s ]--\n%s`----" + (org-element-property :language src-block) + (replace-regexp-in-string + "^" "| " + (org-element-normalize-string + (org-export-format-code-default src-block info))))))) + +(org-export-define-derived-backend 'my-ascii 'ascii + :translate-alist '((src-block . my-ascii-src-block))) +@end group +@end lisp + +The @code{my-ascii-src-block} function looks at the attribute above the +element. If it isn’t true, it gives hand to the @code{ascii} back-end. +Otherwise, it creates a box around the code, leaving room for the language. +A new back-end is then created. It only changes its behaviour when +translating @code{src-block} type element. Now, all it takes to use the new +back-end is calling the following from an Org buffer: + +@smalllisp +(org-export-to-buffer 'my-ascii "*Org MY-ASCII Export*") +@end smalllisp + +It is obviously possible to write an interactive function for this, install +it in the export dispatcher menu, and so on. + @node Publishing, Working With Source Code, Exporting, Top @chapter Publishing @cindex publishing @@ -12189,13 +12938,13 @@ and many other properties of a project. @end menu @node Project alist, Sources and destinations, Configuration, Configuration -@subsection The variable @code{org-publish-project-alist} +@subsection The variable @var{org-publish-project-alist} @cindex org-publish-project-alist @cindex projects, for publishing @vindex org-publish-project-alist Publishing is configured almost entirely through setting the value of one -variable, called @code{org-publish-project-alist}. Each element of the list +variable, called @var{org-publish-project-alist}. Each element of the list configures one project, and may be in one of the two following forms: @lisp @@ -12228,7 +12977,7 @@ and where to put published files. @tab Directory containing publishing source files @item @code{:publishing-directory} @tab Directory where output files will be published. You can directly -publish to a webserver using a file name syntax appropriate for +publish to a web server using a file name syntax appropriate for the Emacs @file{tramp} package. Or you can publish to a local directory and use external tools to upload your website (@pxref{Uploading files}). @item @code{:preparation-function} @@ -12267,7 +13016,7 @@ extension. and @code{:exclude}. @item @code{:recursive} -@tab Non-nil means, check base-directory recursively for files to publish. +@tab non-@code{nil} means, check base-directory recursively for files to publish. @end multitable @node Publishing action, Publishing options, Selecting files, Configuration @@ -12277,201 +13026,164 @@ and @code{:exclude}. Publishing means that a file is copied to the destination directory and possibly transformed in the process. The default transformation is to export Org files as HTML files, and this is done by the function -@code{org-publish-org-to-html} which calls the HTML exporter (@pxref{HTML +@code{org-html-publish-to-html}, which calls the HTML exporter (@pxref{HTML export}). But you also can publish your content as PDF files using -@code{org-publish-org-to-pdf}, or as @code{ascii}, @code{latin1} or -@code{utf8} encoded files using the corresponding functions. If you want to -publish the Org file itself, but with @i{archived}, @i{commented}, and -@i{tag-excluded} trees removed, use @code{org-publish-org-to-org} and set the -parameters @code{:plain-source} and/or @code{:htmlized-source}. This will -produce @file{file.org} and @file{file.org.html} in the publishing -directory@footnote{@file{file-source.org} and @file{file-source.org.html} if -source and publishing directories are equal. Note that with this kind of -setup, you need to add @code{:exclude "-source\\.org"} to the project -definition in @code{org-publish-project-alist} to prevent the published -source files from being considered as new org files the next time the project -is published.}. Other files like images only need to be copied to the -publishing destination; for this you may use @code{org-publish-attachment}. -For non-Org files, you always need to specify the publishing function: +@code{org-latex-publish-to-pdf} or as @code{ascii}, @code{Texinfo}, etc., +using the corresponding functions. + +If you want to publish the Org file as an @code{.org} file but with the +@i{archived}, @i{commented} and @i{tag-excluded} trees removed, use the +function @code{org-org-publish-to-org}. This will produce @file{file.org} +and put it in the publishing directory. If you want a htmlized version of +this file, set the parameter @code{:htmlized-source} to @code{t}, it will +produce @file{file.org.html} in the publishing directory@footnote{If the +publishing directory is the same than the source directory, @file{file.org} +will be exported as @file{file.org.org}, so probably don't want to do this.}. + +Other files like images only need to be copied to the publishing destination. +For this you can use @code{org-publish-attachment}. For non-org files, you +always need to specify the publishing function: @multitable @columnfractions 0.3 0.7 @item @code{:publishing-function} @tab Function executing the publication of a file. This may also be a list of functions, which will all be called in turn. -@item @code{:plain-source} -@tab Non-nil means, publish plain source. @item @code{:htmlized-source} -@tab Non-nil means, publish htmlized source. +@tab non-@code{nil} means, publish htmlized source. @end multitable The function must accept three arguments: a property list containing at least -a @code{:publishing-directory} property, the name of the file to be -published, and the path to the publishing directory of the output file. It -should take the specified file, make the necessary transformation (if any) -and place the result into the destination folder. +a @code{:publishing-directory} property, the name of the file to be published +and the path to the publishing directory of the output file. It should take +the specified file, make the necessary transformation (if any) and place the +result into the destination folder. @node Publishing options, Publishing links, Publishing action, Configuration -@subsection Options for the HTML/@LaTeX{} exporters +@subsection Options for the exporters @cindex options, for publishing -The property list can be used to set many export options for the HTML -and @LaTeX{} exporters. In most cases, these properties correspond to user -variables in Org. The table below lists these properties along -with the variable they belong to. See the documentation string for the -respective variable for details. +The property list can be used to set many export options for the exporters. +In most cases, these properties correspond to user variables in Org. The +first table below lists these properties along with the variable they belong +to. The second table list HTML specific properties. See the documentation +string of these options for details. -@vindex org-export-html-link-up -@vindex org-export-html-link-home -@vindex org-export-default-language @vindex org-display-custom-times -@vindex org-export-headline-levels -@vindex org-export-with-section-numbers -@vindex org-export-section-number-format -@vindex org-export-with-toc -@vindex org-export-preserve-breaks -@vindex org-export-with-archived-trees -@vindex org-export-with-emphasize -@vindex org-export-with-sub-superscripts -@vindex org-export-with-special-strings -@vindex org-export-with-footnotes -@vindex org-export-with-drawers -@vindex org-export-with-tags -@vindex org-export-with-todo-keywords -@vindex org-export-with-tasks -@vindex org-export-with-done-tasks -@vindex org-export-with-priority -@vindex org-export-with-TeX-macros -@vindex org-export-with-LaTeX-fragments -@vindex org-export-skip-text-before-1st-heading -@vindex org-export-with-fixed-width -@vindex org-export-with-timestamps -@vindex org-export-author-info -@vindex org-export-email-info -@vindex org-export-creator-info -@vindex org-export-time-stamp-file -@vindex org-export-with-tables -@vindex org-export-highlight-first-table-line -@vindex org-export-html-style-include-default -@vindex org-export-html-style-include-scripts -@vindex org-export-html-style -@vindex org-export-html-style-extra -@vindex org-export-html-link-org-files-as-html -@vindex org-export-html-inline-images -@vindex org-export-html-extension -@vindex org-export-html-table-tag -@vindex org-export-html-expand -@vindex org-export-html-with-timestamp -@vindex org-export-publishing-directory -@vindex org-export-html-preamble -@vindex org-export-html-postamble -@vindex user-full-name -@vindex user-mail-address -@vindex org-export-select-tags +@vindex org-export-default-language @vindex org-export-exclude-tags +@vindex org-export-headline-levels +@vindex org-export-preserve-breaks +@vindex org-export-publishing-directory +@vindex org-export-select-tags +@vindex org-export-with-archived-trees +@vindex org-export-with-author +@vindex org-export-with-creator +@vindex org-export-with-drawers +@vindex org-export-with-email +@vindex org-export-with-emphasize +@vindex org-export-with-fixed-width +@vindex org-export-with-footnotes +@vindex org-export-with-latex +@vindex org-export-with-planning +@vindex org-export-with-priority +@vindex org-export-with-section-numbers +@vindex org-export-with-special-strings +@vindex org-export-with-sub-superscripts +@vindex org-export-with-tables +@vindex org-export-with-tags +@vindex org-export-with-tasks +@vindex org-export-with-timestamps +@vindex org-export-with-toc +@vindex org-export-with-todo-keywords +@vindex user-mail-address @multitable @columnfractions 0.32 0.68 -@item @code{:link-up} @tab @code{org-export-html-link-up} -@item @code{:link-home} @tab @code{org-export-html-link-home} -@item @code{:language} @tab @code{org-export-default-language} -@item @code{:customtime} @tab @code{org-display-custom-times} -@item @code{:headline-levels} @tab @code{org-export-headline-levels} -@item @code{:section-numbers} @tab @code{org-export-with-section-numbers} -@item @code{:section-number-format} @tab @code{org-export-section-number-format} -@item @code{:table-of-contents} @tab @code{org-export-with-toc} -@item @code{:preserve-breaks} @tab @code{org-export-preserve-breaks} -@item @code{:archived-trees} @tab @code{org-export-with-archived-trees} -@item @code{:emphasize} @tab @code{org-export-with-emphasize} -@item @code{:sub-superscript} @tab @code{org-export-with-sub-superscripts} -@item @code{:special-strings} @tab @code{org-export-with-special-strings} -@item @code{:footnotes} @tab @code{org-export-with-footnotes} -@item @code{:drawers} @tab @code{org-export-with-drawers} -@item @code{:tags} @tab @code{org-export-with-tags} -@item @code{:todo-keywords} @tab @code{org-export-with-todo-keywords} -@item @code{:tasks} @tab @code{org-export-with-tasks} -@item @code{:priority} @tab @code{org-export-with-priority} -@item @code{:TeX-macros} @tab @code{org-export-with-TeX-macros} -@item @code{:LaTeX-fragments} @tab @code{org-export-with-LaTeX-fragments} -@item @code{:latex-listings} @tab @code{org-export-latex-listings} -@item @code{:skip-before-1st-heading} @tab @code{org-export-skip-text-before-1st-heading} -@item @code{:fixed-width} @tab @code{org-export-with-fixed-width} -@item @code{:timestamps} @tab @code{org-export-with-timestamps} -@item @code{:author} @tab @code{user-full-name} -@item @code{:email} @tab @code{user-mail-address} : @code{addr;addr;..} -@item @code{:author-info} @tab @code{org-export-author-info} -@item @code{:email-info} @tab @code{org-export-email-info} -@item @code{:creator-info} @tab @code{org-export-creator-info} -@item @code{:tables} @tab @code{org-export-with-tables} -@item @code{:table-auto-headline} @tab @code{org-export-highlight-first-table-line} -@item @code{:style-include-default} @tab @code{org-export-html-style-include-default} -@item @code{:style-include-scripts} @tab @code{org-export-html-style-include-scripts} -@item @code{:style} @tab @code{org-export-html-style} -@item @code{:style-extra} @tab @code{org-export-html-style-extra} -@item @code{:convert-org-links} @tab @code{org-export-html-link-org-files-as-html} -@item @code{:inline-images} @tab @code{org-export-html-inline-images} -@item @code{:html-extension} @tab @code{org-export-html-extension} -@item @code{:html-preamble} @tab @code{org-export-html-preamble} -@item @code{:html-postamble} @tab @code{org-export-html-postamble} -@item @code{:xml-declaration} @tab @code{org-export-html-xml-declaration} -@item @code{:html-table-tag} @tab @code{org-export-html-table-tag} -@item @code{:expand-quoted-html} @tab @code{org-export-html-expand} -@item @code{:timestamp} @tab @code{org-export-html-with-timestamp} -@item @code{:publishing-directory} @tab @code{org-export-publishing-directory} -@item @code{:select-tags} @tab @code{org-export-select-tags} -@item @code{:exclude-tags} @tab @code{org-export-exclude-tags} -@item @code{:latex-image-options} @tab @code{org-export-latex-image-default-option} +@item @code{:archived-trees} @tab @var{org-export-with-archived-trees} +@item @code{:exclude-tags} @tab @var{org-export-exclude-tags} +@item @code{:headline-levels} @tab @var{org-export-headline-levels} +@item @code{:language} @tab @var{org-export-default-language} +@item @code{:preserve-breaks} @tab @var{org-export-preserve-breaks} +@item @code{:publishing-directory} @tab @var{org-export-publishing-directory} +@item @code{:section-numbers} @tab @var{org-export-with-section-numbers} +@item @code{:select-tags} @tab @var{org-export-select-tags} +@item @code{:with-author} @tab @var{org-export-with-author} +@item @code{:with-creator} @tab @var{org-export-with-creator} +@item @code{:with-drawers} @tab @var{org-export-with-drawers} +@item @code{:with-email} @tab @var{org-export-with-email} +@item @code{:with-emphasize} @tab @var{org-export-with-emphasize} +@item @code{:with-fixed-width} @tab @var{org-export-with-fixed-width} +@item @code{:with-footnotes} @tab @var{org-export-with-footnotes} +@item @code{:with-latex} @tab @var{org-export-with-latex} +@item @code{:with-planning} @tab @var{org-export-with-planning} +@item @code{:with-priority} @tab @var{org-export-with-priority} +@item @code{:with-special-strings} @tab @var{org-export-with-special-strings} +@item @code{:with-sub-superscript} @tab @var{org-export-with-sub-superscripts} +@item @code{:with-tables} @tab @var{org-export-with-tables} +@item @code{:with-tags} @tab @var{org-export-with-tags} +@item @code{:with-tasks} @tab @var{org-export-with-tasks} +@item @code{:with-timestamps} @tab @var{org-export-with-timestamps} +@item @code{:with-toc} @tab @var{org-export-with-toc} +@item @code{:with-todo-keywords} @tab @var{org-export-with-todo-keywords} @end multitable -Most of the @code{org-export-with-*} variables have the same effect in -both HTML and @LaTeX{} exporters, except for @code{:TeX-macros} and -@code{:LaTeX-fragments} options, respectively @code{nil} and @code{t} in the -@LaTeX{} export. See @code{org-export-plist-vars} to check this list of -options. - +@vindex org-html-doctype +@vindex org-html-xml-declaration +@vindex org-html-link-up +@vindex org-html-link-home +@vindex org-html-link-org-files-as-html +@vindex org-html-head +@vindex org-html-head-extra +@vindex org-html-inline-images +@vindex org-html-extension +@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 +@multitable @columnfractions 0.32 0.68 +@item @code{:html-doctype} @tab @var{org-html-doctype} +@item @code{:html-xml-declaration} @tab @var{org-html-xml-declaration} +@item @code{:html-link-up} @tab @var{org-html-link-up} +@item @code{:html-link-home} @tab @var{org-html-link-home} +@item @code{:html-link-org-as-html} @tab @var{org-html-link-org-files-as-html} +@item @code{:html-head} @tab @var{org-html-head} +@item @code{:html-head-extra} @tab @var{org-html-head-extra} +@item @code{:html-inline-images} @tab @var{org-html-inline-images} +@item @code{:html-extension} @tab @var{org-html-extension} +@item @code{:html-preamble} @tab @var{org-html-preamble} +@item @code{:html-postamble} @tab @var{org-html-postamble} +@item @code{:html-table-attributes} @tab @var{org-html-table-default-attributes} +@item @code{:html-head-include-default-style} @tab @var{org-html-style-include-default} +@item @code{:html-head-include-scripts} @tab @var{org-html-style-include-scripts} +@end multitable +Most of the @code{org-export-with-*} variables have the same effect in each +exporter. @vindex org-publish-project-alist -When a property is given a value in @code{org-publish-project-alist}, -its setting overrides the value of the corresponding user variable (if -any) during publishing. Options set within a file (@pxref{Export -options}), however, override everything. +When a property is given a value in @var{org-publish-project-alist}, its +setting overrides the value of the corresponding user variable (if any) +during publishing. Options set within a file (@pxref{Export settings}), +however, override everything. @node Publishing links, Sitemap, Publishing options, Configuration @subsection Links between published files @cindex links, publishing -To create a link from one Org file to another, you would use -something like @samp{[[file:foo.org][The foo]]} or simply -@samp{file:foo.org.} (@pxref{Hyperlinks}). When published, this link -becomes a link to @file{foo.html}. In this way, you can interlink the -pages of your "org web" project and the links will work as expected when -you publish them to HTML@. If you also publish the Org source file and want -to link to that, use an @code{http:} link instead of a @code{file:} link, -because @code{file:} links are converted to link to the corresponding -@file{html} file. +To create a link from one Org file to another, you would use something like +@samp{[[file:foo.org][The foo]]} or simply @samp{file:foo.org.} +(@pxref{Hyperlinks}). When published, this link becomes a link to +@file{foo.html}. You can thus interlink the pages of your "org web" project +and the links will work as expected when you publish them to HTML@. If you +also publish the Org source file and want to link to it, use an @code{http:} +link instead of a @code{file:} link, because @code{file:} links are converted +to link to the corresponding @file{html} file. You may also link to related files, such as images. Provided you are careful with relative file names, and provided you have also configured Org to upload the related files, these links will work too. See @ref{Complex example}, for an example of this usage. -Sometimes an Org file to be published may contain links that are -only valid in your production environment, but not in the publishing -location. In this case, use the property - -@multitable @columnfractions 0.4 0.6 -@item @code{:link-validation-function} -@tab Function to validate links -@end multitable - -@noindent -to define a function for checking link validity. This function must -accept two arguments, the file name and a directory relative to which -the file name is interpreted in the production environment. If this -function returns @code{nil}, then the HTML generator will only insert a -description into the HTML file, but no link. One option for this -function is @code{org-publish-validate-link} which checks if the given -file is part of any project in @code{org-publish-project-alist}. - @node Sitemap, Generating an index, Publishing links, Configuration @subsection Generating a sitemap @cindex sitemap, of published pages @@ -12481,7 +13193,7 @@ a map of files for a given project. @multitable @columnfractions 0.35 0.65 @item @code{:auto-sitemap} -@tab When non-nil, publish a sitemap during @code{org-publish-current-project} +@tab When non-@code{nil}, publish a sitemap during @code{org-publish-current-project} or @code{org-publish-all}. @item @code{:sitemap-filename} @@ -12523,10 +13235,10 @@ for the title of the file, @code{%a} stands for the author of the file and @item @code{:sitemap-date-format} @tab Format string for the @code{format-time-string} function that tells how a sitemap entry's date is to be formatted. This property bypasses -@code{org-publish-sitemap-date-format} which defaults to @code{%Y-%m-%d}. +@var{org-publish-sitemap-date-format} which defaults to @code{%Y-%m-%d}. @item @code{:sitemap-sans-extension} -@tab When non-nil, remove filenames' extensions from the generated sitemap. +@tab When non-@code{nil}, remove filenames' extensions from the generated sitemap. Useful to have cool URIs (see @uref{http://www.w3.org/Provider/Style/URI}). Defaults to @code{nil}. @@ -12540,7 +13252,7 @@ Org mode can generate an index across the files of a publishing project. @multitable @columnfractions 0.25 0.75 @item @code{:makeindex} -@tab When non-nil, generate in index in the file @file{theindex.org} and +@tab When non-@code{nil}, generate in index in the file @file{theindex.org} and publish it as @file{theindex.html}. @end multitable @@ -12577,7 +13289,7 @@ tool syncs them. Publishing to a local directory is also much faster than to a remote one, so that you can afford more easily to republish entire projects. If you set -@code{org-publish-use-timestamps-flag} to @code{nil}, you gain the main +@var{org-publish-use-timestamps-flag} to @code{nil}, you gain the main benefit of re-including any changed external files such as source example files you might include with @code{#+INCLUDE:}. The timestamp mechanism in Org is not smart enough to detect if included files have been modified. @@ -12606,10 +13318,10 @@ directory on the local machine. :base-directory "~/org/" :publishing-directory "~/public_html" :section-numbers nil - :table-of-contents nil - :style ""))) + :with-toc nil + :html-head ""))) @end lisp @node Complex example, , Simple example, Sample configuration @@ -12639,12 +13351,12 @@ right place on the web server, and publishing images to it. :base-directory "~/org/" :base-extension "org" :publishing-directory "/ssh:user@@host:~/html/notebook/" - :publishing-function org-publish-org-to-html + :publishing-function org-html-publish-to-html :exclude "PrivatePage.org" ;; regexp :headline-levels 3 :section-numbers nil - :table-of-contents nil - :style "" :html-preamble t) @@ -12668,13 +13380,13 @@ right place on the web server, and publishing images to it. Once properly configured, Org can publish with the following commands: @table @kbd -@orgcmd{C-c C-e X,org-publish} +@orgcmd{C-c C-e P x,org-publish} Prompt for a specific project and publish all files that belong to it. -@orgcmd{C-c C-e P,org-publish-current-project} +@orgcmd{C-c C-e P p,org-publish-current-project} Publish the project containing the current file. -@orgcmd{C-c C-e F,org-publish-current-file} +@orgcmd{C-c C-e P f,org-publish-current-file} Publish only the current file. -@orgcmd{C-c C-e E,org-publish-all} +@orgcmd{C-c C-e P a,org-publish-all} Publish every project. @end table @@ -12682,7 +13394,7 @@ Publish every project. Org uses timestamps to track when a file has changed. The above functions normally only publish changed files. You can override this and force publishing of all files by giving a prefix argument to any of the commands -above, or by customizing the variable @code{org-publish-use-timestamps-flag}. +above, or by customizing the variable @var{org-publish-use-timestamps-flag}. This may be necessary in particular if files include other files via @code{#+SETUPFILE:} or @code{#+INCLUDE:}. @@ -12771,7 +13483,7 @@ src_[
    ]@{@} @table @code @item <#+NAME: name> This line associates a name with the code block. This is similar to the -@code{#+TBLNAME: NAME} lines that can be used to name tables in Org mode +@code{#+NAME: Name} lines that can be used to name tables in Org mode files. Referencing the name of a code block makes it possible to evaluate the block from other places in the file, from other files, or from Org mode table formulas (see @ref{The spreadsheet}). Names are assumed to be unique @@ -12803,11 +13515,16 @@ Source code in the specified language. @cindex code block, editing @cindex source code, editing +@vindex org-edit-src-auto-save-idle-delay +@vindex org-edit-src-turn-on-auto-save @kindex C-c ' -Use @kbd{C-c '} to edit the current code block. This brings up -a language major-mode edit buffer containing the body of the code -block. Saving this buffer will write the new contents back to the Org -buffer. Use @kbd{C-c '} again to exit. +Use @kbd{C-c '} to edit the current code block. This brings up a language +major-mode edit buffer containing the body of the code block. Manually +saving this buffer with @key{C-x C-s} will write the contents back to the Org +buffer. You can also set @var{org-edit-src-auto-save-idle-delay} to save the +base buffer after some idle delay, or @code{org-edit-src-turn-on-auto-save} +to auto-save this buffer into a separate file using @code{auto-save-mode}. +Use @kbd{C-c '} again to exit. The @code{org-src-mode} minor mode will be active in the edit buffer. The following variables can be used to configure the behavior of the edit @@ -12827,11 +13544,11 @@ This variable is especially useful for tangling languages such as Python, in which whitespace indentation in the output is critical. @item org-src-ask-before-returning-to-edit-buffer By default, Org will ask before returning to an open edit buffer. Set this -variable to nil to switch without asking. +variable to @code{nil} to switch without asking. @end table To turn on native code fontification in the @emph{Org} buffer, configure the -variable @code{org-src-fontify-natively}. +variable @var{org-src-fontify-natively}. @comment node-name, next, previous, up @comment Exporting code blocks, Extracting source code, Editing source code, Working With Source Code @@ -12852,6 +13569,7 @@ The @code{:exports} header argument can be used to specify export behavior: @subsubheading Header arguments: + @table @code @item :exports code The default in most languages. The body of the code block is exported, as @@ -12869,11 +13587,16 @@ Neither the code block nor its results will be exported. @end table It is possible to inhibit the evaluation of code blocks during export. -Setting the @code{org-export-babel-evaluate} variable to @code{nil} will +Setting the @var{org-export-babel-evaluate} variable to @code{nil} will ensure that no code blocks are evaluated as part of the export process. This can be useful in situations where potentially untrusted Org mode files are exported in an automated fashion, for example when Org mode is used as the -markup language for a wiki. +markup language for a wiki. It is also possible to set this variable to +@code{‘inline-only}. In that case, only inline code blocks will be +evaluated, in order to insert their results. Non-inline code blocks are +assumed to have their results already inserted in the buffer by manual +evaluation. This setting is useful to avoid expensive recalculations during +export, not to provide security. @comment node-name, next, previous, up @comment Extracting source code, Evaluating code blocks, Exporting code blocks, Working With Source Code @@ -12890,6 +13613,7 @@ using @code{org-babel-expand-src-block} which can expand both variable and ``noweb'' style references (see @ref{Noweb reference syntax}). @subsubheading Header arguments + @table @code @item :tangle no The default. The code block is not included in the tangled output. @@ -12903,14 +13627,18 @@ Include the code block in the tangled output to file @samp{filename}. @kindex C-c C-v t @subsubheading Functions + @table @code @item org-babel-tangle Tangle the current file. Bound to @kbd{C-c C-v t}. + +With prefix argument only tangle the current code block. @item org-babel-tangle-file Choose a file to tangle. Bound to @kbd{C-c C-v f}. @end table @subsubheading Hooks + @table @code @item org-babel-post-tangle-hook This hook is run from within code files tangled by @code{org-babel-tangle}. @@ -12933,7 +13661,7 @@ Org mode buffer. The results of evaluation are placed following a line that begins by default with @code{#+RESULTS} and optionally a cache identifier and/or the name of the evaluated code block. The default value of @code{#+RESULTS} can be changed with the customizable variable -@code{org-babel-results-keyword}. +@var{org-babel-results-keyword}. By default, the evaluation facility is only enabled for Lisp code blocks specified as @code{emacs-lisp}. However, source code blocks in many languages @@ -12944,7 +13672,7 @@ used to define a code block). @kindex C-c C-c There are a number of ways to evaluate code blocks. The simplest is to press @kbd{C-c C-c} or @kbd{C-c C-v e} with the point on a code block@footnote{The -@code{org-babel-no-eval-on-ctrl-c-ctrl-c} variable can be used to remove code +option @var{org-babel-no-eval-on-ctrl-c-ctrl-c} can be used to remove code evaluation from the @kbd{C-c C-c} key binding.}. This will call the @code{org-babel-execute-src-block} function to evaluate the block and insert its results into the Org mode buffer. @@ -13055,10 +13783,10 @@ Language-specific documentation is available for some languages. If available, it can be found at @uref{http://orgmode.org/worg/org-contrib/babel/languages.html}. -The @code{org-babel-load-languages} controls which languages are enabled for -evaluation (by default only @code{emacs-lisp} is enabled). This variable can -be set using the customization interface or by adding code like the following -to your emacs configuration. +The option @code{org-babel-load-languages} controls which languages are +enabled for evaluation (by default only @code{emacs-lisp} is enabled). This +variable can be set using the customization interface or by adding code like +the following to your emacs configuration. @quotation The following disables @code{emacs-lisp} evaluation and enables evaluation of @@ -13115,8 +13843,8 @@ specific (and having higher priority) than the last. @node System-wide header arguments, Language-specific header arguments, Using header arguments, Using header arguments @subsubheading System-wide header arguments @vindex org-babel-default-header-args -System-wide values of header arguments can be specified by customizing the -@code{org-babel-default-header-args} variable: +System-wide values of header arguments can be specified by adapting the +@var{org-babel-default-header-args} variable: @example :session => "none" @@ -13126,20 +13854,6 @@ System-wide values of header arguments can be specified by customizing the :noweb => "no" @end example -@c @example -@c org-babel-default-header-args is a variable defined in `org-babel.el'. -@c Its value is -@c ((:session . "none") -@c (:results . "replace") -@c (:exports . "code") -@c (:cache . "no") -@c (:noweb . "no")) - - -@c Documentation: -@c Default arguments to use when evaluating a code block. -@c @end example - For example, the following example could be used to set the default value of @code{:noweb} header arguments to @code{yes}. This would have the effect of expanding @code{:noweb} references by default when evaluating source code @@ -13148,7 +13862,7 @@ blocks. @lisp (setq org-babel-default-header-args (cons '(:noweb . "yes") - (assq-delete-all :noweb org-babel-default-header-args))) + (assq-delete-all :noweb org-babel-default-header-args))) @end lisp @node Language-specific header arguments, Buffer-wide header arguments, System-wide header arguments, Using header arguments @@ -13187,7 +13901,7 @@ of setting a header argument for all code blocks in a buffer is @vindex org-use-property-inheritance When properties are used to set default header arguments, they are looked up with inheritance, regardless of the value of -@code{org-use-property-inheritance}. In the following example the value of +@var{org-use-property-inheritance}. In the following example the value of the @code{:cache} header argument will default to @code{yes} in all code blocks in the subtree rooted at the following heading: @@ -13201,7 +13915,7 @@ blocks in the subtree rooted at the following heading: @kindex C-c C-x p @vindex org-babel-default-header-args Properties defined in this way override the properties set in -@code{org-babel-default-header-args}. It is convenient to use the +@var{org-babel-default-header-args}. It is convenient to use the @code{org-set-property} function bound to @kbd{C-c C-x p} to set properties in Org mode documents. @@ -13212,7 +13926,7 @@ The most common way to assign values to header arguments is at the code block level. This can be done by listing a sequence of header arguments and their values as part of the @code{#+BEGIN_SRC} line. Properties set in this way override both the values of -@code{org-babel-default-header-args} and header arguments specified as +@var{org-babel-default-header-args} and header arguments specified as properties. In the following example, the @code{:results} header argument is set to @code{silent}, meaning the results of execution will not be inserted in the buffer, and the @code{:exports} header argument is set to @@ -13321,6 +14035,7 @@ argument in lowercase letters. The following header arguments are defined: * shebang:: Make tangled files executable * eval:: Limit evaluation of specific code blocks * wrap:: Mark source block evaluation results +* post:: Post processing of code block results @end menu Additional header arguments are defined on a language-specific basis, see @@ -13335,11 +14050,13 @@ syntax used to specify arguments is the same across all languages. In every case, variables require a default value when they are declared. The values passed to arguments can either be literal values, references, or -Emacs Lisp code (see @ref{var, Emacs Lisp evaluation of variables}). References -include anything in the Org mode file that takes a @code{#+NAME:}, -@code{#+TBLNAME:}, or @code{#+RESULTS:} line. This includes tables, lists, -@code{#+BEGIN_EXAMPLE} blocks, other code blocks, and the results of other -code blocks. +Emacs Lisp code (see @ref{var, Emacs Lisp evaluation of variables}). +References include anything in the Org mode file that takes a @code{#+NAME:} +or @code{#+RESULTS:} line: tables, lists, @code{#+BEGIN_EXAMPLE} blocks, +other code blocks and the results of other code blocks. + +Note: When a reference is made to another code block, the referenced block +will be evaluated unless it has current cached results (see @ref{cache}). Argument values can be indexed in a manner similar to arrays (see @ref{var, Indexable variable values}). @@ -13361,10 +14078,10 @@ Here are examples of passing values by reference: @table @dfn @item table -an Org mode table named with either a @code{#+NAME:} or @code{#+TBLNAME:} line +an Org mode table named with either a @code{#+NAME:} line @example -#+TBLNAME: example-table +#+NAME: example-table | 1 | | 2 | | 3 | @@ -13457,19 +14174,6 @@ on two lines @end table -@subsubheading Alternate argument syntax -It is also possible to specify arguments in a potentially more natural way -using the @code{#+NAME:} line of a code block. As in the following -example, arguments can be packed inside of parentheses, separated by commas, -following the source name. - -@example -#+NAME: double(input=0, x=2) -#+BEGIN_SRC emacs-lisp -(* 2 (+ input x)) -#+END_SRC -@end example - @subsubheading Indexable variable values It is possible to reference portions of variable values by ``indexing'' into the variables. Indexes are 0 based with negative values counting back from @@ -13594,7 +14298,7 @@ Emacs Lisp, as shown in the following example. @node results, file, var, Specific header arguments @subsubsection @code{:results} -There are three classes of @code{:results} header argument. Only one option +There are four classes of @code{:results} header argument. Only one option per class may be supplied per code block. @itemize @bullet @@ -13603,6 +14307,10 @@ per class may be supplied per code block. from the code block @item @b{type} header arguments specify what type of result the code block will +return---which has implications for how they will be processed before +insertion into the Org mode buffer +@item +@b{format} header arguments specify what type of result the code block will return---which has implications for how they will be inserted into the Org mode buffer @item @@ -13648,6 +14356,15 @@ buffer as quoted text. E.g., @code{:results value verbatim}. @item @code{file} The results will be interpreted as the path to a file, and will be inserted into the Org mode buffer as a file link. E.g., @code{:results value file}. +@end itemize + +@subsubheading Format + +The following options are mutually exclusive and specify what type of results +the code block will return. By default, results are inserted according to the +type as specified above. + +@itemize @bullet @item @code{raw} The results are interpreted as raw Org mode code and are inserted directly into the buffer. If the results look like a table they will be aligned as @@ -13729,9 +14446,9 @@ While the @code{:file} header argument can be used to specify the path to the output file, @code{:dir} specifies the default directory during code block execution. If it is absent, then the directory associated with the current buffer is used. In other words, supplying @code{:dir path} temporarily has -the same effect as changing the current directory with @kbd{M-x cd path}, and +the same effect as changing the current directory with @kbd{M-x cd path RET}, and then not supplying @code{:dir}. Under the surface, @code{:dir} simply sets -the value of the Emacs variable @code{default-directory}. +the value of the Emacs variable @var{default-directory}. When using @code{:dir}, you should supply a relative path for file output (e.g., @code{:file myfile.jpg} or @code{:file results/myfile.jpg}) in which @@ -13769,7 +14486,7 @@ and a link of the following form will be inserted in the org buffer: @end example Most of this functionality follows immediately from the fact that @code{:dir} -sets the value of the Emacs variable @code{default-directory}, thanks to +sets the value of the Emacs variable @var{default-directory}, thanks to tramp. Those using XEmacs, or GNU Emacs prior to version 23 may need to install tramp separately in order for these features to work correctly. @@ -13784,8 +14501,8 @@ currently made to alter the directory associated with an existing session. @code{:dir} should typically not be used to create files during export with @code{:exports results} or @code{:exports both}. The reason is that, in order to retain portability of exported material between machines, during export -links inserted into the buffer will @emph{not} be expanded against @code{default -directory}. Therefore, if @code{default-directory} is altered using +links inserted into the buffer will @emph{not} be expanded against @var{default +directory}. Therefore, if @var{default-directory} is altered using @code{:dir}, it is probable that the file will be created in a location to which the link does not point. @end itemize @@ -13854,7 +14571,6 @@ original Org file from which the code was tangled. A synonym for ``link'' to maintain backwards compatibility. @item @code{org} Include text from the Org mode file as a comment. - The text is picked from the leading context of the tangled code and is limited by the nearest headline or source block as the case may be. @item @code{both} @@ -14086,7 +14802,7 @@ variable and raises an error. Setting @code{:hlines no} or relying on the default value yields the following results. @example -#+TBLNAME: many-cols +#+NAME: many-cols | a | b | c | |---+---+---| | d | e | f | @@ -14108,7 +14824,7 @@ default value yields the following results. Leaves hlines in the table. Setting @code{:hlines yes} has this effect. @example -#+TBLNAME: many-cols +#+NAME: many-cols | a | b | c | |---+---+---| | d | e | f | @@ -14135,9 +14851,7 @@ Leaves hlines in the table. Setting @code{:hlines yes} has this effect. The @code{:colnames} header argument accepts the values @code{yes}, @code{no}, or @code{nil} for unassigned. The default value is @code{nil}. Note that the behavior of the @code{:colnames} header argument may differ -across languages. For example Emacs Lisp code blocks ignore the -@code{:colnames} header argument entirely given the ease with which tables -with column names may be handled directly in Emacs Lisp. +across languages. @itemize @bullet @item @code{nil} @@ -14147,7 +14861,7 @@ names will be removed from the table before processing, then reapplied to the results. @example -#+TBLNAME: less-cols +#+NAME: less-cols | a | |---| | b | @@ -14180,8 +14894,10 @@ hline) @node rownames, shebang, colnames, Specific header arguments @subsubsection @code{:rownames} -The @code{:rownames} header argument can take on the values @code{yes} -or @code{no}, with a default value of @code{no}. +The @code{:rownames} header argument can take on the values @code{yes} or +@code{no}, with a default value of @code{no}. Note that Emacs Lisp code +blocks ignore the @code{:rownames} header argument entirely given the ease +with which tables with row names may be handled directly in Emacs Lisp. @itemize @bullet @item @code{no} @@ -14192,7 +14908,7 @@ The first column of the table is removed from the table before processing, and is then reapplied to the results. @example -#+TBLNAME: with-rownames +#+NAME: with-rownames | one | 1 | 2 | 3 | 4 | 5 | | two | 6 | 7 | 8 | 9 | 10 | @@ -14241,10 +14957,10 @@ Evaluation of the code block during export will require a query. @end table If this header argument is not set then evaluation is determined by the value -of the @code{org-confirm-babel-evaluate} variable see @ref{Code evaluation +of the @var{org-confirm-babel-evaluate} variable see @ref{Code evaluation security}. -@node wrap, , eval, Specific header arguments +@node wrap, post, eval, Specific header arguments @subsubsection @code{:wrap} The @code{:wrap} header argument is used to mark the results of source block evaluation. The header argument can be passed a string that will be appended @@ -14252,6 +14968,41 @@ to @code{#+BEGIN_} and @code{#+END_}, which will then be used to wrap the results. If not string is specified then the results will be wrapped in a @code{#+BEGIN/END_RESULTS} block. +@node post, , wrap, Specific header arguments +@subsubsection @code{:post} +The @code{:post} header argument is used to post-process the results of a +code block execution. When a post argument is given, the results of the code +block will temporarily be bound to the @code{*this*} variable. This variable +may then be included in header argument forms such as those used in @ref{var} +header argument specifications allowing passing of results to other code +blocks, or direct execution via Emacs Lisp. + +The following example illustrates the usage of the @code{:post} header +argument. + +@example +#+name: attr_wrap +#+begin_src sh :var data="" :var width="\\textwidth" :results output + echo "#+ATTR_LATEX :width $width" + echo "$data" +#+end_src + +#+header: :file /tmp/it.png +#+begin_src dot :post attr_wrap(width="5cm", data=*this*) :results drawer + digraph@{ + a -> b; + b -> c; + c -> a; + @} +#+end_src + +#+RESULTS: +:RESULTS: +#+ATTR_LATEX :width 5cm +[[file:/tmp/it.png]] +:END: +@end example + @node Results of evaluation, Noweb reference syntax, Header arguments, Working With Source Code @section Results of evaluation @cindex code block, results of evaluation @@ -14381,7 +15132,7 @@ syntactically valid in languages that you use, then please consider setting the default value. Note: if noweb tangling is slow in large Org mode files consider setting the -@code{*org-babel-use-quick-and-dirty-noweb-expansion*} variable to true. +@var{org-babel-use-quick-and-dirty-noweb-expansion} variable to @code{t}. This will result in faster noweb reference resolution at the expense of not correctly resolving inherited values of the @code{:noweb-ref} header argument. @@ -14564,8 +15315,8 @@ emacs -Q --batch \ Emacs would not be Emacs without completion, and Org mode uses it whenever it makes sense. If you prefer an @i{iswitchb}- or @i{ido}-like interface for some of the completion prompts, you can specify your preference by setting at -most one of the variables @code{org-completion-use-iswitchb} -@code{org-completion-use-ido}. +most one of the variables @var{org-completion-use-iswitchb} +@var{org-completion-use-ido}. Org supports in-buffer completion. This type of completion does not make use of the minibuffer. You simply type a few letters into @@ -14585,7 +15336,7 @@ After @samp{*}, complete headlines in the current buffer so that they can be used in search links like @samp{[[*find this headline]]}. @item After @samp{:} in a headline, complete tags. The list of tags is taken -from the variable @code{org-tag-alist} (possibly set through the +from the variable @var{org-tag-alist} (possibly set through the @samp{#+TAGS} in-buffer option, @pxref{Setting tags}), or it is created dynamically from all tags used in the current buffer. @item @@ -14655,9 +15406,9 @@ additional details. Single keys can be made to execute commands when the cursor is at the beginning of a headline, i.e., before the first star. Configure the variable -@code{org-use-speed-commands} to activate this feature. There is a +@var{org-use-speed-commands} to activate this feature. There is a pre-defined list of commands, and you can add more such commands using the -variable @code{org-speed-commands-user}. Speed keys do not only speed up +variable @var{org-speed-commands-user}. Speed keys do not only speed up navigation and other commands, but they also provide an alternative way to execute commands bound to keys that are not or not easily available on a TTY, or on a small mobile device with a limited keyboard. @@ -14695,19 +15446,19 @@ which take off the default security brakes. @defopt org-confirm-babel-evaluate When t (the default), the user is asked before every code block evaluation. -When nil, the user is not asked. When set to a function, it is called with +When @code{nil}, the user is not asked. When set to a function, it is called with two arguments (language and body of the code block) and should return t to -ask and nil not to ask. +ask and @code{nil} not to ask. @end defopt For example, here is how to execute "ditaa" code (which is considered safe) without asking: -@example +@lisp (defun my-org-confirm-babel-evaluate (lang body) (not (string= lang "ditaa"))) ; don't ask for ditaa (setq org-confirm-babel-evaluate 'my-org-confirm-babel-evaluate) -@end example +@end lisp @item Following @code{shell} and @code{elisp} links Org has two link types that can directly evaluate code (@pxref{External @@ -14735,7 +15486,7 @@ either by the @i{calc} interpreter, or by the @i{Emacs Lisp} interpreter. There are more than 500 variables that can be used to customize Org. For the sake of compactness of the manual, I am not describing the variables here. A structured overview of customization -variables is available with @kbd{M-x org-customize}. Or select +variables is available with @kbd{M-x org-customize RET}. Or select @code{Browse Org Group} from the @code{Org->Customization} menu. Many settings can also be activated on a per-file basis, by putting special lines into the buffer (@pxref{In-buffer settings}). @@ -14761,7 +15512,7 @@ when the file is visited again in a new Emacs session. This line sets the archive location for the agenda file. It applies for all subsequent lines until the next @samp{#+ARCHIVE} line, or the end of the file. The first such line also applies to any entries before it. -The corresponding variable is @code{org-archive-location}. +The corresponding variable is @var{org-archive-location}. @item #+CATEGORY: This line sets the category for the agenda file. The category applies for all subsequent lines until the next @samp{#+CATEGORY} line, or the @@ -14775,21 +15526,21 @@ applies. @vindex org-table-formula-constants @vindex org-table-formula Set file-local values for constants to be used in table formulas. This -line sets the local variable @code{org-table-formula-constants-local}. +line sets the local variable @var{org-table-formula-constants-local}. The global version of this variable is -@code{org-table-formula-constants}. +@var{org-table-formula-constants}. @item #+FILETAGS: :tag1:tag2:tag3: Set tags that can be inherited by any entry in the file, including the top-level entries. @item #+DRAWERS: NAME1 ..... @vindex org-drawers Set the file-local set of additional drawers. The corresponding global -variable is @code{org-drawers}. +variable is @var{org-drawers}. @item #+LINK: linkword replace @vindex org-link-abbrev-alist These lines (several are allowed) specify link abbreviations. @xref{Link abbreviations}. The corresponding variable is -@code{org-link-abbrev-alist}. +@var{org-link-abbrev-alist}. @item #+PRIORITIES: highest lowest default @vindex org-highest-priority @vindex org-lowest-priority @@ -14816,7 +15567,7 @@ Org file is being visited. The first set of options deals with the initial visibility of the outline tree. The corresponding variable for global default settings is -@code{org-startup-folded}, with a default value @code{t}, which means +@var{org-startup-folded}, with a default value @code{t}, which means @code{overview}. @vindex org-startup-folded @cindex @code{overview}, STARTUP keyword @@ -14843,7 +15594,7 @@ noindent @r{start with @code{org-indent-mode} turned off} @vindex org-startup-align-all-tables Then there are options for aligning tables upon visiting a file. This is useful in files containing narrowed table columns. The corresponding -variable is @code{org-startup-align-all-tables}, with a default value +variable is @var{org-startup-align-all-tables}, with a default value @code{nil}. @cindex @code{align}, STARTUP keyword @cindex @code{noalign}, STARTUP keyword @@ -14854,7 +15605,7 @@ noalign @r{don't align tables on startup} @vindex org-startup-with-inline-images When visiting a file, inline images can be automatically displayed. The -corresponding variable is @code{org-startup-with-inline-images}, with a +corresponding variable is @var{org-startup-with-inline-images}, with a default value @code{nil} to avoid delays when visiting a file. @cindex @code{inlineimages}, STARTUP keyword @cindex @code{noinlineimages}, STARTUP keyword @@ -14863,12 +15614,24 @@ inlineimages @r{show inline images} noinlineimages @r{don't show inline images on startup} @end example +@vindex org-startup-with-latex-preview +When visiting a file, @LaTeX{} fragments can be converted to images +automatically. The variable @var{org-startup-with-latex-preview} which +controls this behavior, is set to @code{nil} by default to avoid delays on +startup. +@cindex @code{latexpreview}, STARTUP keyword +@cindex @code{nolatexpreview}, STARTUP keyword +@example +latexpreview @r{preview @LaTeX{} fragments} +nolatexpreview @r{don't preview @LaTeX{} fragments} +@end example + @vindex org-log-done @vindex org-log-note-clock-out @vindex org-log-repeat Logging the closing and reopening of TODO items and clock intervals can be -configured using these options (see variables @code{org-log-done}, -@code{org-log-note-clock-out} and @code{org-log-repeat}) +configured using these options (see variables @var{org-log-done}, +@var{org-log-note-clock-out} and @var{org-log-repeat}) @cindex @code{logdone}, STARTUP keyword @cindex @code{lognotedone}, STARTUP keyword @cindex @code{nologdone}, STARTUP keyword @@ -14886,30 +15649,39 @@ configured using these options (see variables @code{org-log-done}, @cindex @code{logrefile}, STARTUP keyword @cindex @code{lognoterefile}, STARTUP keyword @cindex @code{nologrefile}, STARTUP keyword +@cindex @code{logdrawer}, STARTUP keyword +@cindex @code{nologdrawer}, STARTUP keyword +@cindex @code{logstatesreversed}, STARTUP keyword +@cindex @code{nologstatesreversed}, STARTUP keyword @example -logdone @r{record a timestamp when an item is marked DONE} -lognotedone @r{record timestamp and a note when DONE} -nologdone @r{don't record when items are marked DONE} -logrepeat @r{record a time when reinstating a repeating item} -lognoterepeat @r{record a note when reinstating a repeating item} -nologrepeat @r{do not record when reinstating repeating item} -lognoteclock-out @r{record a note when clocking out} -nolognoteclock-out @r{don't record a note when clocking out} -logreschedule @r{record a timestamp when scheduling time changes} -lognotereschedule @r{record a note when scheduling time changes} -nologreschedule @r{do not record when a scheduling date changes} -logredeadline @r{record a timestamp when deadline changes} -lognoteredeadline @r{record a note when deadline changes} -nologredeadline @r{do not record when a deadline date changes} -logrefile @r{record a timestamp when refiling} -lognoterefile @r{record a note when refiling} -nologrefile @r{do not record when refiling} +logdone @r{record a timestamp when an item is marked DONE} +lognotedone @r{record timestamp and a note when DONE} +nologdone @r{don't record when items are marked DONE} +logrepeat @r{record a time when reinstating a repeating item} +lognoterepeat @r{record a note when reinstating a repeating item} +nologrepeat @r{do not record when reinstating repeating item} +lognoteclock-out @r{record a note when clocking out} +nolognoteclock-out @r{don't record a note when clocking out} +logreschedule @r{record a timestamp when scheduling time changes} +lognotereschedule @r{record a note when scheduling time changes} +nologreschedule @r{do not record when a scheduling date changes} +logredeadline @r{record a timestamp when deadline changes} +lognoteredeadline @r{record a note when deadline changes} +nologredeadline @r{do not record when a deadline date changes} +logrefile @r{record a timestamp when refiling} +lognoterefile @r{record a note when refiling} +nologrefile @r{do not record when refiling} +logdrawer @r{store log into drawer} +nologdrawer @r{store log outside of drawer} +logstatesreversed @r{reverse the order of states notes} +nologstatesreversed @r{do not reverse the order of states notes} @end example + @vindex org-hide-leading-stars @vindex org-odd-levels-only Here are the options for hiding leading stars in outline headings, and for indenting outlines. The corresponding variables are -@code{org-hide-leading-stars} and @code{org-odd-levels-only}, both with a +@var{org-hide-leading-stars} and @var{org-odd-levels-only}, both with a default setting @code{nil} (meaning @code{showstars} and @code{oddeven}). @cindex @code{hidestars}, STARTUP keyword @cindex @code{showstars}, STARTUP keyword @@ -14923,30 +15695,33 @@ noindent @r{no virtual indentation according to outline level} odd @r{allow only odd outline levels (1,3,...)} oddeven @r{allow all outline levels} @end example + @vindex org-put-time-stamp-overlays @vindex org-time-stamp-overlay-formats To turn on custom format overlays over timestamps (variables -@code{org-put-time-stamp-overlays} and -@code{org-time-stamp-overlay-formats}), use +@var{org-put-time-stamp-overlays} and +@var{org-time-stamp-overlay-formats}), use @cindex @code{customtime}, STARTUP keyword @example customtime @r{overlay custom time format} @end example + @vindex constants-unit-system The following options influence the table spreadsheet (variable -@code{constants-unit-system}). +@var{constants-unit-system}). @cindex @code{constcgs}, STARTUP keyword @cindex @code{constSI}, STARTUP keyword @example constcgs @r{@file{constants.el} should use the c-g-s unit system} constSI @r{@file{constants.el} should use the SI unit system} @end example + @vindex org-footnote-define-inline @vindex org-footnote-auto-label @vindex org-footnote-auto-adjust To influence footnote settings, use the following keywords. The -corresponding variables are @code{org-footnote-define-inline}, -@code{org-footnote-auto-label}, and @code{org-footnote-auto-adjust}. +corresponding variables are @var{org-footnote-define-inline}, +@var{org-footnote-auto-label}, and @var{org-footnote-auto-adjust}. @cindex @code{fninline}, STARTUP keyword @cindex @code{nofninline}, STARTUP keyword @cindex @code{fnlocal}, STARTUP keyword @@ -14967,42 +15742,53 @@ fnplain @r{create @code{[1]}-like labels automatically} fnadjust @r{automatically renumber and sort footnotes} nofnadjust @r{do not renumber and sort automatically} @end example + @cindex org-hide-block-startup To hide blocks on startup, use these keywords. The corresponding variable is -@code{org-hide-block-startup}. +@var{org-hide-block-startup}. @cindex @code{hideblocks}, STARTUP keyword @cindex @code{nohideblocks}, STARTUP keyword @example hideblocks @r{Hide all begin/end blocks on startup} nohideblocks @r{Do not hide blocks on startup} @end example + @cindex org-pretty-entities The display of entities as UTF-8 characters is governed by the variable -@code{org-pretty-entities} and the keywords +@var{org-pretty-entities} and the keywords @cindex @code{entitiespretty}, STARTUP keyword @cindex @code{entitiesplain}, STARTUP keyword @example entitiespretty @r{Show entities as UTF-8 characters where possible} entitiesplain @r{Leave entities plain} @end example + @item #+TAGS: TAG1(c1) TAG2(c2) @vindex org-tag-alist These lines (several such lines are allowed) specify the valid tags in this file, and (potentially) the corresponding @emph{fast tag selection} -keys. The corresponding variable is @code{org-tag-alist}. +keys. The corresponding variable is @var{org-tag-alist}. +@cindex #+TBLFM @item #+TBLFM: This line contains the formulas for the table directly above the line. -@item #+TITLE:, #+AUTHOR:, #+EMAIL:, #+LANGUAGE:, #+TEXT:, #+DATE:, -@itemx #+OPTIONS:, #+BIND:, #+XSLT:, + +Table can have multiple lines containing @samp{#+TBLFM:}. Note +that only the first line of @samp{#+TBLFM:} will be applied when +you recalculate the table. For more details see @ref{Using +multiple #+TBLFM lines} in @ref{Editing and debugging formulas}. + +@item #+TITLE:, #+AUTHOR:, #+EMAIL:, #+LANGUAGE:, #+DATE:, +@itemx #+OPTIONS:, #+BIND:, @itemx #+DESCRIPTION:, #+KEYWORDS:, -@itemx #+LaTeX_HEADER:, #+STYLE:, #+LINK_UP:, #+LINK_HOME:, -@itemx #+EXPORT_SELECT_TAGS:, #+EXPORT_EXCLUDE_TAGS: +@itemx #+LaTeX_HEADER:, #+LaTeX_HEADER_EXTRA:, +@itemx #+HTML_HEAD:, #+HTML_HEAD_EXTRA:, #+HTML_LINK_UP:, #+HTML_LINK_HOME:, +@itemx #+SELECT_TAGS:, #+EXCLUDE_TAGS: These lines provide settings for exporting files. For more details see -@ref{Export options}. +@ref{Export settings}. @item #+TODO: #+SEQ_TODO: #+TYP_TODO: @vindex org-todo-keywords These lines set the TODO keywords and their interpretation in the -current file. The corresponding variable is @code{org-todo-keywords}. +current file. The corresponding variable is @var{org-todo-keywords}. @end table @node The very busy C-c C-c key, Clean view, In-buffer settings, Miscellaneous @@ -15043,7 +15829,7 @@ If the cursor is in a property line or at the start or end of a property drawer, offer property commands. @item If the cursor is at a footnote reference, go to the corresponding -definition, and vice versa. +definition, and @emph{vice versa}. @item If the cursor is on a statistics cookie, update it. @item @@ -15095,13 +15881,13 @@ property, such that @code{visual-line-mode} (or purely setting @code{word-wrap}) wraps long lines (including headlines) correctly indented. }. Also headlines are prefixed with additional stars, so that the amount of indentation shifts by two@footnote{See the variable -@code{org-indent-indentation-per-level}.} spaces per level. All headline +@var{org-indent-indentation-per-level}.} spaces per level. All headline stars but the last one are made invisible using the @code{org-hide} face@footnote{Turning on @code{org-indent-mode} sets -@code{org-hide-leading-stars} to @code{t} and @code{org-adapt-indentation} to +@var{org-hide-leading-stars} to @code{t} and @var{org-adapt-indentation} to @code{nil}.}; see below under @samp{2.} for more information on how this works. You can turn on @code{org-indent-mode} for all files by customizing -the variable @code{org-startup-indented}, or you can turn it on for +the variable @var{org-startup-indented}, or you can turn it on for individual files using @example @@ -15126,14 +15912,14 @@ with the headline, like @vindex org-adapt-indentation Org supports this with paragraph filling, line wrapping, and structure -editing@footnote{See also the variable @code{org-adapt-indentation}.}, +editing@footnote{See also the variable @var{org-adapt-indentation}.}, preserving or adapting the indentation as appropriate. @item @vindex org-hide-leading-stars @emph{Hiding leading stars}@* You can modify the display in such a way that all leading stars become invisible. To do this in a global way, configure -the variable @code{org-hide-leading-stars} or change this on a per-file basis +the variable @var{org-hide-leading-stars} or change this on a per-file basis with @example @@ -15169,7 +15955,7 @@ to the next@footnote{When you need to specify a level for a property search or refile targets, @samp{LEVEL=2} will correspond to 3 stars, etc.}. In this way we get the outline view shown at the beginning of this section. In order to make the structure editing and export commands handle this convention -correctly, configure the variable @code{org-odd-levels-only}, or set this on +correctly, configure the variable @var{org-odd-levels-only}, or set this on a per-file basis with one of the following lines: @example @@ -15254,7 +16040,7 @@ packages is using Calc for embedded calculations. @xref{Embedded Mode, @vindex org-table-formula-constants In a table formula (@pxref{The spreadsheet}), it is possible to use names for natural constants or units. Instead of defining your own -constants in the variable @code{org-table-formula-constants}, install +constants in the variable @var{org-table-formula-constants}, install the @file{constants} package which defines a large number of constants and units, and lets you use unit prefixes like @samp{M} for @samp{Mega}, etc. You will need version 2.0 of this package, available @@ -15277,7 +16063,7 @@ supports Imenu---all you need to do to get the index is the following: @end lisp @vindex org-imenu-depth By default the index is two levels deep---you can modify the depth using -the option @code{org-imenu-depth}. +the option @var{org-imenu-depth}. @item @file{remember.el} by John Wiegley @cindex @file{remember.el} @cindex Wiegley, John @@ -15338,7 +16124,7 @@ This conflicts with the use of @kbd{S-@key{cursor}} commands in Org to change timestamps, TODO keywords, priorities, and item bullet types if the cursor is at such a location. By default, @kbd{S-@key{cursor}} commands outside special contexts don't do anything, but you can customize the variable -@code{org-support-shift-select}. Org mode then tries to accommodate shift +@var{org-support-shift-select}. Org mode then tries to accommodate shift selection by (i) using it outside of the special contexts where special commands apply, and by (ii) extending an existing active region even if the cursor moves across a special context. @@ -15353,7 +16139,7 @@ region. In fact, Emacs 23 has this built-in in the form of @code{shift-selection-mode}, see previous paragraph. If you are using Emacs 23, you probably don't want to use another package for this purpose. However, if you prefer to leave these keys to a different package while working in -Org mode, configure the variable @code{org-replace-disputed-keys}. When set, +Org mode, configure the variable @var{org-replace-disputed-keys}. When set, Org will move the following key bindings in Org files, and in the agenda buffer (but not during date selection). @@ -15366,7 +16152,7 @@ C-S-LEFT @result{} M-S-- C-S-RIGHT @result{} M-S-+ @vindex org-disputed-keys Yes, these are unfortunately more difficult to remember. If you want to have other replacement keys, look at the variable -@code{org-disputed-keys}. +@var{org-disputed-keys}. @item @file{filladapt.el} by Kyle Jones @cindex @file{filladapt.el} @@ -15382,7 +16168,7 @@ this: @item @file{yasnippet.el} @cindex @file{yasnippet.el} -The way Org mode binds the TAB key (binding to @code{[tab]} instead of +The way Org mode binds the @key{TAB} key (binding to @code{[tab]} instead of @code{"\t"}) overrules YASnippet's access to this key. The following code fixed this problem: @@ -15407,10 +16193,10 @@ Then, tell Org mode what to do with the new function: @lisp (add-hook 'org-mode-hook (lambda () - (make-variable-buffer-local 'yas/trigger-key) - (setq yas/trigger-key [tab]) - (add-to-list 'org-tab-first-hook 'yas/org-very-safe-expand) - (define-key yas/keymap [tab] 'yas/next-field))) + (make-variable-buffer-local 'yas/trigger-key) + (setq yas/trigger-key [tab]) + (add-to-list 'org-tab-first-hook 'yas/org-very-safe-expand) + (define-key yas/keymap [tab] 'yas/next-field))) @end lisp @item @file{windmove.el} by Hovav Shacham @@ -15435,7 +16221,7 @@ configuration: Viper uses @kbd{C-c /} and therefore makes this key not access the corresponding Org mode command @code{org-sparse-tree}. You need to find another key for this command, or override the key in -@code{viper-vi-global-user-map} with +@var{viper-vi-global-user-map} with @lisp (define-key viper-vi-global-user-map "C-c /" 'org-sparse-tree) @@ -15454,12 +16240,12 @@ files. Any text below a headline that has a @samp{:crypt:} tag will be automatically be encrypted when the file is saved. If you want to use a different tag just -customize the @code{org-crypt-tag-matcher} setting. +customize the @var{org-crypt-tag-matcher} setting. To use org-crypt it is suggested that you have the following in your @file{.emacs}: -@example +@lisp (require 'org-crypt) (org-crypt-use-before-save-magic) (setq org-tags-exclude-from-inheritance (quote ("crypt"))) @@ -15477,7 +16263,7 @@ To use org-crypt it is suggested that you have the following in your ;; To turn it off only locally, you can insert this: ;; ;; # -*- buffer-auto-save-file-name: nil; -*- -@end example +@end lisp Excluding the crypt tag from inheritance prevents already encrypted text being encrypted again. @@ -15493,11 +16279,13 @@ Org. * Hooks:: How to reach into Org's internals * Add-on packages:: Available extensions * Adding hyperlink types:: New custom link types +* Adding export back-ends:: How to write new export back-ends * Context-sensitive commands:: How to add functionality to such commands * Tables in arbitrary syntax:: Orgtbl for @LaTeX{} and other programs * Dynamic blocks:: Automatically filled blocks * Special agenda views:: Customized views -* Extracting agenda information:: Postprocessing of agenda information +* Speeding up your agendas:: Tips on how to speed up your agendas +* Extracting agenda information:: Post-processing of agenda information * Using the property API:: Writing programs that use entry properties * Using the mapping API:: Mapping over all or selected entries @end menu @@ -15517,15 +16305,14 @@ maintained by the Worg project and can be found at @cindex add-on packages A large number of add-on packages have been written by various authors. + These packages are not part of Emacs, but they are distributed as contributed -packages with the separate release available at the Org mode home page at -@uref{http://orgmode.org}. The list of contributed packages, along with -documentation about each package, is maintained by the Worg project at +packages with the separate release available at @uref{http://orgmode.org}. +See the @file{contrib/README} file in the source code directory for a list of +contributed files. You may also find some more information on the Worg page: @uref{http://orgmode.org/worg/org-contrib/}. - - -@node Adding hyperlink types, Context-sensitive commands, Add-on packages, Hacking +@node Adding hyperlink types, Adding export back-ends, Add-on packages, Hacking @section Adding hyperlink types @cindex hyperlinks, adding new types @@ -15592,12 +16379,12 @@ Let's go through the file and see what it does. It does @code{(require 'org)} to make sure that @file{org.el} has been loaded. @item -The next line calls @code{org-add-link-type} to define a new link type +The next line calls @var{org-add-link-type} to define a new link type with prefix @samp{man}. The call also contains the name of a function that will be called to follow such a link. @item @vindex org-store-link-functions -The next line adds a function to @code{org-store-link-functions}, in +The next line adds a function to @var{org-store-link-functions}, in order to allow the command @kbd{C-c l} to record a useful link in a buffer displaying a man page. @end enumerate @@ -15608,16 +16395,16 @@ command should be used to display man pages. There are two options, @code{man} and @code{woman}. Then the function to follow a link is defined. It gets the link path as an argument---in this case the link path is just a topic for the manual command. The function calls the -value of @code{org-man-command} to display the man page. +value of @var{org-man-command} to display the man page. Finally the function @code{org-man-store-link} is defined. When you try to store a link with @kbd{C-c l}, this function will be called to try to make a link. The function must first decide if it is supposed to create the link for this buffer type; we do this by checking the value -of the variable @code{major-mode}. If not, the function must exit and +of the variable @var{major-mode}. If not, the function must exit and return the value @code{nil}. If yes, the link is created by getting the manual topic from the buffer name and prefixing it with the string -@samp{man:}. Then it must call the command @code{org-store-link-props} +@samp{man:}. Then it must call the command @var{org-store-link-props} and set the @code{:type} and @code{:link} properties. Optionally you can also set the @code{:description} property to provide a default for the link description when the link is later inserted into an Org @@ -15628,7 +16415,37 @@ When it makes sense for your new link type, you may also define a function support for inserting such a link with @kbd{C-c C-l}. Such a function should not accept any arguments, and return the full link with prefix. -@node Context-sensitive commands, Tables in arbitrary syntax, Adding hyperlink types, Hacking +@node Adding export back-ends, Context-sensitive commands, Adding hyperlink types, Hacking +@section Adding export back-ends +@cindex Export, writing back-ends + +Org 8.0 comes with a completely rewritten export engine which makes it easy +to write new export back-ends, either from scratch, or from deriving them +from existing ones. + +Your two entry points are respectively @code{org-export-define-backend} and +@code{org-export-define-derived-backend}. To grok these functions, you +should first have a look at @file{ox-latex.el} (for how to define a new +back-end from scratch) and @file{ox-beamer.el} (for how to derive a new +back-end from an existing one. + +When creating a new back-end from scratch, the basic idea is to set the name +of the back-end (as a symbol) and an an alist of elements and export +functions. On top of this, you will need to set additional keywords like +@code{:menu-entry} (to display the back-end in the export dispatcher), +@code{:export-block} (to specify what blocks should not be exported by this +back-end), and @code{:options-alist} (to let the user set export options that +are specific to this back-end.) + +Deriving a new back-end is similar, except that you need to set +@code{:translate-alist} to an alist of export functions that should be used +instead of the parent back-end functions. + +For a complete reference documentation, see +@url{http://orgmode.org/worg/dev/org-export-reference.html, the Org Export +Reference on Worg}. + +@node Context-sensitive commands, Tables in arbitrary syntax, Adding export back-ends, Hacking @section Context-sensitive commands @cindex context-sensitive commands, hooks @cindex add-ons, context-sensitive commands @@ -15697,7 +16514,7 @@ can use Org's facilities to edit and structure lists by turning * Radio tables:: Sending and receiving radio tables * A @LaTeX{} example:: Step by step, almost a tutorial * Translator functions:: Copy and modify -* Radio lists:: Doing the same for lists +* Radio lists:: Sending and receiving lists @end menu @node Radio tables, A @LaTeX{} example, Tables in arbitrary syntax, Tables in arbitrary syntax @@ -15745,8 +16562,8 @@ removal of these columns, the function never knows that there have been additional columns. @item :no-escape t -When non-nil, do not escape special characters @code{&%#_^} when exporting -the table. The default value is nil. +When non-@code{nil}, do not escape special characters @code{&%#_^} when exporting +the table. The default value is @code{nil}. @end table @noindent @@ -15767,7 +16584,7 @@ in @LaTeX{}. @item You can just comment the table line-by-line whenever you want to process the file, and uncomment it whenever you need to edit the table. This -only sounds tedious---the command @kbd{M-x orgtbl-toggle-comment} +only sounds tedious---the command @kbd{M-x orgtbl-toggle-comment RET} makes this comment-toggling very easy, in particular if you bind it to a key. @end itemize @@ -15781,8 +16598,8 @@ The best way to wrap the source table in @LaTeX{} is to use the activated by placing @code{\usepackage@{comment@}} into the document header. Orgtbl mode can insert a radio table skeleton@footnote{By default this works only for @LaTeX{}, HTML, and Texinfo. Configure the -variable @code{orgtbl-radio-tables} to install templates for other -modes.} with the command @kbd{M-x orgtbl-insert-radio-table}. You will +variable @var{orgtbl-radio-tables} to install templates for other +modes.} with the command @kbd{M-x orgtbl-insert-radio-table RET}. You will be prompted for a table name, let's say we use @samp{salesfigures}. You will then get the following template: @@ -15808,7 +16625,7 @@ example you can fix this by adding an extra line inside the @code{comment} environment that is used to balance the dollar expressions. If you are using AUC@TeX{} with the font-latex library, a much better solution is to add the @code{comment} environment to the -variable @code{LaTeX-verbatim-environments}.}: +variable @var{LaTeX-verbatim-environments}.}: @example % BEGIN RECEIVE ORGTBL salesfigures @@ -15861,7 +16678,7 @@ interprets the following parameters (see also @pxref{Translator functions}): @table @code @item :splice nil/t When set to t, return only table body lines, don't wrap them into a -tabular environment. Default is nil. +tabular environment. Default is @code{nil}. @item :fmt fmt A format to be used to wrap each field, it should contain @code{%s} for the @@ -16053,33 +16870,37 @@ The corresponding block writer function could look like this: (defun org-dblock-write:block-update-time (params) (let ((fmt (or (plist-get params :format) "%d. %m. %Y"))) (insert "Last block update at: " - (format-time-string fmt (current-time))))) + (format-time-string fmt (current-time))))) @end lisp If you want to make sure that all dynamic blocks are always up-to-date, you could add the function @code{org-update-all-dblocks} to a hook, for -example @code{before-save-hook}. @code{org-update-all-dblocks} is +example @var{before-save-hook}. @code{org-update-all-dblocks} is written in a way such that it does nothing in buffers that are not in @code{org-mode}. You can narrow the current buffer to the current dynamic block (like any other block) with @code{org-narrow-to-block}. -@node Special agenda views, Extracting agenda information, Dynamic blocks, Hacking +@node Special agenda views, Speeding up your agendas, Dynamic blocks, Hacking @section Special agenda views @cindex agenda views, user-defined @vindex org-agenda-skip-function @vindex org-agenda-skip-function-global Org provides a special hook that can be used to narrow down the selection -made by these agenda views: @code{agenda}, @code{todo}, @code{alltodo}, -@code{tags}, @code{tags-todo}, @code{tags-tree}. You may specify a function -that is used at each match to verify if the match should indeed be part of -the agenda view, and if not, how much should be skipped. You can specify a -global condition that will be applied to all agenda views, this condition -would be stored in the variable @code{org-agenda-skip-function-global}. More -commonly, such a definition is applied only to specific custom searches, -using @code{org-agenda-skip-function}. +made by these agenda views: @code{agenda}, @code{agenda*}@footnote{The +@code{agenda*} view is the same than @code{agenda} except that it only +considers @emph{appointments}, i.e., scheduled and deadline items that have a +time specification @code{[h]h:mm} in their time-stamps.}, @code{todo}, +@code{alltodo}, @code{tags}, @code{tags-todo}, @code{tags-tree}. You may +specify a function that is used at each match to verify if the match should +indeed be part of the agenda view, and if not, how much should be skipped. +You can specify a global condition that will be applied to all agenda views, +this condition would be stored in the variable +@var{org-agenda-skip-function-global}. More commonly, such a definition is +applied only to specific custom searches, using +@var{org-agenda-skip-function}. Let's say you want to produce a list of projects that contain a WAITING tag anywhere in the project tree. Let's further assume that you have @@ -16114,7 +16935,7 @@ like this: @end lisp @vindex org-agenda-overriding-header -Note that this also binds @code{org-agenda-overriding-header} to get a +Note that this also binds @var{org-agenda-overriding-header} to get a meaningful header in the agenda view. @vindex org-odd-levels-only @@ -16122,12 +16943,12 @@ meaningful header in the agenda view. A general way to create custom searches is to base them on a search for entries with a certain level limit. If you want to study all entries with your custom search function, simply do a search for -@samp{LEVEL>0}@footnote{Note that, when using @code{org-odd-levels-only}, a +@samp{LEVEL>0}@footnote{Note that, when using @var{org-odd-levels-only}, a level number corresponds to order in the hierarchy, not to the number of -stars.}, and then use @code{org-agenda-skip-function} to select the entries +stars.}, and then use @var{org-agenda-skip-function} to select the entries you really want to have. -You may also put a Lisp form into @code{org-agenda-skip-function}. In +You may also put a Lisp form into @var{org-agenda-skip-function}. In particular, you may use the functions @code{org-agenda-skip-entry-if} and @code{org-agenda-skip-subtree-if} in this form, for example: @@ -16166,7 +16987,48 @@ like this, even without defining a special function: (org-agenda-overriding-header "Projects waiting for something: ")))) @end lisp -@node Extracting agenda information, Using the property API, Special agenda views, Hacking +@node Speeding up your agendas, Extracting agenda information, Special agenda views, Hacking +@section Speeding up your agendas +@cindex agenda views, optimization + +When your Org files grow in both number and size, agenda commands may start +to become slow. Below are some tips on how to speed up the agenda commands. + +@enumerate +@item +Reduce the number of Org agenda files: this will reduce the slowliness caused +by accessing to a hard drive. +@item +Reduce the number of DONE and archived headlines: this way the agenda does +not need to skip them. +@item +@vindex org-agenda-dim-blocked-tasks +Inhibit the dimming of blocked tasks: +@lisp +(setq org-agenda-dim-blocked-tasks nil) +@end lisp +@item +@vindex org-startup-folded +@vindex org-agenda-inhibit-startup +Inhibit agenda files startup options: +@lisp +(setq org-agenda-inhibit-startup nil) +@end lisp +@item +@vindex org-agenda-show-inherited-tags +@vindex org-agenda-use-tag-inheritance +Disable tag inheritance in agenda: +@lisp +(setq org-agenda-use-tag-inheritance nil) +@end lisp +@end enumerate + +You can set these options for specific agenda views only. See the docstrings +of these variables for details on why they affect the agenda generation, and +this @uref{http://orgmode.org/worg/agenda-optimization.html, dedicated Worg +page} for further explanations. + +@node Extracting agenda information, Using the property API, Speeding up your agendas, Hacking @section Extracting agenda information @cindex agenda, pipe @cindex Scripts, for agenda processing @@ -16179,7 +17041,7 @@ processing of the data. The first of these commands is the function @code{org-batch-agenda}, that produces an agenda view and sends it as ASCII text to STDOUT@. The command takes a single string as parameter. If the string has length 1, it is used as a key to one of the commands -you have configured in @code{org-agenda-custom-commands}, basically any +you have configured in @var{org-agenda-custom-commands}, basically any key you can use after @kbd{C-c a}. For example, to directly print the current TODO list, you could use @@ -16283,27 +17145,27 @@ This includes the TODO keyword, the tags, time strings for deadline, scheduled, and clocking, and any additional properties defined in the entry. The return value is an alist. Keys may occur multiple times if the property key was used several times.@* -POM may also be nil, in which case the current entry is used. -If WHICH is nil or `all', get all properties. If WHICH is +POM may also be @code{nil}, in which case the current entry is used. +If WHICH is @code{nil} or `all', get all properties. If WHICH is `special' or `standard', only get that subclass. @end defun @vindex org-use-property-inheritance @findex org-insert-property-drawer @defun org-entry-get pom property &optional inherit -Get value of PROPERTY for entry at point-or-marker POM@. By default, -this only looks at properties defined locally in the entry. If INHERIT -is non-nil and the entry does not have the property, then also check -higher levels of the hierarchy. If INHERIT is the symbol +Get value of @code{PROPERTY} for entry at point-or-marker @code{POM}@. By default, +this only looks at properties defined locally in the entry. If @code{INHERIT} +is non-@code{nil} and the entry does not have the property, then also check +higher levels of the hierarchy. If @code{INHERIT} is the symbol @code{selective}, use inheritance if and only if the setting of -@code{org-use-property-inheritance} selects PROPERTY for inheritance. +@var{org-use-property-inheritance} selects @code{PROPERTY} for inheritance. @end defun @defun org-entry-delete pom property -Delete the property PROPERTY from entry at point-or-marker POM. +Delete the property @code{PROPERTY} from entry at point-or-marker POM. @end defun @defun org-entry-put pom property value -Set PROPERTY to VALUE for entry at point-or-marker POM. +Set @code{PROPERTY} to @code{VALUE} for entry at point-or-marker POM. @end defun @defun org-buffer-property-keys &optional include-specials @@ -16315,28 +17177,29 @@ Insert a property drawer for the current entry. Also @end defun @defun org-entry-put-multivalued-property pom property &rest values -Set PROPERTY at point-or-marker POM to VALUES@. VALUES should be a list of -strings. They will be concatenated, with spaces as separators. +Set @code{PROPERTY} at point-or-marker @code{POM} to @code{VALUES}@. +@code{VALUES} should be a list of strings. They will be concatenated, with +spaces as separators. @end defun @defun org-entry-get-multivalued-property pom property -Treat the value of the property PROPERTY as a whitespace-separated list of -values and return the values as a list of strings. +Treat the value of the property @code{PROPERTY} as a whitespace-separated +list of values and return the values as a list of strings. @end defun @defun org-entry-add-to-multivalued-property pom property value -Treat the value of the property PROPERTY as a whitespace-separated list of -values and make sure that VALUE is in this list. +Treat the value of the property @code{PROPERTY} as a whitespace-separated +list of values and make sure that @code{VALUE} is in this list. @end defun @defun org-entry-remove-from-multivalued-property pom property value -Treat the value of the property PROPERTY as a whitespace-separated list of -values and make sure that VALUE is @emph{not} in this list. +Treat the value of the property @code{PROPERTY} as a whitespace-separated +list of values and make sure that @code{VALUE} is @emph{not} in this list. @end defun @defun org-entry-member-in-multivalued-property pom property value -Treat the value of the property PROPERTY as a whitespace-separated list of -values and check if VALUE is in this list. +Treat the value of the property @code{PROPERTY} as a whitespace-separated +list of values and check if @code{VALUE} is in this list. @end defun @defopt org-property-allowed-value-functions @@ -16360,30 +17223,29 @@ functions for each or selected entries. The main entry point for this API is: @defun org-map-entries func &optional match scope &rest skip -Call FUNC at each headline selected by MATCH in SCOPE. +Call @code{FUNC} at each headline selected by @code{MATCH} in @code{SCOPE}. -FUNC is a function or a Lisp form. The function will be called without -arguments, with the cursor positioned at the beginning of the headline. -The return values of all calls to the function will be collected and -returned as a list. +@code{FUNC} is a function or a Lisp form. The function will be called +without arguments, with the cursor positioned at the beginning of the +headline. The return values of all calls to the function will be collected +and returned as a list. -The call to FUNC will be wrapped into a save-excursion form, so FUNC -does not need to preserve point. After evaluation, the cursor will be -moved to the end of the line (presumably of the headline of the -processed entry) and search continues from there. Under some -circumstances, this may not produce the wanted results. For example, -if you have removed (e.g., archived) the current (sub)tree it could -mean that the next entry will be skipped entirely. In such cases, you -can specify the position from where search should continue by making -FUNC set the variable `org-map-continue-from' to the desired buffer -position. +The call to @code{FUNC} will be wrapped into a save-excursion form, so +@code{FUNC} does not need to preserve point. After evaluation, the cursor +will be moved to the end of the line (presumably of the headline of the +processed entry) and search continues from there. Under some circumstances, +this may not produce the wanted results. For example, if you have removed +(e.g., archived) the current (sub)tree it could mean that the next entry will +be skipped entirely. In such cases, you can specify the position from where +search should continue by making @code{FUNC} set the variable +@var{org-map-continue-from} to the desired buffer position. -MATCH is a tags/property/todo match as it is used in the agenda match view. -Only headlines that are matched by this query will be considered during -the iteration. When MATCH is nil or t, all headlines will be -visited by the iteration. +@code{MATCH} is a tags/property/todo match as it is used in the agenda match +view. Only headlines that are matched by this query will be considered +during the iteration. When @code{MATCH} is @code{nil} or @code{t}, all +headlines will be visited by the iteration. -SCOPE determines the scope of this command. It can be any of: +@code{SCOPE} determines the scope of this command. It can be any of: @example nil @r{the current buffer, respecting the restriction if any} @@ -16407,7 +17269,7 @@ the scanner. The following items can be given here: archive @r{skip trees with the archive tag} comment @r{skip trees with the COMMENT keyword} function or Lisp form - @r{will be used as value for @code{org-agenda-skip-function},} + @r{will be used as value for @var{org-agenda-skip-function},} @r{so whenever the function returns t, FUNC} @r{will not be called for that entry and search will} @r{continue from the point where the function leaves it} @@ -16421,17 +17283,18 @@ Here are a couple of functions that might be handy: @defun org-todo &optional arg Change the TODO state of the entry. See the docstring of the functions for -the many possible values for the argument ARG. +the many possible values for the argument @code{ARG}. @end defun @defun org-priority &optional action Change the priority of the entry. See the docstring of this function for the -possible values for ACTION. +possible values for @code{ACTION}. @end defun @defun org-toggle-tag tag &optional onoff -Toggle the tag TAG in the current entry. Setting ONOFF to either @code{on} -or @code{off} will not toggle tag, but ensure that it is either on or off. +Toggle the tag @code{TAG} in the current entry. Setting @code{ONOFF} to +either @code{on} or @code{off} will not toggle tag, but ensure that it is +either on or off. @end defun @defun org-promote @@ -16480,7 +17343,7 @@ format that can be displayed by @i{MobileOrg}, and for integrating notes captured and changes made by @i{MobileOrg} into the main system. For changing tags and TODO states in MobileOrg, you should have set up the -customization variables @code{org-todo-keywords} and @code{org-tags-alist} to +customization variables @var{org-todo-keywords} and @var{org-tag-alist} to cover all important tags and TODO keywords, even if individual files use only part of these. MobileOrg will also offer you states and tags set up with in-buffer settings, but it will understand the logistics of TODO state @@ -16502,9 +17365,9 @@ uploaded to the server. This can be done with Org mode 7.02 and with @i{MobileOrg 1.5} (iPhone version), and you need an @file{openssl} installation on your system. To turn on encryption, set a password in @i{MobileOrg} and, on the Emacs side, configure the variable -@code{org-mobile-use-encryption}@footnote{If you can safely store the +@var{org-mobile-use-encryption}@footnote{If you can safely store the password in your Emacs setup, you might also want to configure -@code{org-mobile-encryption-password}. Please read the docstring of that +@var{org-mobile-encryption-password}. Please read the docstring of that variable. Note that encryption will apply only to the contents of the @file{.org} files. The file names themselves will remain visible.}. @@ -16527,12 +17390,12 @@ and to read captured notes from there. @node Pushing to MobileOrg, Pulling from MobileOrg, Setting up the staging area, MobileOrg @section Pushing to MobileOrg -This operation copies all files currently listed in @code{org-mobile-files} -to the directory @code{org-mobile-directory}. By default this list contains -all agenda files (as listed in @code{org-agenda-files}), but additional files -can be included by customizing @code{org-mobile-files}. File names will be -staged with paths relative to @code{org-directory}, so all files should be -inside this directory@footnote{Symbolic links in @code{org-directory} need to +This operation copies all files currently listed in @var{org-mobile-files} +to the directory @var{org-mobile-directory}. By default this list contains +all agenda files (as listed in @var{org-agenda-files}), but additional files +can be included by customizing @var{org-mobile-files}. File names will be +staged with paths relative to @var{org-directory}, so all files should be +inside this directory@footnote{Symbolic links in @var{org-directory} need to have the same name than their targets.}. The push operation also creates a special Org file @file{agendas.org} with @@ -16540,7 +17403,7 @@ all custom agenda view defined by the user@footnote{While creating the agendas, Org mode will force ID properties on all referenced entries, so that these entries can be uniquely identified if @i{MobileOrg} flags them for further action. If you do not want to get these properties in so many -entries, you can set the variable @code{org-mobile-force-id-on-agenda-items} +entries, you can set the variable @var{org-mobile-force-id-on-agenda-items} to @code{nil}. Org mode will then rely on outline paths, in the hope that these will be unique enough.}. @@ -16564,7 +17427,7 @@ and operates on the pointers to flagged entries. Here is how it works: Org moves all entries found in @file{mobileorg.org}@footnote{@file{mobileorg.org} will be empty after this operation.} and appends them to the file pointed to by the variable -@code{org-mobile-inbox-for-pull}. Each captured entry and each editing event +@var{org-mobile-inbox-for-pull}. Each captured entry and each editing event will be a top-level entry in the inbox file. @item After moving the entries, Org will attempt to implement the changes made in @@ -16581,6 +17444,7 @@ should then go through these entries and do whatever actions are necessary. If a note has been stored while flagging an entry in @i{MobileOrg}, that note will be displayed in the echo area when the cursor is on the corresponding agenda line. + @table @kbd @kindex ? @item ? @@ -16597,11 +17461,11 @@ this flagged entry is finished. @kindex C-c a ? If you are not able to process all flagged entries directly, you can always return to this agenda view@footnote{Note, however, that there is a subtle -difference. The view created automatically by @kbd{M-x org-mobile-pull -@key{RET}} is guaranteed to search all files that have been addressed by the -last pull. This might include a file that is not currently in your list of -agenda files. If you later use @kbd{C-c a ?} to regenerate the view, only -the current agenda files will be searched.} using @kbd{C-c a ?}. +difference. The view created automatically by @kbd{M-x org-mobile-pull RET} +is guaranteed to search all files that have been addressed by the last pull. +This might include a file that is not currently in your list of agenda files. +If you later use @kbd{C-c a ?} to regenerate the view, only the current +agenda files will be searched.} using @kbd{C-c a ?}. @node History and Acknowledgments, GNU Free Documentation License, MobileOrg, Top @appendix History and acknowledgments @@ -16661,7 +17525,7 @@ of his great @file{remember.el}. Without Sebastian, the HTML/XHTML publishing of Org would be the pitiful work of an ignorant amateur. Sebastian has pushed this part of Org onto a much higher level. He also wrote @file{org-info.js}, a Java script for displaying -webpages derived from Org using an Info-like or a folding interface with +web pages derived from Org using an Info-like or a folding interface with single-key navigation. @end table @@ -16675,8 +17539,8 @@ would not be complete without adding a few more acknowledgements and thanks to Carsten's ones above. I am first grateful to Carsten for his trust while handing me over the -maintainership of Org. His support as been great since day one of this new -adventure, and it helped a lot. +maintainership of Org. His unremitting support is what really helped me +getting more confident over time, with both the community and the code. When I took over maintainership, I knew I would have to make Org more collaborative than ever, as I would have to rely on people that are more @@ -16690,15 +17554,13 @@ Eric is maintaining the Babel parts of Org. His reactivity here kept me away from worrying about possible bugs here and let me focus on other parts. @item Nicolas Goaziou -Nicolas is maintaining the consistency of the deepest parts of Org. His work -on @file{org-element.el} and @file{org-export.el} has been outstanding, and -opened the doors for many new ideas and features. - -@item Jambunathan K -Jambunathan contributed the ODT exporter, definitely a killer feature of -Org mode. He also contributed the new HTML exporter, which is another core -feature of Org. Here too, I knew I could rely on him to fix bugs in these -areas and to patiently explain the users what was the problems and solutions. +Nicolas is maintaining the consistency of the deepest parts of Org. His +work on @file{org-element.el} and @file{ox.el} has been outstanding, and +opened the doors for many new ideas and features. He rewrote many of the +old exporters to use the new export engine, and helped with documenting +this major change. More importantly (if that's possible), he has been more +than reliable during all the work done for Org 8.0, and always very +reactive on the mailing list. @item Achim Gratz Achim rewrote the building process of Org, turning some @emph{ad hoc} tools @@ -16722,8 +17584,17 @@ complete if the ones above were not mentioned in this manual. @item @i{Russel Adams} came up with the idea for drawers. @item +@i{Suvayu Ali} has steadily helped on the mailing list, providing useful +feedback on many features and several patches. +@item +@i{Luis Anaya} wrote @file{ox-man.el}. +@item @i{Thomas Baumann} wrote @file{org-bbdb.el} and @file{org-mhe.el}. @item +@i{Michael Brand} helped by reporting many bugs and testing many features. +He also implemented the distinction between empty fields and 0-value fields +in Org's spreadsheets. +@item @i{Christophe Bataillon} created the great unicorn logo that we use on the Org mode website. @item @@ -16747,7 +17618,11 @@ calculations and improved XEmacs compatibility, in particular by porting @item @i{Sacha Chua} suggested copying some linking code from Planner. @item -@i{Baoqiu Cui} contributed the DocBook exporter. +@i{Toby S. Cubitt} contributed to the code for clock formats. +@item +@i{Baoqiu Cui} contributed the DocBook exporter. It has been deleted from +Org 8.0: you can now export to Texinfo and export the @file{.texi} file to +DocBook using @code{makeinfo}. @item @i{Eddward DeVilla} proposed and tested checkbox statistics. He also came up with the idea of properties, and that there should be an API for @@ -16764,7 +17639,8 @@ the Org-Babel documentation into the manual. @item @i{Christian Egli} converted the documentation into Texinfo format, inspired the agenda, patched CSS formatting into the HTML exporter, and wrote -@file{org-taskjuggler.el}. +@file{org-taskjuggler.el}, which has been rewritten by Nicolas Goaziou as +@file{ox-taskjuggler.el} for Org 8.0. @item @i{David Emery} provided a patch for custom CSS support in exported HTML agendas. @@ -16790,7 +17666,9 @@ publication through Network Theory Ltd. @item @i{Niels Giesen} had the idea to automatically archive DONE trees. @item -@i{Nicolas Goaziou} rewrote much of the plain list code. +@i{Nicolas Goaziou} rewrote much of the plain list code. He also wrote +@file{org-element.el} and @file{org-export.el}, which was a huge step forward +in implementing a clean framework for Org exporters. @item @i{Kai Grossjohann} pointed out key-binding conflicts with other packages. @item @@ -16813,6 +17691,8 @@ folded entries, and column view for properties. @item @i{Tokuya Kameshima} wrote @file{org-wl.el} and @file{org-mew.el}. @item +@i{Jonathan Leech-Pepin} wrote @file{ox-texinfo.el}. +@item @i{Shidai Liu} ("Leo") asked for embedded @LaTeX{} and tested it. He also provided frequent feedback and some patches. @item @@ -16825,7 +17705,7 @@ small fixes and patches. @item @i{Jason F. McBrayer} suggested agenda export to CSV format. @item -@i{Max Mikhanosha} came up with the idea of refiling. +@i{Max Mikhanosha} came up with the idea of refiling and sticky agendas. @item @i{Dmitri Minaev} sent a patch to set priority limits on a per-file basis. @@ -16859,6 +17739,9 @@ links, among other things. @i{Pete Phillips} helped during the development of the TAGS feature, and provided frequent feedback. @item +@i{Francesco Pizzolante} provided patches that helped speeding up the agenda +generation. +@item @i{Martin Pohlack} provided the code snippet to bundle character insertion into bundles of 20 for undo. @item @@ -16884,6 +17767,9 @@ of feedback, developed and applied standards to the Org documentation. @i{Christian Schlauer} proposed angular brackets around links, among other things. @item +@i{Christopher Schmidt} reworked @code{orgstruct-mode} so that users can +enjoy folding in non-org buffers by using Org headlines in comments. +@item @i{Paul Sexton} wrote @file{org-ctags.el}. @item Linking to VM/BBDB/Gnus was first inspired by @i{Tom Shannon}'s @@ -16915,7 +17801,7 @@ with links transformation to Org syntax. @i{David O'Toole} wrote @file{org-publish.el} and drafted the manual chapter about publishing. @item -@i{Jambunathan K} contributed the ODT exporter. +@i{Jambunathan K} contributed the ODT exporter and rewrote the HTML exporter. @item @i{Sebastien Vauban} reported many issues with @LaTeX{} and BEAMER export and enabled source code highlighting in Gnus. diff --git a/doc/orgguide.texi b/doc/orgguide.texi index b563ad779..1425fef9c 100644 --- a/doc/orgguide.texi +++ b/doc/orgguide.texi @@ -13,9 +13,9 @@ @c Version and Contact Info @set MAINTAINERSITE @uref{http://orgmode.org,maintainers webpage} @set AUTHOR Carsten Dominik -@set MAINTAINER Carsten Dominik -@set MAINTAINEREMAIL @email{carsten at orgmode dot org} -@set MAINTAINERCONTACT @uref{mailto:carsten at orgmode dot org,contact the maintainer} +@set MAINTAINER Bastien Guerry +@set MAINTAINEREMAIL @email{bzg at gnu dot org} +@set MAINTAINERCONTACT @uref{mailto:bzg at gnu dot org,contact the maintainer} @c %**end of header @finalout @@ -98,7 +98,7 @@ modify this GNU manual.'' * Working With Source Code:: Source code snippets embedded in Org * Miscellaneous:: All the rest which did not fit elsewhere -* GNU Free Documentation License:: This manual license. +* GNU Free Documentation License:: This manual license. @detailmenu --- The Detailed Node Listing --- @@ -148,6 +148,7 @@ Tags * Tag inheritance:: Tags use the tree structure of the outline * Setting tags:: How to assign tags to a headline * Tag searches:: Searching for combinations of tags +* Tag searches:: Searching for combinations of tags Dates and Times @@ -158,8 +159,8 @@ Dates and Times Capture - Refile - Archive -* Capture:: -* Refiling notes:: Moving a tree from one place to another +* Capture:: Capturing new stuff +* Refile and copy:: Moving a tree from one place to another * Archiving:: What to do with finished projects Capture @@ -427,7 +428,7 @@ Promote/demote the current subtree by one level. Move subtree up/down (swap with previous/next subtree of same level). @item C-c C-w -Refile entry or region to a different location. @xref{Refiling notes}. +Refile entry or region to a different location. @xref{Refile and copy}. @item C-x n s/w Narrow buffer to current subtree / widen it again @end table @@ -729,6 +730,9 @@ Links such as @samp{[[My Target]]} or @samp{[[My Target][Find my target]]} lead to a text search in the current file for the corresponding target which looks like @samp{<>}. +Internal links will be used to reference their destination, through links or +numbers, when possible. + @node External links, Handling links, Internal links, Hyperlinks @section External links @@ -1110,6 +1114,7 @@ Tags will by default be in bold face with the same color as the headline. * Tag inheritance:: Tags use the tree structure of the outline * Setting tags:: How to assign tags to a headline * Tag searches:: Searching for combinations of tags +* Tag searches:: Searching for combinations of tags @end menu @node Tag inheritance, Setting tags, Tags, Tags @@ -1189,7 +1194,46 @@ can instead set the TAGS option line as: #+TAGS: @@work(w) @@home(h) @@tennisclub(t) laptop(l) pc(p) @end smallexample -@node Tag searches, , Setting tags, Tags +@node Tag searches, Tag searches, Setting tags, Tags +@section Tag groups + +@cindex group tags +@cindex tags, groups +In a set of mutually exclusive tags, the first tag can be defined as a +@emph{group tag}. When you search for a group tag, it will return matches +for all members in the group. In an agenda view, filtering by a group tag +will display headlines tagged with at least one of the members of the +group. This makes tag searches and filters even more flexible. + +You can set group tags by inserting a colon between the group tag and other +tags, like this: + +@example +#+TAGS: @{ @@read : @@read_book @@read_ebook @} +@end example + +In this example, @samp{@@read} is a @emph{group tag} for a set of three +tags: @samp{@@read}, @samp{@@read_book} and @samp{@@read_ebook}. + +You can also use the @code{:grouptags} keyword directly when setting +@var{org-tag-alist}: + +@lisp +(setq org-tag-alist '((:startgroup . nil) + ("@@read" . nil) + (:grouptags . nil) + ("@@read_book" . nil) + ("@@read_ebook" . nil) + (:endgroup . nil))) +@end lisp + +@kindex C-c C-x q +@vindex org-group-tags +If you want to ignore group tags temporarily, toggle group tags support +with @command{org-toggle-tags-groups}, bound to @kbd{C-c C-x q}. If you +want to disable tag groups completely, set @var{org-group-tags} to nil. + +@node Tag searches, , Tag searches, Tags @section Tag searches Once a system of tags has been set up, it can be used to collect related @@ -1518,17 +1562,17 @@ projects need to be moved around. Moving completed project trees to an archive file keeps the system compact and fast. @menu -* Capture:: -* Refiling notes:: Moving a tree from one place to another +* Capture:: Capturing new stuff +* Refile and copy:: Moving a tree from one place to another * Archiving:: What to do with finished projects @end menu -@node Capture, Refiling notes, Capture - Refile - Archive, Capture - Refile - Archive +@node Capture, Refile and copy, Capture - Refile - Archive, Capture - Refile - Archive @section Capture Org's method for capturing new items is heavily inspired by John Wiegley -excellent remember package. It lets you store quick notes with little -interruption of your work flow. Org lets you define templates for new +excellent @file{remember.el} package. It lets you store quick notes with +little interruption of your work flow. Org lets you define templates for new entries and associate them with different targets for storing notes. @menu @@ -1563,7 +1607,7 @@ Once you are done entering information into the capture buffer, @kbd{C-c C-c} will return you to the window configuration before the capture process, so that you can resume your work without further distraction. @item C-c C-w -Finalize by moving the entry to a refile location (@pxref{Refiling notes}). +Finalize by moving the entry to a refile location (@pxref{Refile and copy}). @item C-c C-k Abort the capture process and return to the previous state. @end table @@ -1605,21 +1649,24 @@ allow dynamic insertion of content. Here is a small selection of the possibilities, consult the manual for more. @smallexample %a @r{annotation, normally the link created with @code{org-store-link}} -%i @r{initial content, the region when remember is called with C-u.} +%i @r{initial content, the region when capture is called with C-u.} %t @r{timestamp, date only} %T @r{timestamp with date and time} %u, %U @r{like the above, but inactive timestamps} @end smallexample -@node Refiling notes, Archiving, Capture, Capture - Refile - Archive -@section Refiling notes +@node Refile and copy, Archiving, Capture, Capture - Refile - Archive +@section Refile and copy -When reviewing the captured data, you may want to refile some of the entries -into a different list, for example into a project. Cutting, finding the -right location, and then pasting the note is cumbersome. To simplify this -process, you can use the following special command: +When reviewing the captured data, you may want to refile or copy some of the +entries into a different list, for example into a project. Cutting, finding +the right location, and then pasting the note is cumbersome. To simplify +this process, you can use the following special command: @table @kbd +@item C-c M-x +Copy the entry or region at point. This command behaves like +@code{org-refile}, except that the original note will not be deleted. @item C-c C-w 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 @@ -1633,7 +1680,7 @@ Use the refile interface to jump to a heading. Jump to the location where @code{org-refile} last moved a tree to. @end table -@node Archiving, , Refiling notes, Capture - Refile - Archive +@node Archiving, , Refile and copy, Capture - Refile - Archive @section Archiving When a project represented by a (sub)tree is finished, you may want @@ -1666,8 +1713,6 @@ setting this variable, for example @seealso{ @uref{http://orgmode.org/manual/Capture-_002d-Refile-_002d-Archive.html#Capture-_002d-Refile-_002d-Archive, Chapter 9 of the manual}@* -@uref{http://members.optusnet.com.au/~charles57/GTD/remember.html, Charles -Cave's remember tutorial}@* @uref{http://orgmode.org/worg/org-tutorials/org-protocol-custom-handler.php, Sebastian Rose's tutorial for capturing from a web browser}}@uref{}@* @@ -2045,7 +2090,7 @@ summarizes the markup rules used in an Org-mode buffer. @menu * Structural markup elements:: The basic structure as seen by the exporter -* Images and tables:: Tables and Images will be included +* Images and tables:: Images, tables and caption mechanism * Literal examples:: Source code examples with special formatting * Include files:: Include additional files into a document * Embedded @LaTeX{}:: @LaTeX{} can be freely used inside Org documents @@ -2166,32 +2211,30 @@ Toggle the COMMENT keyword at the beginning of an entry. For Org mode tables, the lines before the first horizontal separator line will become table header lines. You can use the following lines somewhere before the table to assign a caption and a label for cross references, and in -the text you can refer to the object with @code{\ref@{tab:basic-data@}}: +the text you can refer to the object with @code{[[tab:basic-data]]}: @smallexample #+CAPTION: This is the caption for the next table (or link) -#+LABEL: tbl:basic-data +#+NAME: tbl:basic-data | ... | ...| |-----|----| @end smallexample -Some backends (HTML, @LaTeX{}, and DocBook) allow you to directly include -images into the exported document. Org does this, if a link to an image -files does not have a description part, for example @code{[[./img/a.jpg]]}. -If you wish to define a caption for the image and maybe a label for internal -cross references, you sure that the link is on a line by itself precede it -with: +Some backends allow you to directly include images into the exported +document. Org does this, if a link to an image files does not have +a description part, for example @code{[[./img/a.jpg]]}. If you wish to +define a caption for the image and maybe a label for internal cross +references, you sure that the link is on a line by itself precede it with: @smallexample #+CAPTION: This is the caption for the next figure link (or table) -#+LABEL: fig:SED-HR4049 +#+NAME: fig:SED-HR4049 [[./img/a.jpg]] @end smallexample -You may also define additional attributes for the figure. As this is -backend-specific, see the sections about the individual backends for more -information. - +The same caption mechanism applies to other structures than images and tables +(e.g., @LaTeX{} equations, source code blocks), provided the chosen export +back-end supports them. @node Literal examples, Include files, Images and tables, Markup @section Literal examples @@ -2251,7 +2294,7 @@ processed normally. @kbd{C-c '} will visit the included file. For scientific notes which need to be able to contain mathematical symbols and the occasional formula, Org-mode supports embedding @LaTeX{} code into -its files. You can directly use TeX-like macros for special symbols, enter +its files. You can directly use TeX-like syntax for special symbols, enter formulas and entire @LaTeX{} environments. @smallexample @@ -2311,8 +2354,6 @@ Insert template with export options, see example below. #+DESCRIPTION: the page description, e.g.@: for the XHTML meta tag #+KEYWORDS: the page keywords, e.g.@: for the XHTML meta tag #+LANGUAGE: language for HTML, e.g.@: @samp{en} (@code{org-export-default-language}) -#+TEXT: Some descriptive text to be inserted at the beginning. -#+TEXT: Several lines may be given. #+OPTIONS: H:2 num:t toc:t \n:nil @@:t ::t |:t ^:t f:t TeX:t ... #+LINK_UP: the ``up'' link of an exported page #+LINK_HOME: the ``home'' link of an exported page @@ -2386,7 +2427,7 @@ Export as @LaTeX{} and then process to PDF, then open the resulting PDF file. By default, the @LaTeX{} output uses the class @code{article}. You can change this by adding an option like @code{#+LaTeX_CLASS: myclass} in your -file. The class must be listed in @code{org-export-latex-classes}. +file. The class must be listed in @code{org-latex-classes}. Embedded @LaTeX{} as described in @ref{Embedded @LaTeX{}}, will be correctly inserted into the @LaTeX{} file. Similarly to the HTML exporter, you can use diff --git a/etc/schema/od-manifest-schema-v1.2-cs01.rnc b/etc/schema/od-manifest-schema-v1.2-os.rnc similarity index 97% rename from etc/schema/od-manifest-schema-v1.2-cs01.rnc rename to etc/schema/od-manifest-schema-v1.2-os.rnc index eb225b231..554f3219e 100644 --- a/etc/schema/od-manifest-schema-v1.2-cs01.rnc +++ b/etc/schema/od-manifest-schema-v1.2-os.rnc @@ -1,7 +1,7 @@ # Open Document Format for Office Applications (OpenDocument) Version 1.2 -# Committee Specification (CS) 01, 17 March 2011 +# OASIS Standard, 29 September 2011 # Manifest Relax-NG Schema -# +# Source: http://docs.oasis-open.org/office/v1.2/os/ # Copyright (c) OASIS Open 2002-2011, 2013. All Rights Reserved. # # All capitalized terms in the following text have the meanings assigned to them diff --git a/etc/schema/od-schema-v1.2-cs01.rnc b/etc/schema/od-schema-v1.2-os.rnc similarity index 99% rename from etc/schema/od-schema-v1.2-cs01.rnc rename to etc/schema/od-schema-v1.2-os.rnc index 38b11e999..c019fba56 100644 --- a/etc/schema/od-schema-v1.2-cs01.rnc +++ b/etc/schema/od-schema-v1.2-os.rnc @@ -1,7 +1,7 @@ # Open Document Format for Office Applications (OpenDocument) Version 1.2 -# Committee Specification (CS) 01, 17 March 2011 +# OASIS Standard, 29 September 2011 # Relax-NG Schema -# +# Source: http://docs.oasis-open.org/office/v1.2/os/ # Copyright (c) OASIS Open 2002-2011, 2013. All Rights Reserved. # # All capitalized terms in the following text have the meanings assigned to them diff --git a/etc/schema/schemas.xml b/etc/schema/schemas.xml index a319191ab..f1e0ed785 100644 --- a/etc/schema/schemas.xml +++ b/etc/schema/schemas.xml @@ -2,6 +2,6 @@ - - + + diff --git a/etc/styles/OrgOdtContentTemplate.xml b/etc/styles/OrgOdtContentTemplate.xml index 55e1b7870..d0c98a3e5 100644 --- a/etc/styles/OrgOdtContentTemplate.xml +++ b/etc/styles/OrgOdtContentTemplate.xml @@ -46,7 +46,19 @@ + + + + + + + + + + + diff --git a/etc/styles/OrgOdtStyles.xml b/etc/styles/OrgOdtStyles.xml index 5dfcfa838..f41d9840c 100644 --- a/etc/styles/OrgOdtStyles.xml +++ b/etc/styles/OrgOdtStyles.xml @@ -86,7 +86,11 @@ - + + + + + @@ -252,26 +256,44 @@ + + + + - + + + + + + + + - + - + + + + + + + + @@ -279,6 +301,9 @@ + + + @@ -325,9 +350,10 @@ - + + @@ -349,23 +375,41 @@ - - - - - - + + + - + - - + + + + + + + + + + + - + + + + + + + + + / + + / + + @@ -441,7 +485,7 @@ - + diff --git a/lisp/Makefile b/lisp/Makefile index 0e10c2306..89f504db6 100644 --- a/lisp/Makefile +++ b/lisp/Makefile @@ -89,5 +89,5 @@ clean cleanall cleanelc:: clean-install: if [ -d $(DESTDIR)$(lispdir) ] ; then \ - $(RM) $(DESTDIR)$(lispdir)/org*.el* $(DESTDIR)$(lispdir)/ob*.el* ; \ + $(RM) $(DESTDIR)$(lispdir)/org*.el* $(DESTDIR)$(lispdir)/ob*.el* $(DESTDIR)$(lispdir)/ox*.el* ; \ fi ; diff --git a/lisp/ob-C.el b/lisp/ob-C.el index 42a98de8c..b1e8a06b7 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -31,7 +31,6 @@ ;;; Code: (require 'ob) -(require 'ob-eval) (require 'cc-mode) (declare-function org-entry-get "org" @@ -106,11 +105,11 @@ or `org-babel-execute:C++'." (org-babel-process-file-name tmp-src-file)) "")))) ((lambda (results) (org-babel-reassemble-table - (if (member "vector" (cdr (assoc :result-params params))) - (let ((tmp-file (org-babel-temp-file "c-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file)) - (org-babel-read results)) + (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-read results) + (let ((tmp-file (org-babel-temp-file "c-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 562f37d7b..67d3c3759 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -28,9 +28,6 @@ ;;; Code: (require 'ob) -(require 'ob-ref) -(require 'ob-comint) -(require 'ob-eval) (eval-when-compile (require 'cl)) (declare-function orgtbl-to-tsv "org-table" (table params)) @@ -212,6 +209,9 @@ This function is called by `org-babel-execute-src-block'." (if (org-babel-comint-buffer-livep session) session (save-window-excursion + (when (get-buffer session) + ;; Session buffer exists, but with dead process + (set-buffer session)) (require 'ess) (R) (rename-buffer (if (bufferp session) @@ -240,7 +240,7 @@ current code buffer." '((:bmp . "bmp") (:jpg . "jpeg") (:jpeg . "jpeg") - (:tex . "tikz") + (:tikz . "tikz") (:tiff . "tiff") (:png . "png") (:svg . "svg") @@ -302,11 +302,10 @@ last statement in BODY, as elisp." (format "{function ()\n{\n%s\n}}()" body) (org-babel-process-file-name tmp-file 'noquote))) (org-babel-R-process-value-result - (if (or (member "scalar" result-params) - (member "verbatim" result-params)) - (with-temp-buffer - (insert-file-contents tmp-file) - (buffer-string)) + (org-babel-result-cond result-params + (with-temp-buffer + (insert-file-contents tmp-file) + (buffer-string)) (org-babel-import-elisp-from-file tmp-file '(16))) column-names-p))) (output (org-babel-eval org-babel-R-command body)))) @@ -335,11 +334,10 @@ last statement in BODY, as elisp." "FALSE") ".Last.value" (org-babel-process-file-name tmp-file 'noquote))) (org-babel-R-process-value-result - (if (or (member "scalar" result-params) - (member "verbatim" result-params)) - (with-temp-buffer - (insert-file-contents tmp-file) - (buffer-string)) + (org-babel-result-cond result-params + (with-temp-buffer + (insert-file-contents tmp-file) + (buffer-string)) (org-babel-import-elisp-from-file tmp-file '(16))) column-names-p))) (output diff --git a/lisp/ob-awk.el b/lisp/ob-awk.el index 12d625acf..373d5fd98 100644 --- a/lisp/ob-awk.el +++ b/lisp/ob-awk.el @@ -32,7 +32,6 @@ ;;; Code: (require 'ob) -(require 'ob-eval) (require 'org-compat) (eval-when-compile (require 'cl)) @@ -45,7 +44,7 @@ (defvar org-babel-awk-command "awk" "Name of the awk executable command.") -(defun org-babel-expand-body:awk (body params &optional processed-params) +(defun org-babel-expand-body:awk (body params) "Expand BODY according to PARAMS, return the expanded body." (dolist (pair (mapcar #'cdr (org-babel-get-header params :var))) (setf body (replace-regexp-in-string @@ -78,10 +77,8 @@ called by `org-babel-execute-src-block'" (org-babel-reassemble-table ((lambda (results) (when results - (if (or (member "scalar" result-params) - (member "verbatim" result-params) - (member "output" result-params)) - results + (org-babel-result-cond result-params + results (let ((tmp (org-babel-temp-file "awk-results-"))) (with-temp-file tmp (insert results)) (org-babel-import-elisp-from-file tmp))))) diff --git a/lisp/ob-calc.el b/lisp/ob-calc.el index a8e53c01b..766f6cebb 100644 --- a/lisp/ob-calc.el +++ b/lisp/ob-calc.el @@ -31,7 +31,6 @@ (unless (featurep 'xemacs) (require 'calc-trail) (require 'calc-store)) -(eval-when-compile (require 'ob-comint)) (declare-function calc-store-into "calc-store" (&optional var)) (declare-function calc-recall "calc-store" (&optional var)) diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el index b020498eb..bc2bbc0d0 100644 --- a/lisp/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -79,9 +79,8 @@ (insert (org-babel-expand-body:clojure body params)) ((lambda (result) (let ((result-params (cdr (assoc :result-params params)))) - (if (or (member "scalar" result-params) - (member "verbatim" result-params)) - result + (org-babel-result-cond result-params + result (condition-case nil (org-babel-script-escape result) (error result))))) (slime-eval diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el index 5ea3be2d5..f1562970f 100644 --- a/lisp/ob-comint.el +++ b/lisp/ob-comint.el @@ -30,7 +30,7 @@ ;; org-babel at large. ;;; Code: -(require 'ob) +(require 'ob-core) (require 'org-compat) (require 'comint) (eval-when-compile (require 'cl)) diff --git a/lisp/ob-core.el b/lisp/ob-core.el new file mode 100644 index 000000000..817bb2ac0 --- /dev/null +++ b/lisp/ob-core.el @@ -0,0 +1,2707 @@ +;;; ob-core.el --- working with code blocks in org-mode + +;; Copyright (C) 2009-2012 Free Software Foundation, Inc. + +;; Authors: Eric Schulte +;; Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: +(eval-when-compile + (require 'cl)) +(require 'ob-eval) +(require 'org-macs) +(require 'org-compat) + +(defconst org-babel-exeext + (if (memq system-type '(windows-nt cygwin)) + ".exe" + nil)) +;; dynamically scoped for tramp +(defvar org-babel-call-process-region-original nil) +(defvar org-src-lang-modes) +(defvar org-babel-library-of-babel) +(declare-function show-all "outline" ()) +(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) +(declare-function org-mark-ring-push "org" (&optional pos buffer)) +(declare-function tramp-compat-make-temp-file "tramp-compat" + (filename &optional dir-flag)) +(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) +(declare-function tramp-file-name-user "tramp" (vec)) +(declare-function tramp-file-name-host "tramp" (vec)) +(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) +(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-edit-src-code "org-src" + (&optional context code edit-buffer-name quietp)) +(declare-function org-edit-src-exit "org-src" (&optional context)) +(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) +(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body)) +(declare-function org-outline-overlay-data "org" (&optional use-markers)) +(declare-function org-set-outline-overlay-data "org" (data)) +(declare-function org-narrow-to-subtree "org" ()) +(declare-function org-split-string "org" (string &optional separators)) +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) +(declare-function org-make-options-regexp "org" (kwds &optional extra)) +(declare-function org-do-remove-indentation "org" (&optional n)) +(declare-function org-next-block "org" (arg &optional backward block-regexp)) +(declare-function org-previous-block "org" (arg &optional block-regexp)) +(declare-function org-show-context "org" (&optional key)) +(declare-function org-at-table-p "org" (&optional table-type)) +(declare-function org-cycle "org" (&optional arg)) +(declare-function org-uniquify "org" (list)) +(declare-function org-current-level "org" ()) +(declare-function org-table-import "org-table" (file arg)) +(declare-function org-add-hook "org-compat" + (hook function &optional append local)) +(declare-function org-table-align "org-table" ()) +(declare-function org-table-end "org-table" (&optional table-type)) +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function orgtbl-to-orgtbl "org-table" (table params)) +(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) +(declare-function org-babel-lob-get-info "ob-lob" nil) +(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) +(declare-function org-babel-ref-parse "ob-ref" (assignment)) +(declare-function org-babel-ref-resolve "ob-ref" (ref)) +(declare-function org-babel-ref-goto-headline-id "ob-ref" (id)) +(declare-function org-babel-ref-headline-body "ob-ref" ()) +(declare-function org-babel-lob-execute-maybe "ob-lob" ()) +(declare-function org-number-sequence "org-compat" (from &optional to inc)) +(declare-function org-at-item-p "org-list" ()) +(declare-function org-list-parse-list "org-list" (&optional delete)) +(declare-function org-list-to-generic "org-list" (LIST PARAMS)) +(declare-function org-list-struct "org-list" ()) +(declare-function org-list-prevs-alist "org-list" (struct)) +(declare-function org-list-get-list-end "org-list" (item struct prevs)) +(declare-function org-remove-if "org" (predicate seq)) +(declare-function org-completing-read "org" (&rest args)) +(declare-function org-escape-code-in-region "org-src" (beg end)) +(declare-function org-unescape-code-in-string "org-src" (s)) +(declare-function org-table-to-lisp "org-table" (&optional txt)) +(declare-function org-reverse-string "org" (string)) + +(defgroup org-babel nil + "Code block evaluation and management in `org-mode' documents." + :tag "Babel" + :group 'org) + +(defcustom org-confirm-babel-evaluate t + "Confirm before evaluation. +Require confirmation before interactively evaluating code +blocks in Org-mode buffers. The default value of this variable +is t, meaning confirmation is required for any code block +evaluation. This variable can be set to nil to inhibit any +future confirmation requests. This variable can also be set to a +function which takes two arguments the language of the code block +and the body of the code block. Such a function should then +return a non-nil value if the user should be prompted for +execution or nil if no prompt is required. + +Warning: Disabling confirmation may result in accidental +evaluation of potentially harmful code. It may be advisable +remove code block execution from C-c C-c as further protection +against accidental code block evaluation. The +`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to +remove code block execution from the C-c C-c keybinding." + :group 'org-babel + :version "24.1" + :type '(choice boolean function)) +;; don't allow this variable to be changed through file settings +(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t))) + +(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil + "Remove code block evaluation from the C-c C-c key binding." + :group 'org-babel + :version "24.1" + :type 'boolean) + +(defcustom org-babel-results-keyword "RESULTS" + "Keyword used to name results generated by code blocks. +Should be either RESULTS or NAME however any capitalization may +be used." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-babel-noweb-wrap-start "<<" + "String used to begin a noweb reference in a code block. +See also `org-babel-noweb-wrap-end'." + :group 'org-babel + :type 'string) + +(defcustom org-babel-noweb-wrap-end ">>" + "String used to end a noweb reference in a code block. +See also `org-babel-noweb-wrap-start'." + :group 'org-babel + :type 'string) + +(defun org-babel-noweb-wrap (&optional regexp) + (concat org-babel-noweb-wrap-start + (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") + org-babel-noweb-wrap-end)) + +(defvar org-babel-src-name-regexp + "^[ \t]*#\\+name:[ \t]*" + "Regular expression used to match a source name line.") + +(defvar org-babel-multi-line-header-regexp + "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$" + "Regular expression used to match multi-line header arguments.") + +(defvar org-babel-src-name-w-name-regexp + (concat org-babel-src-name-regexp + "\\(" + org-babel-multi-line-header-regexp + "\\)*" + "\\([^ ()\f\t\n\r\v]+\\)") + "Regular expression matching source name lines with a name.") + +(defvar org-babel-src-block-regexp + (concat + ;; (1) indentation (2) lang + "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*" + ;; (3) switches + "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)" + ;; (4) header arguments + "\\([^\n]*\\)\n" + ;; (5) body + "\\([^\000]*?\n\\)?[ \t]*#\\+end_src") + "Regexp used to identify code blocks.") + +(defvar org-babel-inline-src-block-regexp + (concat + ;; (1) replacement target (2) lang + "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)" + ;; (3,4) (unused, headers) + "\\(\\|\\[\\(.*?\\)\\]\\)" + ;; (5) body + "{\\([^\f\n\r\v]+?\\)}\\)") + "Regexp used to identify inline src-blocks.") + +(defun org-babel-get-header (params key &optional others) + "Select only header argument of type KEY from a list. +Optional argument OTHERS indicates that only the header that do +not match KEY should be returned." + (delq nil + (mapcar + (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p)) + params))) + +(defun org-babel-get-inline-src-block-matches() + "Set match data if within body of an inline source block. +Returns non-nil if match-data set" + (let ((src-at-0-p (save-excursion + (beginning-of-line 1) + (string= "src" (thing-at-point 'word)))) + (first-line-p (= 1 (line-number-at-pos))) + (orig (point))) + (let ((search-for (cond ((and src-at-0-p first-line-p "src_")) + (first-line-p "[[:punct:] \t]src_") + (t "[[:punct:] \f\t\n\r\v]src_"))) + (lower-limit (if first-line-p + nil + (- (point-at-bol) 1)))) + (save-excursion + (when (or (and src-at-0-p (bobp)) + (and (re-search-forward "}" (point-at-eol) t) + (re-search-backward search-for lower-limit t) + (> orig (point)))) + (when (looking-at org-babel-inline-src-block-regexp) + t )))))) + +(defvar org-babel-inline-lob-one-liner-regexp) +(defun org-babel-get-lob-one-liner-matches() + "Set match data if on line of an lob one liner. +Returns non-nil if match-data set" + (save-excursion + (unless (= (point) (point-at-bol)) ;; move before inline block + (re-search-backward "[ \f\t\n\r\v]" nil t)) + (if (looking-at org-babel-inline-lob-one-liner-regexp) + t + nil))) + +(defun org-babel-get-src-block-info (&optional light) + "Get information on the current source block. + +Optional argument LIGHT does not resolve remote variable +references; a process which could likely result in the execution +of other code blocks. + +Returns a list + (language body header-arguments-alist switches name indent)." + (let ((case-fold-search t) head info name indent) + ;; full code block + (if (setq head (org-babel-where-is-src-block-head)) + (save-excursion + (goto-char head) + (setq info (org-babel-parse-src-block-match)) + (setq indent (car (last info))) + (setq info (butlast info)) + (while (and (forward-line -1) + (looking-at org-babel-multi-line-header-regexp)) + (setf (nth 2 info) + (org-babel-merge-params + (nth 2 info) + (org-babel-parse-header-arguments (match-string 1))))) + (when (looking-at org-babel-src-name-w-name-regexp) + (setq name (org-no-properties (match-string 3))))) + ;; inline source block + (when (org-babel-get-inline-src-block-matches) + (setq info (org-babel-parse-inline-src-block-match)))) + ;; resolve variable references and add summary parameters + (when (and info (not light)) + (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) + (when info (append info (list name indent))))) + +(defvar org-current-export-file) ; dynamically bound +(defmacro org-babel-check-confirm-evaluate (info &rest body) + "Evaluate BODY with special execution confirmation variables set. + +Specifically; NOEVAL will indicate if evaluation is allowed, +QUERY will indicate if a user query is required, CODE-BLOCK will +hold the language of the code block, and BLOCK-NAME will hold the +name of the code block." + (declare (indent defun)) + (org-with-gensyms + (lang block-body headers name eval eval-no export eval-no-export) + `(let* ((,lang (nth 0 ,info)) + (,block-body (nth 1 ,info)) + (,headers (nth 2 ,info)) + (,name (nth 4 ,info)) + (,eval (or (cdr (assoc :eval ,headers)) + (when (assoc :noeval ,headers) "no"))) + (,eval-no (or (equal ,eval "no") + (equal ,eval "never"))) + (,export (org-bound-and-true-p org-current-export-file)) + (,eval-no-export (and ,export (or (equal ,eval "no-export") + (equal ,eval "never-export")))) + (noeval (or ,eval-no ,eval-no-export)) + (query (or (equal ,eval "query") + (and ,export (equal ,eval "query-export")) + (when (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))) + +(defsubst org-babel-check-evaluate (info) + "Check if code block INFO should be evaluated. +Do not query the user." + (org-babel-check-confirm-evaluate info + (not (when noeval + (message (format "Evaluation of this%scode-block%sis disabled." + code-block block-name)))))) + + ;; dynamically scoped for asynchroneous export +(defvar org-babel-confirm-evaluate-answer-no) + +(defsubst org-babel-confirm-evaluate (info) + "Confirm evaluation of the code block INFO. + +If the variable `org-babel-confirm-evaluate-answer-no' is bound +to a non-nil value, auto-answer with \"no\". + +This query can also be suppressed by setting the value of +`org-confirm-babel-evaluate' to nil, in which case all future +interactive code block evaluations will proceed without any +confirmation from the user. + +Note disabling confirmation may result in accidental evaluation +of potentially harmful code." + (org-babel-check-confirm-evaluate info + (not (when query + (unless + (and (not (org-bound-and-true-p + org-babel-confirm-evaluate-answer-no)) + (yes-or-no-p + (format "Evaluate this%scode block%son your system? " + code-block block-name))) + (message (format "Evaluation of this%scode-block%sis aborted." + code-block block-name))))))) + +;;;###autoload +(defun org-babel-execute-safely-maybe () + (unless org-babel-no-eval-on-ctrl-c-ctrl-c + (org-babel-execute-maybe))) + +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe) + +;;;###autoload +(defun org-babel-execute-maybe () + (interactive) + (or (org-babel-execute-src-block-maybe) + (org-babel-lob-execute-maybe))) + +(defmacro org-babel-when-in-src-block (&rest body) + "Execute BODY if point is in a source block and return t. + +Otherwise do nothing and return nil." + `(if (or (org-babel-where-is-src-block-head) + (org-babel-get-inline-src-block-matches)) + (progn + ,@body + t) + nil)) + +(defun org-babel-execute-src-block-maybe () + "Conditionally execute a source block. +Detect if this is context for a Babel src-block and if so +then run `org-babel-execute-src-block'." + (interactive) + (org-babel-when-in-src-block + (org-babel-eval-wipe-error-buffer) + (org-babel-execute-src-block current-prefix-arg))) + +;;;###autoload +(defun org-babel-view-src-block-info () + "Display information on the current source block. +This includes header arguments, language and name, and is largely +a window into the `org-babel-get-src-block-info' function." + (interactive) + (let ((info (org-babel-get-src-block-info 'light)) + (full (lambda (it) (> (length it) 0))) + (printf (lambda (fmt &rest args) (princ (apply #'format fmt args))))) + (when info + (with-help-window (help-buffer) + (let ((name (nth 4 info)) + (lang (nth 0 info)) + (switches (nth 3 info)) + (header-args (nth 2 info))) + (when name (funcall printf "Name: %s\n" name)) + (when lang (funcall printf "Lang: %s\n" lang)) + (when (funcall full switches) (funcall printf "Switches: %s\n" switches)) + (funcall printf "Header Arguments:\n") + (dolist (pair (sort header-args + (lambda (a b) (string< (symbol-name (car a)) + (symbol-name (car b)))))) + (when (funcall full (cdr pair)) + (funcall printf "\t%S%s\t%s\n" + (car pair) + (if (> (length (format "%S" (car pair))) 7) "" "\t") + (cdr pair))))))))) + +;;;###autoload +(defun org-babel-expand-src-block-maybe () + "Conditionally expand a source block. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-expand-src-block'." + (interactive) + (org-babel-when-in-src-block + (org-babel-expand-src-block current-prefix-arg))) + +;;;###autoload +(defun org-babel-load-in-session-maybe () + "Conditionally load a source block in a session. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-load-in-session'." + (interactive) + (org-babel-when-in-src-block + (org-babel-load-in-session current-prefix-arg))) + +(add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe) + +;;;###autoload +(defun org-babel-pop-to-session-maybe () + "Conditionally pop to a session. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-switch-to-session'." + (interactive) + (org-babel-when-in-src-block + (org-babel-switch-to-session current-prefix-arg))) + +(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe) + +(defconst org-babel-common-header-args-w-values + '((cache . ((no yes))) + (cmdline . :any) + (colnames . ((nil no yes))) + (comments . ((no link yes org both noweb))) + (dir . :any) + (eval . ((never query))) + (exports . ((code results both none))) + (file . :any) + (file-desc . :any) + (hlines . ((no yes))) + (mkdirp . ((yes no))) + (no-expand) + (noeval) + (noweb . ((yes no tangle no-export strip-export))) + (noweb-ref . :any) + (noweb-sep . :any) + (padline . ((yes no))) + (post . :any) + (results . ((file list vector table scalar verbatim) + (raw html latex org code pp drawer) + (replace silent none append prepend) + (output value))) + (rownames . ((no yes))) + (sep . :any) + (session . :any) + (shebang . :any) + (tangle . ((tangle yes no :any))) + (var . :any) + (wrap . :any))) + +(defconst org-babel-header-arg-names + (mapcar #'car org-babel-common-header-args-w-values) + "Common header arguments used by org-babel. +Note that individual languages may define their own language +specific header arguments as well.") + +(defvar org-babel-default-header-args + '((:session . "none") (:results . "replace") (:exports . "code") + (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no") + (:padnewline . "yes")) + "Default arguments to use when evaluating a source block.") + +(defvar org-babel-default-inline-header-args + '((:session . "none") (:results . "replace") (:exports . "results")) + "Default arguments to use when evaluating an inline source block.") + +(defvar org-babel-data-names '("tblname" "results" "name")) + +(defvar org-babel-result-regexp + (concat "^[ \t]*#\\+" + (regexp-opt org-babel-data-names t) + "\\(\\[\\(" + ;; FIXME The string below is `org-ts-regexp' + "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" + " \\)?\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*") + "Regular expression used to match result lines. +If the results are associated with a hash key then the hash will +be saved in the second match data.") + +(defvar org-babel-result-w-name-regexp + (concat org-babel-result-regexp + "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")) + +(defvar org-babel-min-lines-for-block-output 10 + "The minimum number of lines for block output. +If number of lines of output is equal to or exceeds this +value, the output is placed in a #+begin_example...#+end_example +block. Otherwise the output is marked as literal by inserting +colons at the starts of the lines. This variable only takes +effect if the :results output option is in effect.") + +(defvar org-babel-noweb-error-langs nil + "Languages for which Babel will raise literate programming errors. +List of languages for which errors should be raised when the +source code block satisfying a noweb reference in this language +can not be resolved.") + +(defvar org-babel-hash-show 4 + "Number of initial characters to show of a hidden results hash.") + +(defvar org-babel-hash-show-time nil + "Non-nil means show the time the code block was evaluated in the result hash.") + +(defvar org-babel-after-execute-hook nil + "Hook for functions to be called after `org-babel-execute-src-block'") + +(defun org-babel-named-src-block-regexp-for-name (name) + "This generates a regexp used to match a src block named NAME." + (concat org-babel-src-name-regexp (regexp-quote name) + "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*" + (substring org-babel-src-block-regexp 1))) + +(defun org-babel-named-data-regexp-for-name (name) + "This generates a regexp used to match data named NAME." + (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)")) + +;;; functions +(defvar call-process-region) + +;;;###autoload +(defun org-babel-execute-src-block (&optional arg info params) + "Execute the current source code block. +Insert the results of execution into the buffer. Source code +execution and the collection and formatting of results can be +controlled through a variety of header arguments. + +With prefix argument ARG, force re-execution even if an existing +result cached in the buffer would otherwise have been returned. + +Optionally supply a value for INFO in the form returned by +`org-babel-get-src-block-info'. + +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 + (copy-tree info) + (org-babel-get-src-block-info))) + (merged-params (org-babel-merge-params (nth 2 info) params))) + (when (org-babel-check-evaluate + (let ((i info)) (setf (nth 2 i) merged-params) i)) + (let* ((params (if params + (org-babel-process-params merged-params) + (nth 2 info))) + (cachep (and (not arg) (cdr (assoc :cache params)) + (string= "yes" (cdr (assoc :cache params))))) + (new-hash (when cachep (org-babel-sha1-hash info))) + (old-hash (when cachep (org-babel-current-result-hash))) + (cache-current-p (and (not arg) new-hash + (equal new-hash old-hash)))) + (cond + (cache-current-p + (save-excursion ;; return cached result + (goto-char (org-babel-where-is-src-block-result nil info)) + (end-of-line 1) (forward-char 1) + (let ((result (org-babel-read-result))) + (message (replace-regexp-in-string + "%" "%%" (format "%S" result))) result))) + ((org-babel-confirm-evaluate + (let ((i info)) (setf (nth 2 i) merged-params) i)) + (let* ((lang (nth 0 info)) + (result-params (cdr (assoc :result-params params))) + (body (setf (nth 1 info) + (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory (expand-file-name dir))) + default-directory)) + (org-babel-call-process-region-original ;; for tramp handler + (or (org-bound-and-true-p + org-babel-call-process-region-original) + (symbol-function 'call-process-region))) + (indent (car (last info))) + result cmd) + (unwind-protect + (let ((call-process-region + (lambda (&rest args) + (apply 'org-babel-tramp-handle-call-process-region + args)))) + (let ((lang-check + (lambda (f) + (let ((f (intern (concat "org-babel-execute:" f)))) + (when (fboundp f) f))))) + (setq cmd + (or (funcall lang-check lang) + (funcall lang-check + (symbol-name + (cdr (assoc lang org-src-lang-modes)))) + (error "No org-babel-execute function for %s!" + lang)))) + (message "executing %s code block%s..." + (capitalize lang) + (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) + (if (member "none" result-params) + (progn + (funcall cmd body params) + (message "result silenced")) + (setq result + ((lambda (result) + (if (and (eq (cdr (assoc :result-type params)) + 'value) + (or (member "vector" result-params) + (member "table" result-params)) + (not (listp result))) + (list (list result)) result)) + (funcall cmd body params))) + ;; if non-empty result and :file then write to :file + (when (cdr (assoc :file params)) + (when result + (with-temp-file (cdr (assoc :file params)) + (insert + (org-babel-format-result + result (cdr (assoc :sep (nth 2 info))))))) + (setq result (cdr (assoc :file params)))) + ;; possibly perform post process provided its appropriate + (when (cdr (assoc :post params)) + (let ((*this* (if (cdr (assoc :file params)) + (org-babel-result-to-file + (cdr (assoc :file params)) + (when (assoc :file-desc params) + (or (cdr (assoc :file-desc params)) + result))) + result))) + (setq result (org-babel-ref-resolve + (cdr (assoc :post params)))) + (when (cdr (assoc :file params)) + (setq result-params + (remove "file" result-params))))) + (org-babel-insert-result + result result-params info new-hash indent lang) + (run-hooks 'org-babel-after-execute-hook) + result)) + (setq call-process-region + 'org-babel-call-process-region-original))))))))) + +(defun org-babel-expand-body:generic (body params &optional var-lines) + "Expand BODY with PARAMS. +Expand a block of code with org-babel according to its header +arguments. This generic implementation of body expansion is +called for languages which have not defined their own specific +org-babel-expand-body:lang function." + (mapconcat #'identity (append var-lines (list body)) "\n")) + +;;;###autoload +(defun org-babel-expand-src-block (&optional arg info params) + "Expand the current source code block. +Expand according to the source code block's header +arguments and pop open the results in a preview buffer." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + (lang (nth 0 info)) + (params (setf (nth 2 info) + (sort (org-babel-merge-params (nth 2 info) params) + (lambda (el1 el2) (string< (symbol-name (car el1)) + (symbol-name (car el2))))))) + (body (setf (nth 1 info) + (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) (nth 1 info)))) + (expand-cmd (intern (concat "org-babel-expand-body:" lang))) + (assignments-cmd (intern (concat "org-babel-variable-assignments:" + lang))) + (expanded + (if (fboundp expand-cmd) (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params (and (fboundp assignments-cmd) + (funcall assignments-cmd params)))))) + (if (called-interactively-p 'any) + (org-edit-src-code + nil expanded + (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")) + expanded))) + +(defun org-babel-edit-distance (s1 s2) + "Return the edit (levenshtein) distance between strings S1 S2." + (let* ((l1 (length s1)) + (l2 (length s2)) + (dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil)) + (number-sequence 1 (1+ l1))))) + (in (lambda (i j) (aref (aref dist i) j)))) + (setf (aref (aref dist 0) 0) 0) + (dolist (j (number-sequence 1 l2)) + (setf (aref (aref dist 0) j) j)) + (dolist (i (number-sequence 1 l1)) + (setf (aref (aref dist i) 0) i) + (dolist (j (number-sequence 1 l2)) + (setf (aref (aref dist i) j) + (min + (1+ (funcall in (1- i) j)) + (1+ (funcall in i (1- j))) + (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1) + (funcall in (1- i) (1- j))))))) + (funcall in l1 l2))) + +(defun org-babel-combine-header-arg-lists (original &rest others) + "Combine a number of lists of header argument names and arguments." + (let ((results (copy-sequence original))) + (dolist (new-list others) + (dolist (arg-pair new-list) + (let ((header (car arg-pair)) + (args (cdr arg-pair))) + (setq results + (cons arg-pair (org-remove-if + (lambda (pair) (equal header (car pair))) + results)))))) + results)) + +;;;###autoload +(defun org-babel-check-src-block () + "Check for misspelled header arguments in the current code block." + (interactive) + ;; TODO: report malformed code block + ;; TODO: report incompatible combinations of header arguments + ;; TODO: report uninitialized variables + (let ((too-close 2) ;; <- control closeness to report potential match + (names (mapcar #'symbol-name org-babel-header-arg-names))) + (dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1)) + (and (org-babel-where-is-src-block-head) + (org-babel-parse-header-arguments + (org-no-properties + (match-string 4)))))) + (dolist (name names) + (when (and (not (string= header name)) + (<= (org-babel-edit-distance header name) too-close) + (not (member header names))) + (error "Supplied header \"%S\" is suspiciously close to \"%S\"" + header name)))) + (message "No suspicious header arguments found."))) + +;;;###autoload +(defun org-babel-insert-header-arg () + "Insert a header argument selecting from lists of common args and values." + (interactive) + (let* ((lang (car (org-babel-get-src-block-info 'light))) + (lang-headers (intern (concat "org-babel-header-args:" lang))) + (headers (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (if (boundp lang-headers) (eval lang-headers) nil))) + (arg (org-icompleting-read + "Header Arg: " + (mapcar + (lambda (header-spec) (symbol-name (car header-spec))) + headers)))) + (insert ":" arg) + (let ((vals (cdr (assoc (intern arg) headers)))) + (when vals + (insert + " " + (cond + ((eq vals :any) + (read-from-minibuffer "value: ")) + ((listp vals) + (mapconcat + (lambda (group) + (let ((arg (org-icompleting-read + "value: " + (cons "default" (mapcar #'symbol-name group))))) + (if (and arg (not (string= "default" arg))) + (concat arg " ") + ""))) + vals "")))))))) + +;; Add support for completing-read insertion of header arguments after ":" +(defun org-babel-header-arg-expand () + "Call `org-babel-enter-header-arg-w-completion' in appropriate contexts." + (when (and (equal (char-before) ?\:) (org-babel-where-is-src-block-head)) + (org-babel-enter-header-arg-w-completion (match-string 2)))) + +(defun org-babel-enter-header-arg-w-completion (&optional lang) + "Insert header argument appropriate for LANG with completion." + (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang))) + (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var))) + (headers-w-values (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values lang-headers)) + (headers (mapcar #'symbol-name (mapcar #'car headers-w-values))) + (header (org-completing-read "Header Arg: " headers)) + (args (cdr (assoc (intern header) headers-w-values))) + (arg (when (and args (listp args)) + (org-completing-read + (format "%s: " header) + (mapcar #'symbol-name (apply #'append args)))))) + (insert (concat header " " (or arg ""))) + (cons header arg))) + +(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand) + +;;;###autoload +(defun org-babel-load-in-session (&optional arg info) + "Load the body of the current source-code block. +Evaluate the header arguments for the source block before +entering the session. After loading the body this pops open the +session." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + (lang (nth 0 info)) + (params (nth 2 info)) + (body (if (not info) + (user-error "No src code block at point") + (setf (nth 1 info) + (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) + (nth 1 info))))) + (session (cdr (assoc :session params))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory dir)) default-directory)) + (cmd (intern (concat "org-babel-load-session:" lang)))) + (unless (fboundp cmd) + (error "No org-babel-load-session function for %s!" lang)) + (pop-to-buffer (funcall cmd session body params)) + (end-of-line 1))) + +;;;###autoload +(defun org-babel-initiate-session (&optional arg info) + "Initiate session for current code block. +If called with a prefix argument then resolve any variable +references in the header arguments and assign these variables in +the session. Copy the body of the code block to the kill ring." + (interactive "P") + (let* ((info (or info (org-babel-get-src-block-info (not arg)))) + (lang (nth 0 info)) + (body (nth 1 info)) + (params (nth 2 info)) + (session (cdr (assoc :session params))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory dir)) default-directory)) + (init-cmd (intern (format "org-babel-%s-initiate-session" lang))) + (prep-cmd (intern (concat "org-babel-prep-session:" lang)))) + (if (and (stringp session) (string= session "none")) + (error "This block is not using a session!")) + (unless (fboundp init-cmd) + (error "No org-babel-initiate-session function for %s!" lang)) + (with-temp-buffer (insert (org-babel-trim body)) + (copy-region-as-kill (point-min) (point-max))) + (when arg + (unless (fboundp prep-cmd) + (error "No org-babel-prep-session function for %s!" lang)) + (funcall prep-cmd session params)) + (funcall init-cmd session params))) + +;;;###autoload +(defun org-babel-switch-to-session (&optional arg info) + "Switch to the session of the current code block. +Uses `org-babel-initiate-session' to start the session. If called +with a prefix argument then this is passed on to +`org-babel-initiate-session'." + (interactive "P") + (pop-to-buffer (org-babel-initiate-session arg info)) + (end-of-line 1)) + +(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) + +;;;###autoload +(defun org-babel-switch-to-session-with-code (&optional arg info) + "Switch to code buffer and display session." + (interactive "P") + (let ((swap-windows + (lambda () + (let ((other-window-buffer (window-buffer (next-window)))) + (set-window-buffer (next-window) (current-buffer)) + (set-window-buffer (selected-window) other-window-buffer)) + (other-window 1))) + (info (org-babel-get-src-block-info)) + (org-src-window-setup 'reorganize-frame)) + (save-excursion + (org-babel-switch-to-session arg info)) + (org-edit-src-code) + (funcall swap-windows))) + +(defmacro org-babel-do-in-edit-buffer (&rest body) + "Evaluate BODY in edit buffer if there is a code block at point. +Return t if a code block was found at point, nil otherwise." + `(let ((org-src-window-setup 'switch-invisibly)) + (when (and (org-babel-where-is-src-block-head) + (org-edit-src-code nil nil nil)) + (unwind-protect (progn ,@body) + (if (org-bound-and-true-p org-edit-src-from-org-mode) + (org-edit-src-exit))) + t))) +(def-edebug-spec org-babel-do-in-edit-buffer (body)) + +(defun org-babel-do-key-sequence-in-edit-buffer (key) + "Read key sequence and execute the command in edit buffer. +Enter a key sequence to be executed in the language major-mode +edit buffer. For example, TAB will alter the contents of the +Org-mode code block according to the effect of TAB in the +language major-mode buffer. For languages that support +interactive sessions, this can be used to send code from the Org +buffer to the session for evaluation using the native major-mode +evaluation mechanisms." + (interactive "kEnter key-sequence to execute in edit buffer: ") + (org-babel-do-in-edit-buffer + (call-interactively + (key-binding (or key (read-key-sequence nil)))))) + +(defvar org-bracket-link-regexp) + +;;;###autoload +(defun org-babel-open-src-block-result (&optional re-run) + "If `point' is on a src block then open the results of the +source code block, otherwise return nil. With optional prefix +argument RE-RUN the source-code block is evaluated even if +results already exist." + (interactive "P") + (let ((info (org-babel-get-src-block-info))) + (when info + (save-excursion + ;; go to the results, if there aren't any then run the block + (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result)) + (progn (org-babel-execute-src-block) + (org-babel-where-is-src-block-result)))) + (end-of-line 1) + (while (looking-at "[\n\r\t\f ]") (forward-char 1)) + ;; open the results + (if (looking-at org-bracket-link-regexp) + ;; file results + (org-open-at-point) + (let ((r (org-babel-format-result + (org-babel-read-result) (cdr (assoc :sep (nth 2 info)))))) + (pop-to-buffer (get-buffer-create "*Org-Babel Results*")) + (delete-region (point-min) (point-max)) + (insert r))) + t)))) + +;;;###autoload +(defmacro org-babel-map-src-blocks (file &rest body) + "Evaluate BODY forms on each source-block in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer. During evaluation of BODY the following local variables +are set relative to the currently matched code block. + +full-block ------- string holding the entirety of the code block +beg-block -------- point at the beginning of the code block +end-block -------- point at the end of the matched code block +lang ------------- string holding the language of the code block +beg-lang --------- point at the beginning of the lang +end-lang --------- point at the end of the lang +switches --------- string holding the switches +beg-switches ----- point at the beginning of the switches +end-switches ----- point at the end of the switches +header-args ------ string holding the header-args +beg-header-args -- point at the beginning of the header-args +end-header-args -- point at the end of the header-args +body ------------- string holding the body of the code block +beg-body --------- point at the beginning of the body +end-body --------- point at the end of the body" + (declare (indent 1)) + (let ((tempvar (make-symbol "file"))) + `(let* ((,tempvar ,file) + (visited-p (or (null ,tempvar) + (get-file-buffer (expand-file-name ,tempvar)))) + (point (point)) to-be-removed) + (save-window-excursion + (when ,tempvar (find-file ,tempvar)) + (setq to-be-removed (current-buffer)) + (goto-char (point-min)) + (while (re-search-forward org-babel-src-block-regexp nil t) + (goto-char (match-beginning 0)) + (let ((full-block (match-string 0)) + (beg-block (match-beginning 0)) + (end-block (match-end 0)) + (lang (match-string 2)) + (beg-lang (match-beginning 2)) + (end-lang (match-end 2)) + (switches (match-string 3)) + (beg-switches (match-beginning 3)) + (end-switches (match-end 3)) + (header-args (match-string 4)) + (beg-header-args (match-beginning 4)) + (end-header-args (match-end 4)) + (body (match-string 5)) + (beg-body (match-beginning 5)) + (end-body (match-end 5))) + ,@body + (goto-char end-block)))) + (unless visited-p (kill-buffer to-be-removed)) + (goto-char point)))) +(def-edebug-spec org-babel-map-src-blocks (form body)) + +;;;###autoload +(defmacro org-babel-map-inline-src-blocks (file &rest body) + "Evaluate BODY forms on each inline source-block in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer." + (declare (indent 1)) + (let ((tempvar (make-symbol "file"))) + `(let* ((,tempvar ,file) + (visited-p (or (null ,tempvar) + (get-file-buffer (expand-file-name ,tempvar)))) + (point (point)) to-be-removed) + (save-window-excursion + (when ,tempvar (find-file ,tempvar)) + (setq to-be-removed (current-buffer)) + (goto-char (point-min)) + (while (re-search-forward org-babel-inline-src-block-regexp nil t) + (goto-char (match-beginning 1)) + (save-match-data ,@body) + (goto-char (match-end 0)))) + (unless visited-p (kill-buffer to-be-removed)) + (goto-char point)))) +(def-edebug-spec org-babel-map-inline-src-blocks (form body)) + +(defvar org-babel-lob-one-liner-regexp) + +;;;###autoload +(defmacro org-babel-map-call-lines (file &rest body) + "Evaluate BODY forms on each call line in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer." + (declare (indent 1)) + (let ((tempvar (make-symbol "file"))) + `(let* ((,tempvar ,file) + (visited-p (or (null ,tempvar) + (get-file-buffer (expand-file-name ,tempvar)))) + (point (point)) to-be-removed) + (save-window-excursion + (when ,tempvar (find-file ,tempvar)) + (setq to-be-removed (current-buffer)) + (goto-char (point-min)) + (while (re-search-forward org-babel-lob-one-liner-regexp nil t) + (goto-char (match-beginning 1)) + (save-match-data ,@body) + (goto-char (match-end 0)))) + (unless visited-p (kill-buffer to-be-removed)) + (goto-char point)))) +(def-edebug-spec org-babel-map-call-lines (form body)) + +;;;###autoload +(defmacro org-babel-map-executables (file &rest body) + (declare (indent 1)) + (let ((tempvar (make-symbol "file")) + (rx (make-symbol "rx"))) + `(let* ((,tempvar ,file) + (,rx (concat "\\(" org-babel-src-block-regexp + "\\|" org-babel-inline-src-block-regexp + "\\|" org-babel-lob-one-liner-regexp "\\)")) + (visited-p (or (null ,tempvar) + (get-file-buffer (expand-file-name ,tempvar)))) + (point (point)) to-be-removed) + (save-window-excursion + (when ,tempvar (find-file ,tempvar)) + (setq to-be-removed (current-buffer)) + (goto-char (point-min)) + (while (re-search-forward ,rx nil t) + (goto-char (match-beginning 1)) + (when (looking-at org-babel-inline-src-block-regexp)(forward-char 1)) + (save-match-data ,@body) + (goto-char (match-end 0)))) + (unless visited-p (kill-buffer to-be-removed)) + (goto-char point)))) +(def-edebug-spec org-babel-map-executables (form body)) + +;;;###autoload +(defun org-babel-execute-buffer (&optional arg) + "Execute source code blocks in a buffer. +Call `org-babel-execute-src-block' on every source block in +the current buffer." + (interactive "P") + (org-babel-eval-wipe-error-buffer) + (org-save-outline-visibility t + (org-babel-map-executables nil + (if (looking-at org-babel-lob-one-liner-regexp) + (org-babel-lob-execute-maybe) + (org-babel-execute-src-block arg))))) + +;;;###autoload +(defun org-babel-execute-subtree (&optional arg) + "Execute source code blocks in a subtree. +Call `org-babel-execute-src-block' on every source block in +the current subtree." + (interactive "P") + (save-restriction + (save-excursion + (org-narrow-to-subtree) + (org-babel-execute-buffer arg) + (widen)))) + +;;;###autoload +(defun org-babel-sha1-hash (&optional info) + "Generate an sha1 hash based on the value of info." + (interactive) + (let ((print-level nil) + (info (or info (org-babel-get-src-block-info)))) + (setf (nth 2 info) + (sort (copy-sequence (nth 2 info)) + (lambda (a b) (string< (car a) (car b))))) + (let* ((rm (lambda (lst) + (dolist (p '("replace" "silent" "none" + "append" "prepend")) + (setq lst (remove p lst))) + lst)) + (norm (lambda (arg) + (let ((v (if (and (listp (cdr arg)) (null (cddr arg))) + (copy-sequence (cdr arg)) + (cdr arg)))) + (when (and v (not (and (sequencep v) + (not (consp v)) + (= (length v) 0)))) + (cond + ((and (listp v) ; lists are sorted + (member (car arg) '(:result-params))) + (sort (funcall rm v) #'string<)) + ((and (stringp v) ; strings are sorted + (member (car arg) '(:results :exports))) + (mapconcat #'identity (sort (funcall rm (split-string v)) + #'string<) " ")) + (t v))))))) + ((lambda (hash) + (when (org-called-interactively-p 'interactive) (message hash)) hash) + (let ((it (format "%s-%s" + (mapconcat + #'identity + (delq nil (mapcar (lambda (arg) + (let ((normalized (funcall norm arg))) + (when normalized + (format "%S" normalized)))) + (nth 2 info))) ":") + (nth 1 info)))) + (sha1 it)))))) + +(defun org-babel-current-result-hash () + "Return the current in-buffer hash." + (org-babel-where-is-src-block-result) + (org-no-properties (match-string 5))) + +(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) + (org-babel-hide-hash))) + +(defun org-babel-hide-hash () + "Hide the hash in the current results line. +Only the initial `org-babel-hash-show' characters of the hash +will remain visible." + (add-to-invisibility-spec '(org-babel-hide-hash . t)) + (save-excursion + (when (and (re-search-forward org-babel-result-regexp nil t) + (match-string 5)) + (let* ((start (match-beginning 5)) + (hide-start (+ org-babel-hash-show start)) + (end (match-end 5)) + (hash (match-string 5)) + ov1 ov2) + (setq ov1 (make-overlay start hide-start)) + (setq ov2 (make-overlay hide-start end)) + (overlay-put ov2 'invisible 'org-babel-hide-hash) + (overlay-put ov1 'babel-hash hash))))) + +(defun org-babel-hide-all-hashes () + "Hide the hash in the current buffer. +Only the initial `org-babel-hash-show' characters of each hash +will remain visible. This function should be called as part of +the `org-mode-hook'." + (save-excursion + (while (and (not org-babel-hash-show-time) + (re-search-forward org-babel-result-regexp nil t)) + (goto-char (match-beginning 0)) + (org-babel-hide-hash) + (goto-char (match-end 0))))) +(add-hook 'org-mode-hook 'org-babel-hide-all-hashes) + +(defun org-babel-hash-at-point (&optional point) + "Return the value of the hash at POINT. +The hash is also added as the last element of the kill ring. +This can be called with C-c C-c." + (interactive) + (let ((hash (car (delq nil (mapcar + (lambda (ol) (overlay-get ol 'babel-hash)) + (overlays-at (or point (point)))))))) + (when hash (kill-new hash) (message hash)))) +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point) + +(defun org-babel-result-hide-spec () + "Hide portions of results lines. +Add `org-babel-hide-result' as an invisibility spec for hiding +portions of results lines." + (add-to-invisibility-spec '(org-babel-hide-result . t))) +(add-hook 'org-mode-hook 'org-babel-result-hide-spec) + +(defvar org-babel-hide-result-overlays nil + "Overlays hiding results.") + +(defun org-babel-result-hide-all () + "Fold all results in the current buffer." + (interactive) + (org-babel-show-result-all) + (save-excursion + (while (re-search-forward org-babel-result-regexp nil t) + (save-excursion (goto-char (match-beginning 0)) + (org-babel-hide-result-toggle-maybe))))) + +(defun org-babel-show-result-all () + "Unfold all results in the current buffer." + (mapc 'delete-overlay org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays nil)) + +;;;###autoload +(defun org-babel-hide-result-toggle-maybe () + "Toggle visibility of result at point." + (interactive) + (let ((case-fold-search t)) + (if (save-excursion + (beginning-of-line 1) + (looking-at org-babel-result-regexp)) + (progn (org-babel-hide-result-toggle) + t) ;; to signal that we took action + nil))) ;; to signal that we did not + +(defun org-babel-hide-result-toggle (&optional force) + "Toggle the visibility of the current result." + (interactive) + (save-excursion + (beginning-of-line) + (if (re-search-forward org-babel-result-regexp nil t) + (let ((start (progn (beginning-of-line 2) (- (point) 1))) + (end (progn + (while (looking-at org-babel-multi-line-header-regexp) + (forward-line 1)) + (goto-char (- (org-babel-result-end) 1)) (point))) + ov) + (if (memq t (mapcar (lambda (overlay) + (eq (overlay-get overlay 'invisible) + 'org-babel-hide-result)) + (overlays-at start))) + (if (or (not force) (eq force 'off)) + (mapc (lambda (ov) + (when (member ov org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays + (delq ov org-babel-hide-result-overlays))) + (when (eq (overlay-get ov 'invisible) + 'org-babel-hide-result) + (delete-overlay ov))) + (overlays-at start))) + (setq ov (make-overlay start end)) + (overlay-put ov 'invisible 'org-babel-hide-result) + ;; make the block accessible to isearch + (overlay-put + ov 'isearch-open-invisible + (lambda (ov) + (when (member ov org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays + (delq ov org-babel-hide-result-overlays))) + (when (eq (overlay-get ov 'invisible) + 'org-babel-hide-result) + (delete-overlay ov)))) + (push ov org-babel-hide-result-overlays))) + (error "Not looking at a result line")))) + +;; org-tab-after-check-for-cycling-hook +(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe) +;; Remove overlays when changing major mode +(add-hook 'org-mode-hook + (lambda () (org-add-hook 'change-major-mode-hook + 'org-babel-show-result-all 'append 'local))) + +(defvar org-file-properties) +(defun org-babel-params-from-properties (&optional lang) + "Retrieve parameters specified as properties. +Return an association list of any source block params which +may be specified in the properties of the current outline entry." + (save-match-data + (let (val sym) + (org-babel-parse-multiple-vars + (delq nil + (mapcar + (lambda (header-arg) + (and (setq val (org-entry-get (point) header-arg t)) + (cons (intern (concat ":" header-arg)) + (org-babel-read val)))) + (mapcar + #'symbol-name + (mapcar + #'car + (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (progn + (setq sym (intern (concat "org-babel-header-args:" lang))) + (and (boundp sym) (eval sym)))))))))))) + +(defvar org-src-preserve-indentation) +(defun org-babel-parse-src-block-match () + "Parse the results from a match of the `org-babel-src-block-regexp'." + (let* ((block-indentation (length (match-string 1))) + (lang (org-no-properties (match-string 2))) + (lang-headers (intern (concat "org-babel-default-header-args:" lang))) + (switches (match-string 3)) + (body (org-no-properties + (let* ((body (match-string 5)) + (sub-length (- (length body) 1))) + (if (and (> sub-length 0) + (string= "\n" (substring body sub-length))) + (substring body 0 sub-length) + (or body ""))))) + (preserve-indentation (or org-src-preserve-indentation + (save-match-data + (string-match "-i\\>" switches))))) + (list lang + ;; get block body less properties, protective commas, and indentation + (with-temp-buffer + (save-match-data + (insert (org-unescape-code-in-string body)) + (unless preserve-indentation (org-do-remove-indentation)) + (buffer-string))) + (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-properties lang) + (if (boundp lang-headers) (eval lang-headers) nil) + (org-babel-parse-header-arguments + (org-no-properties (or (match-string 4) "")))) + switches + block-indentation))) + +(defun org-babel-parse-inline-src-block-match () + "Parse the results from a match of the `org-babel-inline-src-block-regexp'." + (let* ((lang (org-no-properties (match-string 2))) + (lang-headers (intern (concat "org-babel-default-header-args:" lang)))) + (list lang + (org-unescape-code-in-string (org-no-properties (match-string 5))) + (org-babel-merge-params + org-babel-default-inline-header-args + (org-babel-params-from-properties lang) + (if (boundp lang-headers) (eval lang-headers) nil) + (org-babel-parse-header-arguments + (org-no-properties (or (match-string 4) ""))))))) + +(defun org-babel-balanced-split (string alts) + "Split STRING on instances of ALTS. +ALTS is a cons of two character options where each option may be +either the numeric code of a single character or a list of +character alternatives. For example to split on balanced +instances of \"[ \t]:\" set ALTS to '((32 9) . 58)." + (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))) + (matched (lambda (ch last) + (if (consp alts) + (and (funcall matches ch (cdr alts)) + (funcall matches last (car alts))) + (funcall matches ch alts)))) + (balance 0) (last 0) + quote partial lst) + (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]: + (setq balance (+ balance + (cond ((or (equal 91 ch) (equal 40 ch)) 1) + ((or (equal 93 ch) (equal 41 ch)) -1) + (t 0)))) + (when (and (equal 34 ch) (not (equal 92 last))) + (setq quote (not quote))) + (setq partial (cons ch partial)) + (when (and (= balance 0) (not quote) (funcall matched ch last)) + (setq lst (cons (apply #'string (nreverse + (if (consp alts) + (cddr partial) + (cdr partial)))) + lst)) + (setq partial nil)) + (setq last ch)) + (string-to-list string)) + (nreverse (cons (apply #'string (nreverse partial)) lst)))) + +(defun org-babel-join-splits-near-ch (ch list) + "Join splits where \"=\" is on either end of the split." + (let ((last= (lambda (str) (= ch (aref str (1- (length str)))))) + (first= (lambda (str) (= ch (aref str 0))))) + (reverse + (org-reduce (lambda (acc el) + (let ((head (car acc))) + (if (and head (or (funcall last= head) (funcall first= el))) + (cons (concat head el) (cdr acc)) + (cons el acc)))) + list :initial-value nil)))) + +(defun org-babel-parse-header-arguments (arg-string) + "Parse a string of header arguments returning an alist." + (when (> (length arg-string) 0) + (org-babel-parse-multiple-vars + (delq nil + (mapcar + (lambda (arg) + (if (string-match + "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" + arg) + (cons (intern (match-string 1 arg)) + (org-babel-read (org-babel-chomp (match-string 2 arg)))) + (cons (intern (org-babel-chomp arg)) nil))) + ((lambda (raw) + (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw)))) + (org-babel-balanced-split arg-string '((32 9) . 58)))))))) + +(defun org-babel-parse-multiple-vars (header-arguments) + "Expand multiple variable assignments behind a single :var keyword. + +This allows expression of multiple variables with one :var as +shown below. + +#+PROPERTY: var foo=1, bar=2" + (let (results) + (mapc (lambda (pair) + (if (eq (car pair) :var) + (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results)) + (org-babel-join-splits-near-ch + 61 (org-babel-balanced-split (cdr pair) 32))) + (push pair results))) + header-arguments) + (nreverse results))) + +(defun org-babel-process-params (params) + "Expand variables in PARAMS and add summary parameters." + (let* ((processed-vars (mapcar (lambda (el) + (if (consp (cdr el)) + (cdr el) + (org-babel-ref-parse (cdr el)))) + (org-babel-get-header params :var))) + (vars-and-names (if (and (assoc :colname-names params) + (assoc :rowname-names params)) + (list processed-vars) + (org-babel-disassemble-tables + processed-vars + (cdr (assoc :hlines params)) + (cdr (assoc :colnames params)) + (cdr (assoc :rownames params))))) + (raw-result (or (cdr (assoc :results params)) "")) + (result-params (append + (split-string (if (stringp raw-result) + raw-result + (eval raw-result))) + (cdr (assoc :result-params params))))) + (append + (mapcar (lambda (var) (cons :var var)) (car vars-and-names)) + (list + (cons :colname-names (or (cdr (assoc :colname-names params)) + (cadr vars-and-names))) + (cons :rowname-names (or (cdr (assoc :rowname-names params)) + (caddr vars-and-names))) + (cons :result-params result-params) + (cons :result-type (cond ((member "output" result-params) 'output) + ((member "value" result-params) 'value) + (t 'value)))) + (org-babel-get-header params :var 'other)))) + +;; row and column names +(defun org-babel-del-hlines (table) + "Remove all 'hlines from TABLE." + (remove 'hline table)) + +(defun org-babel-get-colnames (table) + "Return the column 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." + (if (equal 'hline (nth 1 table)) + (cons (cddr table) (car table)) + (cons (cdr table) (car table)))) + +(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))))) + +(defun org-babel-put-colnames (table colnames) + "Add COLNAMES to TABLE if they exist." + (if colnames (apply 'list colnames 'hline table) table)) + +(defun org-babel-put-rownames (table rownames) + "Add ROWNAMES to TABLE if they exist." + (if rownames + (mapcar (lambda (row) + (if (listp row) + (cons (or (pop rownames) "") row) + row)) table) + table)) + +(defun org-babel-pick-name (names selector) + "Select one out of an alist of row or column names. +SELECTOR can be either a list of names in which case those names +will be returned directly, or an index into the list NAMES in +which case the indexed names will be return." + (if (listp selector) + selector + (when names + (if (and selector (symbolp selector) (not (equal t selector))) + (cdr (assoc selector names)) + (if (integerp selector) + (nth (- selector 1) names) + (cdr (car (last names)))))))) + +(defun org-babel-disassemble-tables (vars hlines colnames rownames) + "Parse tables for further processing. +Process the variables in VARS according to the HLINES, +ROWNAMES and COLNAMES header arguments. Return a list consisting +of the vars, cnames and rnames." + (let (cnames rnames) + (list + (mapcar + (lambda (var) + (when (listp (cdr var)) + (when (and (not (equal colnames "no")) + (or colnames (and (equal (nth 1 (cdr var)) 'hline) + (not (member 'hline (cddr (cdr var))))))) + (let ((both (org-babel-get-colnames (cdr var)))) + (setq cnames (cons (cons (car var) (cdr both)) + cnames)) + (setq var (cons (car var) (car both))))) + (when (and rownames (not (equal rownames "no"))) + (let ((both (org-babel-get-rownames (cdr var)))) + (setq rnames (cons (cons (car var) (cdr both)) + rnames)) + (setq var (cons (car var) (car both))))) + (when (and hlines (not (equal hlines "yes"))) + (setq var (cons (car var) (org-babel-del-hlines (cdr var)))))) + var) + vars) + (reverse cnames) (reverse rnames)))) + +(defun org-babel-reassemble-table (table colnames rownames) + "Add column and row names to a table. +Given a TABLE and set of COLNAMES and ROWNAMES add the names +to the table for reinsertion to org-mode." + (if (listp table) + ((lambda (table) + (if (and colnames (listp (car table)) (= (length (car table)) + (length colnames))) + (org-babel-put-colnames table colnames) table)) + (if (and rownames (= (length table) (length rownames))) + (org-babel-put-rownames table rownames) table)) + table)) + +(defun org-babel-where-is-src-block-head () + "Find where the current source block begins. +Return the point at the beginning of the current source +block. Specifically at the beginning of the #+BEGIN_SRC line. +If the point is not on a source block then return nil." + (let ((initial (point)) (case-fold-search t) top bottom) + (or + (save-excursion ;; on a source name line or a #+header line + (beginning-of-line 1) + (and (or (looking-at org-babel-src-name-regexp) + (looking-at org-babel-multi-line-header-regexp)) + (progn + (while (and (forward-line 1) + (or (looking-at org-babel-src-name-regexp) + (looking-at org-babel-multi-line-header-regexp)))) + (looking-at org-babel-src-block-regexp)) + (point))) + (save-excursion ;; on a #+begin_src line + (beginning-of-line 1) + (and (looking-at org-babel-src-block-regexp) + (point))) + (save-excursion ;; inside a src block + (and + (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point)) + (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point)) + (< top initial) (< initial bottom) + (progn (goto-char top) (beginning-of-line 1) + (looking-at org-babel-src-block-regexp)) + (point)))))) + +;;;###autoload +(defun org-babel-goto-src-block-head () + "Go to the beginning of the current code block." + (interactive) + ((lambda (head) + (if head (goto-char head) (error "Not currently in a code block"))) + (org-babel-where-is-src-block-head))) + +;;;###autoload +(defun org-babel-goto-named-src-block (name) + "Go to a named source-code block." + (interactive + (let ((completion-ignore-case t) + (case-fold-search t) + (under-point (thing-at-point 'line))) + (list (org-icompleting-read + "source-block name: " (org-babel-src-block-names) nil t + (cond + ;; noweb + ((string-match (org-babel-noweb-wrap) under-point) + (let ((block-name (match-string 1 under-point))) + (string-match "[^(]*" block-name) + (match-string 0 block-name))) + ;; #+call: + ((string-match org-babel-lob-one-liner-regexp under-point) + (let ((source-info (car (org-babel-lob-get-info)))) + (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info) + (let ((source-name (match-string 1 source-info))) + source-name)))) + ;; #+results: + ((string-match (concat "#\\+" org-babel-results-keyword + "\\:\s+\\([^\\(]*\\)") under-point) + (match-string 1 under-point)) + ;; symbol-at-point + ((and (thing-at-point 'symbol)) + (org-babel-find-named-block (thing-at-point 'symbol)) + (thing-at-point 'symbol)) + ("")))))) + (let ((point (org-babel-find-named-block name))) + (if point + ;; taken from `org-open-at-point' + (progn (org-mark-ring-push) (goto-char point) (org-show-context)) + (message "source-code block '%s' not found in this buffer" name)))) + +(defun org-babel-find-named-block (name) + "Find a named source-code block. +Return the location of the source block identified by source +NAME, or nil if no such block exists. Set match data according to +org-babel-named-src-block-regexp." + (save-excursion + (let ((case-fold-search t) + (regexp (org-babel-named-src-block-regexp-for-name name)) msg) + (goto-char (point-min)) + (when (or (re-search-forward regexp nil t) + (re-search-backward regexp nil t)) + (match-beginning 0))))) + +(defun org-babel-src-block-names (&optional file) + "Returns the names of source blocks in FILE or the current buffer." + (save-excursion + (when file (find-file file)) (goto-char (point-min)) + (let ((case-fold-search t) names) + (while (re-search-forward org-babel-src-name-w-name-regexp nil t) + (setq names (cons (match-string 3) names))) + names))) + +;;;###autoload +(defun org-babel-goto-named-result (name) + "Go to a named result." + (interactive + (let ((completion-ignore-case t)) + (list (org-icompleting-read "source-block name: " + (org-babel-result-names) nil t)))) + (let ((point (org-babel-find-named-result name))) + (if point + ;; taken from `org-open-at-point' + (progn (goto-char point) (org-show-context)) + (message "result '%s' not found in this buffer" name)))) + +(defun org-babel-find-named-result (name &optional point) + "Find a named result. +Return the location of the result named NAME in the current +buffer or nil if no such result exists." + (save-excursion + (let ((case-fold-search t)) + (goto-char (or point (point-min))) + (catch 'is-a-code-block + (when (re-search-forward + (concat org-babel-result-regexp + "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t) + (when (and (string= "name" (downcase (match-string 1))) + (or (beginning-of-line 1) + (looking-at org-babel-src-block-regexp) + (looking-at org-babel-multi-line-header-regexp))) + (throw 'is-a-code-block (org-babel-find-named-result name (point)))) + (beginning-of-line 0) (point)))))) + +(defun org-babel-result-names (&optional file) + "Returns the names of results in FILE or the current buffer." + (save-excursion + (when file (find-file file)) (goto-char (point-min)) + (let ((case-fold-search t) names) + (while (re-search-forward org-babel-result-w-name-regexp nil t) + (setq names (cons (match-string 4) names))) + names))) + +;;;###autoload +(defun org-babel-next-src-block (&optional arg) + "Jump to the next source block. +With optional prefix argument ARG, jump forward ARG many source blocks." + (interactive "p") + (org-next-block arg nil org-babel-src-block-regexp)) + +;;;###autoload +(defun org-babel-previous-src-block (&optional arg) + "Jump to the previous source block. +With optional prefix argument ARG, jump backward ARG many source blocks." + (interactive "p") + (org-previous-block arg org-babel-src-block-regexp)) + +(defvar org-babel-load-languages) + +;;;###autoload +(defun org-babel-mark-block () + "Mark current src block." + (interactive) + ((lambda (head) + (when head + (save-excursion + (goto-char head) + (looking-at org-babel-src-block-regexp)) + (push-mark (match-end 5) nil t) + (goto-char (match-beginning 5)))) + (org-babel-where-is-src-block-head))) + +(defun org-babel-demarcate-block (&optional arg) + "Wrap or split the code in the region or on the point. +When called from inside of a code block the current block is +split. When called from outside of a code block a new code block +is created. In both cases if the region is demarcated and if the +region is not active then the point is demarcated." + (interactive "P") + (let ((info (org-babel-get-src-block-info 'light)) + (headers (progn (org-babel-where-is-src-block-head) + (match-string 4))) + (stars (concat (make-string (or (org-current-level) 1) ?*) " "))) + (if info + (mapc + (lambda (place) + (save-excursion + (goto-char place) + (let ((lang (nth 0 info)) + (indent (make-string (nth 5 info) ? ))) + (when (string-match "^[[:space:]]*$" + (buffer-substring (point-at-bol) + (point-at-eol))) + (delete-region (point-at-bol) (point-at-eol))) + (insert (concat + (if (looking-at "^") "" "\n") + indent "#+end_src\n" + (if arg stars indent) "\n" + indent "#+begin_src " lang + (if (> (length headers) 1) + (concat " " headers) headers) + (if (looking-at "[\n\r]") + "" + (concat "\n" (make-string (current-column) ? ))))))) + (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))) + (body (delete-and-extract-region + (if (org-region-active-p) (mark) (point)) (point)))) + (insert (concat (if (looking-at "^") "" "\n") + (if arg (concat stars "\n") "") + "#+begin_src " lang "\n" + body + (if (or (= (length body) 0) + (string-match "[\r\n]$" body)) "" "\n") + "#+end_src\n")) + (goto-char start) (move-end-of-line 1))))) + +(defvar org-babel-lob-one-liner-regexp) +(defun org-babel-where-is-src-block-result (&optional insert info hash indent) + "Find where the current source block results begin. +Return the point at the beginning of the result of the current +source block. Specifically at the beginning of the results line. +If no result exists for this block then create a results line +following the source block." + (save-excursion + (let* ((case-fold-search t) + (on-lob-line (save-excursion + (beginning-of-line 1) + (looking-at org-babel-lob-one-liner-regexp))) + (inlinep (when (org-babel-get-inline-src-block-matches) + (match-end 0))) + (name (if on-lob-line + (mapconcat #'identity (butlast (org-babel-lob-get-info)) + "") + (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)) + (org-with-wide-buffer + (setq + found ;; was there a result (before we potentially insert one) + (or + inlinep + (and + ;; named results: + ;; - return t if it is found, else return nil + ;; - if it does not need to be rebuilt, then don't set end + ;; - if it does need to be rebuilt then do set end + name (setq beg (org-babel-find-named-result name)) + (prog1 beg + (when (and hash (not (string= hash (match-string 5)))) + (goto-char beg) (setq end beg) ;; beginning of result + (forward-line 1) + (delete-region end (org-babel-result-end)) nil))) + (and + ;; unnamed results: + ;; - return t if it is found, else return nil + ;; - if it is found, and the hash doesn't match, delete and set end + (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t)) + (progn (end-of-line 1) + (if (eobp) (insert "\n") (forward-char 1)) + (setq end (point)) + (or (and + (not name) + (progn ;; unnamed results line already exists + (catch 'non-comment + (while (re-search-forward "[^ \f\t\n\r\v]" nil t) + (beginning-of-line 1) + (cond + ((looking-at (concat org-babel-result-regexp "\n")) + (throw 'non-comment t)) + ((looking-at "^[ \t]*#") (end-of-line 1)) + (t (throw 'non-comment nil)))))) + (let ((this-hash (match-string 5))) + (prog1 (point) + ;; must remove and rebuild if hash!=old-hash + (if (and hash (not (string= hash this-hash))) + (prog1 nil + (forward-line 1) + (delete-region + end (org-babel-result-end))) + (setq end nil))))))))))) + (if (not (and insert end)) found + (goto-char end) + (unless beg + (if (looking-at "[\n\r]") (forward-char 1) (insert "\n"))) + (insert (concat + (when (wholenump indent) (make-string indent ? )) + "#+" org-babel-results-keyword + (when hash + (if org-babel-hash-show-time + (concat + "["(format-time-string "<%Y-%m-%d %H:%M:%S>")" "hash"]") + (concat "["hash"]"))) + ":" + (when name (concat " " name)) "\n")) + (unless beg (insert "\n") (backward-char)) + (beginning-of-line 0) + (if hash (org-babel-hide-hash)) + (point))))) + +(defvar org-block-regexp) +(defun org-babel-read-result () + "Read the result at `point' into emacs-lisp." + (let ((case-fold-search t) result-string) + (cond + ((org-at-table-p) (org-babel-read-table)) + ((org-at-item-p) (org-babel-read-list)) + ((looking-at org-bracket-link-regexp) (org-babel-read-link)) + ((looking-at org-block-regexp) (org-babel-trim (match-string 4))) + ((looking-at "^[ \t]*: ") + (setq result-string + (org-babel-trim + (mapconcat (lambda (line) + (if (and (> (length line) 1) + (string-match "^[ \t]*: \\(.+\\)" line)) + (match-string 1 line) + line)) + (split-string + (buffer-substring + (point) (org-babel-result-end)) "[\r\n]+") + "\n"))) + (or (org-babel-number-p result-string) result-string)) + ((looking-at org-babel-result-regexp) + (save-excursion (forward-line 1) (org-babel-read-result)))))) + +(defun org-babel-read-table () + "Read the table at `point' into emacs-lisp." + (mapcar (lambda (row) + (if (and (symbolp row) (equal row 'hline)) row + (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row))) + (org-table-to-lisp))) + +(defun org-babel-read-list () + "Read the list at `point' into emacs-lisp." + (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) + (mapcar #'cadr (cdr (org-list-parse-list))))) + +(defvar org-link-types-re) +(defun org-babel-read-link () + "Read the link at `point' into emacs-lisp. +If the path of the link is a file path it is expanded using +`expand-file-name'." + (let* ((case-fold-search t) + (raw (and (looking-at org-bracket-link-regexp) + (org-no-properties (match-string 1)))) + (type (and (string-match org-link-types-re raw) + (match-string 1 raw)))) + (cond + ((not type) (expand-file-name raw)) + ((string= type "file") + (and (string-match "file\\(.*\\):\\(.+\\)" raw) + (expand-file-name (match-string 2 raw)))) + (t raw)))) + +(defun org-babel-format-result (result &optional sep) + "Format RESULT for writing to file." + (let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r))))) + (if (listp result) + ;; table result + (orgtbl-to-generic + result (list :sep (or sep "\t") :fmt echo-res)) + ;; scalar result + (funcall echo-res result)))) + +(defun org-babel-insert-result + (result &optional result-params info hash indent lang) + "Insert RESULT into the current buffer. +By default RESULT is inserted after the end of the +current source block. With optional argument RESULT-PARAMS +controls insertion of results in the org-mode file. +RESULT-PARAMS can take the following values: + +replace - (default option) insert results after the source block + replacing any previously inserted results + +silent -- no results are inserted into the Org-mode buffer but + the results are echoed to the minibuffer and are + ingested by Emacs (a potentially time consuming + process) + +file ---- the results are interpreted as a file path, and are + inserted into the buffer using the Org-mode file syntax + +list ---- the results are interpreted as an Org-mode list. + +raw ----- results are added directly to the Org-mode file. This + is a good option if you code block will output org-mode + formatted text. + +drawer -- results are added directly to the Org-mode file as with + \"raw\", but are wrapped in a RESULTS drawer, allowing + them to later be replaced or removed automatically. + +org ----- results are added inside of a \"#+BEGIN_SRC org\" block. + They are not comma-escaped when inserted, but Org syntax + here will be discarded when exporting the file. + +html ---- results are added inside of a #+BEGIN_HTML block. This + is a good option if you code block will output html + formatted text. + +latex --- results are added inside of a #+BEGIN_LATEX block. + This is a good option if you code block will output + latex formatted text. + +code ---- the results are extracted in the syntax of the source + code of the language being evaluated and are added + inside of a #+BEGIN_SRC block with the source-code + language set appropriately. Note this relies on the + optional LANG argument." + (if (stringp result) + (progn + (setq result (org-no-properties result)) + (when (member "file" result-params) + (setq result (org-babel-result-to-file + result (when (assoc :file-desc (nth 2 info)) + (or (cdr (assoc :file-desc (nth 2 info))) + result)))))) + (unless (listp result) (setq result (format "%S" result)))) + (if (and result-params (member "silent" result-params)) + (progn + (message (replace-regexp-in-string "%" "%%" (format "%S" result))) + result) + (save-excursion + (let* ((inlinep + (save-excursion + (when (or (org-babel-get-inline-src-block-matches) + (org-babel-get-lob-one-liner-matches)) + (goto-char (match-end 0)) + (insert (if (listp result) "\n" " ")) + (point)))) + (existing-result (unless inlinep + (org-babel-where-is-src-block-result + t info hash indent))) + (results-switches + (cdr (assoc :results_switches (nth 2 info)))) + (visible-beg (copy-marker (point-min))) + (visible-end (copy-marker (point-max))) + ;; When results exist outside of the current visible + ;; region of the buffer, be sure to widen buffer to + ;; update them. + (outside-scope-p (and existing-result + (or (> visible-beg existing-result) + (<= visible-end existing-result)))) + beg end) + (when (and (stringp result) ; ensure results end in a newline + (not inlinep) + (> (length result) 0) + (not (or (string-equal (substring result -1) "\n") + (string-equal (substring result -1) "\r")))) + (setq result (concat result "\n"))) + (unwind-protect + (progn + (when outside-scope-p (widen)) + (if (not existing-result) + (setq beg (or inlinep (point))) + (goto-char existing-result) + (save-excursion + (re-search-forward "#" nil t) + (setq indent (- (current-column) 1))) + (forward-line 1) + (setq beg (point)) + (cond + ((member "replace" result-params) + (delete-region (point) (org-babel-result-end))) + ((member "append" result-params) + (goto-char (org-babel-result-end)) (setq beg (point-marker))) + ((member "prepend" result-params)))) ; already there + (setq results-switches + (if results-switches (concat " " results-switches) "")) + (let ((wrap (lambda (start finish &optional no-escape) + (goto-char end) (insert (concat finish "\n")) + (goto-char beg) (insert (concat start "\n")) + (unless no-escape + (org-escape-code-in-region (min (point) end) end)) + (goto-char end) (goto-char (point-at-eol)) + (setq end (point-marker)))) + (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it))))))) + ;; insert results based on type + (cond + ;; do nothing for an empty result + ((null result)) + ;; insert a list if preferred + ((member "list" result-params) + (insert + (org-babel-trim + (org-list-to-generic + (cons 'unordered + (mapcar + (lambda (el) (list nil (if (stringp el) el (format "%S" el)))) + (if (listp result) result (list result)))) + '(:splicep nil :istart "- " :iend "\n"))) + "\n")) + ;; assume the result is a table if it's not a string + ((funcall proper-list-p result) + (goto-char beg) + (insert (concat (orgtbl-to-orgtbl + (if (or (eq 'hline (car result)) + (and (listp (car result)) + (listp (cdr (car result))))) + result (list result)) + '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) + (goto-char beg) (when (org-at-table-p) (org-table-align))) + ((and (listp result) (not (funcall proper-list-p result))) + (insert (format "%s\n" result))) + ((member "file" result-params) + (when inlinep (goto-char inlinep)) + (insert result)) + (t (goto-char beg) (insert result))) + (when (funcall proper-list-p result) (goto-char (org-table-end))) + (setq end (point-marker)) + ;; possibly wrap result + (cond + ((assoc :wrap (nth 2 info)) + (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS"))) + (funcall wrap (concat "#+BEGIN_" name) + (concat "#+END_" (car (org-split-string name)))))) + ((member "html" result-params) + (funcall wrap "#+BEGIN_HTML" "#+END_HTML")) + ((member "latex" result-params) + (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX")) + ((member "org" result-params) + (goto-char beg) (if (org-at-table-p) (org-cycle)) + (funcall wrap "#+BEGIN_SRC org" "#+END_SRC")) + ((member "code" result-params) + (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches) + "#+END_SRC")) + ((member "raw" result-params) + (goto-char beg) (if (org-at-table-p) (org-cycle))) + ((or (member "drawer" result-params) + ;; Stay backward compatible with <7.9.2 + (member "wrap" result-params)) + (goto-char beg) (if (org-at-table-p) (org-cycle)) + (funcall wrap ":RESULTS:" ":END:" 'no-escape)) + ((and (not (funcall proper-list-p result)) + (not (member "file" result-params))) + (org-babel-examplize-region beg end results-switches) + (setq end (point))))) + ;; possibly indent the results to match the #+results line + (when (and (not inlinep) (numberp indent) indent (> indent 0) + ;; in this case `table-align' does the work for us + (not (and (listp result) + (member "append" result-params)))) + (indent-rigidly beg end indent)) + (if (null result) + (if (member "value" result-params) + (message "Code block returned no value.") + (message "Code block produced no output.")) + (message "Code block evaluation complete."))) + (when outside-scope-p (narrow-to-region visible-beg visible-end)) + (set-marker visible-beg nil) + (set-marker visible-end nil)))))) + +(defun org-babel-remove-result (&optional info) + "Remove the result of the current source block." + (interactive) + (let ((location (org-babel-where-is-src-block-result nil info)) start) + (when location + (setq start (- location 1)) + (save-excursion + (goto-char location) (forward-line 1) + (delete-region start (org-babel-result-end)))))) + +(defun org-babel-result-end () + "Return the point at the end of the current set of results." + (save-excursion + (cond + ((org-at-table-p) (progn (goto-char (org-table-end)) (point))) + ((org-at-item-p) (let* ((struct (org-list-struct)) + (prvs (org-list-prevs-alist struct))) + (org-list-get-list-end (point-at-bol) struct prvs))) + ((let ((case-fold-search t)) (looking-at "^\\([ \t]*\\):results:")) + (progn (re-search-forward (concat "^" (match-string 1) ":END:")) + (forward-char 1) (point))) + (t + (let ((case-fold-search t)) + (if (looking-at (concat "[ \t]*#\\+begin_\\([^ \t\n\r]+\\)")) + (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1)) + nil t) + (forward-char 1)) + (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)") + (forward-line 1)))) + (point))))) + +(defun org-babel-result-to-file (result &optional description) + "Convert RESULT into an `org-mode' link with optional DESCRIPTION. +If the `default-directory' is different from the containing +file's directory then expand relative links." + (when (stringp result) + (format "[[file:%s]%s]" + (if (and default-directory + buffer-file-name + (not (string= (expand-file-name default-directory) + (expand-file-name + (file-name-directory buffer-file-name))))) + (expand-file-name result default-directory) + result) + (if description (concat "[" description "]") "")))) + +(defvar org-babel-capitalize-examplize-region-markers nil + "Make true to capitalize begin/end example markers inserted by code blocks.") + +(defun org-babel-examplize-region (beg end &optional results-switches) + "Comment out region using the inline '==' or ': ' org example quote." + (interactive "*r") + (let ((chars-between (lambda (b e) + (not (string-match "^[\\s]*$" (buffer-substring b e))))) + (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers + (upcase str) str)))) + (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg) + (funcall chars-between end (save-excursion (goto-char end) (point-at-eol)))) + (save-excursion + (goto-char beg) + (insert (format "=%s=" (prog1 (buffer-substring beg end) + (delete-region beg end))))) + (let ((size (count-lines beg end))) + (save-excursion + (cond ((= size 0)) ; do nothing for an empty result + ((< size org-babel-min-lines-for-block-output) + (goto-char beg) + (dotimes (n size) + (beginning-of-line 1) (insert ": ") (forward-line 1))) + (t + (goto-char beg) + (insert (if results-switches + (format "%s%s\n" + (funcall maybe-cap "#+begin_example") + results-switches) + (funcall maybe-cap "#+begin_example\n"))) + (if (markerp end) (goto-char end) (forward-char (- end beg))) + (insert (funcall maybe-cap "#+end_example\n"))))))))) + +(defun org-babel-update-block-body (new-body) + "Update the body of the current code block to NEW-BODY." + (if (not (org-babel-where-is-src-block-head)) + (error "Not in a source block") + (save-match-data + (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5)) + (indent-rigidly (match-beginning 5) (match-end 5) 2))) + +(defun org-babel-merge-params (&rest plists) + "Combine all parameter association lists in PLISTS. +Later elements of PLISTS override the values of previous elements. +This takes into account some special considerations for certain +parameters when merging lists." + (let* ((results-exclusive-groups + (mapcar (lambda (group) (mapcar #'symbol-name group)) + (cdr (assoc 'results org-babel-common-header-args-w-values)))) + (exports-exclusive-groups + (mapcar (lambda (group) (mapcar #'symbol-name group)) + (cdr (assoc 'exports org-babel-common-header-args-w-values)))) + (variable-index 0) + (e-merge (lambda (exclusive-groups &rest result-params) + ;; maintain exclusivity of mutually exclusive parameters + (let (output) + (mapc (lambda (new-params) + (mapc (lambda (new-param) + (mapc (lambda (exclusive-group) + (when (member new-param exclusive-group) + (mapcar (lambda (excluded-param) + (setq output + (delete + excluded-param + output))) + exclusive-group))) + exclusive-groups) + (setq output (org-uniquify + (cons new-param output)))) + new-params)) + result-params) + output))) + params results exports tangle noweb cache vars shebang comments padline) + + (mapc + (lambda (plist) + (mapc + (lambda (pair) + (case (car pair) + (:var + (let ((name (if (listp (cdr pair)) + (cadr pair) + (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" + (cdr pair)) + (intern (match-string 1 (cdr pair))))))) + (if name + (setq vars + (append + (if (member name (mapcar #'car vars)) + (delq nil + (mapcar + (lambda (p) + (unless (equal (car p) name) p)) + vars)) + vars) + (list (cons name pair)))) + ;; if no name is given and we already have named variables + ;; then assign to named variables in order + (if (and vars (nth variable-index vars)) + (prog1 (setf (cddr (nth variable-index vars)) + (concat (symbol-name + (car (nth variable-index vars))) + "=" (cdr pair))) + (incf variable-index)) + (error "Variable \"%s\" must be assigned a default value" + (cdr pair)))))) + (:results + (setq results (funcall e-merge results-exclusive-groups + results + (split-string + (let ((r (cdr pair))) + (if (stringp r) r (eval r))))))) + (:file + (when (cdr pair) + (setq results (funcall e-merge results-exclusive-groups + results '("file"))) + (unless (or (member "both" exports) + (member "none" exports) + (member "code" exports)) + (setq exports (funcall e-merge exports-exclusive-groups + exports '("results")))) + (setq params (cons pair (assq-delete-all (car pair) params))))) + (:exports + (setq exports (funcall e-merge exports-exclusive-groups + exports (split-string (cdr pair))))) + (:tangle ;; take the latest -- always overwrite + (setq tangle (or (list (cdr pair)) tangle))) + (:noweb + (setq noweb (funcall e-merge + '(("yes" "no" "tangle" "no-export" + "strip-export" "eval")) + noweb + (split-string (or (cdr pair) ""))))) + (:cache + (setq cache (funcall e-merge '(("yes" "no")) cache + (split-string (or (cdr pair) ""))))) + (:padline + (setq padline (funcall e-merge '(("yes" "no")) padline + (split-string (or (cdr pair) ""))))) + (:shebang ;; take the latest -- always overwrite + (setq shebang (or (list (cdr pair)) shebang))) + (:comments + (setq comments (funcall e-merge '(("yes" "no")) comments + (split-string (or (cdr pair) ""))))) + (t ;; replace: this covers e.g. :session + (setq params (cons pair (assq-delete-all (car pair) params)))))) + plist)) + plists) + (setq vars (reverse vars)) + (while vars (setq params (cons (cons :var (cddr (pop vars))) params))) + (mapc + (lambda (hd) + (let ((key (intern (concat ":" (symbol-name hd)))) + (val (eval hd))) + (setf params (cons (cons key (mapconcat 'identity val " ")) params)))) + '(results exports tangle noweb padline cache shebang comments)) + params)) + +(defvar org-babel-use-quick-and-dirty-noweb-expansion nil + "Set to true to use regular expressions to expand noweb references. +This results in much faster noweb reference expansion but does +not properly allow code blocks to inherit the \":noweb-ref\" +header argument from buffer or subtree wide properties.") + +(defun org-babel-noweb-p (params context) + "Check if PARAMS require expansion in CONTEXT. +CONTEXT may be one of :tangle, :export or :eval." + (let* (intersect + (intersect (lambda (as bs) + (when as + (if (member (car as) bs) + (car as) + (funcall intersect (cdr as) bs)))))) + (funcall intersect (case context + (:tangle '("yes" "tangle" "no-export" "strip-export")) + (:eval '("yes" "no-export" "strip-export" "eval")) + (:export '("yes"))) + (split-string (or (cdr (assoc :noweb params)) ""))))) + +(defun org-babel-expand-noweb-references (&optional info parent-buffer) + "Expand Noweb references in the body of the current source code block. + +For example the following reference would be replaced with the +body of the source-code block named 'example-block'. + +<> + +Note that any text preceding the <> construct on a line will +be interposed between the lines of the replacement text. So for +example if <> is placed behind a comment, then the entire +replacement text will also be commented. + +This function must be called from inside of the buffer containing +the source-code block which holds BODY. + +In addition the following syntax can be used to insert the +results of evaluating the source-code block named 'example-block'. + +<> + +Any optional arguments can be passed to example-block by placing +the arguments inside the parenthesis following the convention +defined by `org-babel-lob'. For example + +<> + +would set the value of argument \"a\" equal to \"9\". Note that +these arguments are not evaluated in the current source-code +block but are passed literally to the \"example-block\"." + (let* ((parent-buffer (or parent-buffer (current-buffer))) + (info (or info (org-babel-get-src-block-info))) + (lang (nth 0 info)) + (body (nth 1 info)) + (ob-nww-start org-babel-noweb-wrap-start) + (ob-nww-end org-babel-noweb-wrap-end) + (comment (string= "noweb" (cdr (assoc :comments (nth 2 info))))) + (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|" + ":noweb-ref[ \t]+" "\\)")) + (new-body "") + (nb-add (lambda (text) (setq new-body (concat new-body text)))) + (c-wrap (lambda (text) + (with-temp-buffer + (funcall (intern (concat lang "-mode"))) + (comment-region (point) (progn (insert text) (point))) + (org-babel-trim (buffer-string))))) + index source-name evaluate prefix blocks-in-buffer) + (with-temp-buffer + (org-set-local 'org-babel-noweb-wrap-start ob-nww-start) + (org-set-local 'org-babel-noweb-wrap-end ob-nww-end) + (insert body) (goto-char (point-min)) + (setq index (point)) + (while (and (re-search-forward (org-babel-noweb-wrap) nil t)) + (save-match-data (setf source-name (match-string 1))) + (save-match-data (setq evaluate (string-match "\(.*\)" source-name))) + (save-match-data + (setq prefix + (buffer-substring (match-beginning 0) + (save-excursion + (beginning-of-line 1) (point))))) + ;; add interval to new-body (removing noweb reference) + (goto-char (match-beginning 0)) + (funcall nb-add (buffer-substring index (point))) + (goto-char (match-end 0)) + (setq index (point)) + (funcall nb-add + (with-current-buffer parent-buffer + (save-restriction + (widen) + (mapconcat ;; interpose PREFIX between every line + #'identity + (split-string + (if evaluate + (let ((raw (org-babel-ref-resolve source-name))) + (if (stringp raw) raw (format "%S" raw))) + (or + ;; retrieve from the library of babel + (nth 2 (assoc (intern source-name) + org-babel-library-of-babel)) + ;; return the contents of headlines literally + (save-excursion + (when (org-babel-ref-goto-headline-id source-name) + (org-babel-ref-headline-body))) + ;; find the expansion of reference in this buffer + (let ((rx (concat rx-prefix source-name "[ \t\n]")) + expansion) + (save-excursion + (goto-char (point-min)) + (if org-babel-use-quick-and-dirty-noweb-expansion + (while (re-search-forward rx nil t) + (let* ((i (org-babel-get-src-block-info 'light)) + (body (org-babel-expand-noweb-references i)) + (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + "\n")) + (full (if comment + ((lambda (cs) + (concat (funcall c-wrap (car cs)) "\n" + body "\n" + (funcall c-wrap (cadr cs)))) + (org-babel-tangle-comment-links i)) + body))) + (setq expansion (cons sep (cons full expansion))))) + (org-babel-map-src-blocks nil + (let ((i (org-babel-get-src-block-info 'light))) + (when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) + (nth 4 i)) + source-name) + (let* ((body (org-babel-expand-noweb-references i)) + (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + "\n")) + (full (if comment + ((lambda (cs) + (concat (funcall c-wrap (car cs)) "\n" + body "\n" + (funcall c-wrap (cadr cs)))) + (org-babel-tangle-comment-links i)) + body))) + (setq expansion + (cons sep (cons full expansion))))))))) + (and expansion + (mapconcat #'identity (nreverse (cdr expansion)) ""))) + ;; possibly raise an error if named block doesn't exist + (if (member lang org-babel-noweb-error-langs) + (error "%s" (concat + (org-babel-noweb-wrap source-name) + "could not be resolved (see " + "`org-babel-noweb-error-langs')")) + ""))) + "[\n\r]") (concat "\n" prefix)))))) + (funcall nb-add (buffer-substring index (point-max)))) + new-body)) + +(defun org-babel-script-escape (str &optional force) + "Safely convert tables into elisp lists." + (let (in-single in-double out) + ((lambda (escaped) (condition-case nil (org-babel-read escaped) (error escaped))) + (if (or force + (and (stringp str) + (> (length str) 2) + (or (and (string-equal "[" (substring str 0 1)) + (string-equal "]" (substring str -1))) + (and (string-equal "{" (substring str 0 1)) + (string-equal "}" (substring str -1))) + (and (string-equal "(" (substring str 0 1)) + (string-equal ")" (substring str -1)))))) + (org-babel-read + (concat + "'" + (progn + (mapc + (lambda (ch) + (setq + out + (case ch + (91 (if (or in-double in-single) ; [ + (cons 91 out) + (cons 40 out))) + (93 (if (or in-double in-single) ; ] + (cons 93 out) + (cons 41 out))) + (123 (if (or in-double in-single) ; { + (cons 123 out) + (cons 40 out))) + (125 (if (or in-double in-single) ; } + (cons 125 out) + (cons 41 out))) + (44 (if (or in-double in-single) ; , + (cons 44 out) (cons 32 out))) + (39 (if in-double ; ' + (cons 39 out) + (setq in-single (not in-single)) (cons 34 out))) + (34 (if in-single ; " + (append (list 34 32) out) + (setq in-double (not in-double)) (cons 34 out))) + (t (cons ch out))))) + (string-to-list str)) + (apply #'string (reverse out))))) + str)))) + +(defun org-babel-read (cell &optional inhibit-lisp-eval) + "Convert the string value of CELL to a number if appropriate. +Otherwise if cell looks like lisp (meaning it starts with a +\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, otherwise +return it unmodified as a string. Optional argument NO-LISP-EVAL +inhibits lisp evaluation for situations in which is it not +appropriate." + (if (and (stringp cell) (not (equal cell ""))) + (or (org-babel-number-p cell) + (if (and (not inhibit-lisp-eval) + (or (member (substring cell 0 1) '("(" "'" "`" "[")) + (string= cell "*this*"))) + (eval (read cell)) + (if (string= (substring cell 0 1) "\"") + (read cell) + (progn (set-text-properties 0 (length cell) nil cell) cell)))) + cell)) + +(defun org-babel-number-p (string) + "If STRING represents a number return its value." + (if (and (string-match "[0-9]+" string) + (string-match "^-?[0-9]*\\.?[0-9]*$" string) + (= (length (substring string (match-beginning 0) + (match-end 0))) + (length string))) + (string-to-number string))) + +(defun org-babel-import-elisp-from-file (file-name &optional separator) + "Read the results located at FILE-NAME into an elisp table. +If the table is trivial, then return it as a scalar." + (let (result) + (save-window-excursion + (with-temp-buffer + (condition-case err + (progn + (org-table-import file-name separator) + (delete-file file-name) + (setq result (mapcar (lambda (row) + (mapcar #'org-babel-string-read row)) + (org-table-to-lisp)))) + (error (message "Error reading results: %s" err) nil))) + (if (null (cdr result)) ;; if result is trivial vector, then scalarize it + (if (consp (car result)) + (if (null (cdr (car result))) + (caar result) + result) + (car result)) + result)))) + +(defun org-babel-string-read (cell) + "Strip nested \"s from around strings." + (org-babel-read (or (and (stringp cell) + (string-match "\\\"\\(.+\\)\\\"" cell) + (match-string 1 cell)) + cell) t)) + +(defun org-babel-chomp (string &optional regexp) + "Strip trailing spaces and carriage returns from STRING. +Default regexp used is \"[ \f\t\n\r\v]\" but can be +overwritten by specifying a regexp as a second argument." + (let ((regexp (or regexp "[ \f\t\n\r\v]"))) + (while (and (> (length string) 0) + (string-match regexp (substring string -1))) + (setq string (substring string 0 -1))) + string)) + +(defun org-babel-trim (string &optional regexp) + "Strip leading and trailing spaces and carriage returns from STRING. +Like `org-babel-chomp' only it runs on both the front and back +of the string." + (org-babel-chomp (org-reverse-string + (org-babel-chomp (org-reverse-string string) regexp)) + regexp)) + +(defun org-babel-tramp-handle-call-process-region + (start end program &optional delete buffer display &rest args) + "Use Tramp to handle `call-process-region'. +Fixes a bug in `tramp-handle-call-process-region'." + (if (and (featurep 'tramp) (file-remote-p default-directory)) + (let ((tmpfile (tramp-compat-make-temp-file ""))) + (write-region start end tmpfile) + (when delete (delete-region start end)) + (unwind-protect + ;; (apply 'call-process program tmpfile buffer display args) + ;; bug in tramp + (apply 'process-file program tmpfile buffer display args) + (delete-file tmpfile))) + ;; org-babel-call-process-region-original is the original emacs + ;; definition. It is in scope from the let binding in + ;; org-babel-execute-src-block + (apply org-babel-call-process-region-original + start end program delete buffer display args))) + +(defun org-babel-local-file-name (file) + "Return the local name component of FILE." + (if (file-remote-p file) + (let (localname) + (with-parsed-tramp-file-name file nil + localname)) + file)) + +(defun org-babel-process-file-name (name &optional no-quote-p) + "Prepare NAME to be used in an external process. +If NAME specifies a remote location, the remote portion of the +name is removed, since in that case the process will be executing +remotely. The file name is then processed by `expand-file-name'. +Unless second argument NO-QUOTE-P is non-nil, the file name is +additionally processed by `shell-quote-argument'" + ((lambda (f) (if no-quote-p f (shell-quote-argument f))) + (expand-file-name (org-babel-local-file-name name)))) + +(defvar org-babel-temporary-directory) +(unless (or noninteractive (boundp 'org-babel-temporary-directory)) + (defvar org-babel-temporary-directory + (or (and (boundp 'org-babel-temporary-directory) + (file-exists-p org-babel-temporary-directory) + org-babel-temporary-directory) + (make-temp-file "babel-" t)) + "Directory to hold temporary files created to execute code blocks. +Used by `org-babel-temp-file'. This directory will be removed on +Emacs shutdown.")) + +(defmacro org-babel-result-cond (result-params scalar-form &rest table-forms) + "Call the code to parse raw string results according to RESULT-PARAMS." + (declare (indent 1) + (debug (form form &rest form))) + (org-with-gensyms (params) + `(let ((,params ,result-params)) + (unless (member "none" ,params) + (if (or (member "scalar" ,params) + (member "verbatim" ,params) + (member "html" ,params) + (member "code" ,params) + (member "pp" ,params) + (and (or (member "output" ,params) + (member "raw" ,params) + (member "org" ,params) + (member "drawer" ,params)) + (not (member "table" ,params)))) + ,scalar-form + ,@table-forms))))) +(def-edebug-spec org-babel-result-cond (form form body)) + +(defun org-babel-temp-file (prefix &optional suffix) + "Create a temporary file in the `org-babel-temporary-directory'. +Passes PREFIX and SUFFIX directly to `make-temp-file' with the +value of `temporary-file-directory' temporarily set to the value +of `org-babel-temporary-directory'." + (if (file-remote-p default-directory) + (let ((prefix + (concat (file-remote-p default-directory) + (expand-file-name prefix temporary-file-directory)))) + (make-temp-file prefix nil suffix)) + (let ((temporary-file-directory + (or (and (boundp 'org-babel-temporary-directory) + (file-exists-p org-babel-temporary-directory) + org-babel-temporary-directory) + temporary-file-directory))) + (make-temp-file prefix nil suffix)))) + +(defun org-babel-remove-temporary-directory () + "Remove `org-babel-temporary-directory' on Emacs shutdown." + (when (and (boundp 'org-babel-temporary-directory) + (file-exists-p org-babel-temporary-directory)) + ;; taken from `delete-directory' in files.el + (condition-case nil + (progn + (mapc (lambda (file) + ;; This test is equivalent to + ;; (and (file-directory-p fn) (not (file-symlink-p fn))) + ;; but more efficient + (if (eq t (car (file-attributes file))) + (delete-directory file) + (delete-file file))) + ;; We do not want to delete "." and "..". + (directory-files org-babel-temporary-directory 'full + "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) + (delete-directory org-babel-temporary-directory)) + (error + (message "Failed to remove temporary Org-babel directory %s" + (if (boundp 'org-babel-temporary-directory) + org-babel-temporary-directory + "[directory not defined]")))))) + +(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) + +(provide 'ob-core) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ob-core.el ends here diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el index d6bbbbce3..d3d76e57a 100644 --- a/lisp/ob-ditaa.el +++ b/lisp/ob-ditaa.el @@ -34,22 +34,38 @@ ;; 3) we are adding the "file" and "cmdline" header arguments ;; ;; 4) there are no variables (at least for now) -;; -;; 5) it depends on a variable defined in org-exp-blocks (namely -;; `org-ditaa-jar-path') so be sure you have org-exp-blocks loaded ;;; Code: (require 'ob) (require 'org-compat) -(defvar org-ditaa-jar-path) ;; provided by org-exp-blocks - (defvar org-babel-default-header-args:ditaa '((:results . "file") (:exports . "results") (:java . "-Dfile.encoding=UTF-8")) "Default arguments for evaluating a ditaa source block.") +(defcustom org-ditaa-jar-path (expand-file-name + "ditaa.jar" + (file-name-as-directory + (expand-file-name + "scripts" + (file-name-as-directory + (expand-file-name + "../contrib" + (file-name-directory (org-find-library-dir "org"))))))) + "Path to the ditaa jar executable." + :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." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + (defcustom org-ditaa-jar-option "-jar" "Option for the ditaa jar file. Do not leave leading or trailing spaces in this string." @@ -69,16 +85,25 @@ This function is called by `org-babel-execute-src-block'." (cmdline (cdr (assoc :cmdline params))) (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 " " (shell-quote-argument - (expand-file-name org-ditaa-jar-path)) + (expand-file-name + (if eps org-ditaa-eps-jar-path org-ditaa-jar-path))) " " cmdline " " (org-babel-process-file-name in-file) - " " (org-babel-process-file-name out-file)))) + " " (org-babel-process-file-name out-file))) + (pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf") + (cdr (assoc :pdf params)))) + (concat + "epstopdf" + " " (org-babel-process-file-name (concat in-file ".eps")) + " -o=" (org-babel-process-file-name out-file))))) (unless (file-exists-p org-ditaa-jar-path) (error "Could not find ditaa.jar at %s" org-ditaa-jar-path)) (with-temp-file in-file (insert body)) (message cmd) (shell-command cmd) + (when pdf-cmd (message pdf-cmd) (shell-command pdf-cmd)) nil)) ;; signal that output has already been written to file (defun org-babel-prep-session:ditaa (session params) diff --git a/lisp/ob-dot.el b/lisp/ob-dot.el index b5e78802b..750426413 100644 --- a/lisp/ob-dot.el +++ b/lisp/ob-dot.el @@ -39,7 +39,6 @@ ;;; Code: (require 'ob) -(require 'ob-eval) (defvar org-babel-default-header-args:dot '((:results . "file") (:exports . "results")) diff --git a/lisp/ob-emacs-lisp.el b/lisp/ob-emacs-lisp.el index d6073ca8e..886645dc9 100644 --- a/lisp/ob-emacs-lisp.el +++ b/lisp/ob-emacs-lisp.el @@ -27,7 +27,6 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'ob-comint)) (defvar org-babel-default-header-args:emacs-lisp '((:hlines . "yes") (:colnames . "no")) @@ -56,11 +55,13 @@ "Execute a block of emacs-lisp code with Babel." (save-window-excursion ((lambda (result) - (if (or (member "scalar" (cdr (assoc :result-params params))) - (member "verbatim" (cdr (assoc :result-params params)))) - (let ((print-level nil) - (print-length nil)) - (format "%S" result)) + (org-babel-result-cond (cdr (assoc :result-params params)) + (let ((print-level nil) + (print-length nil)) + (if (or (member "scalar" (cdr (assoc :result-params params))) + (member "verbatim" (cdr (assoc :result-params params)))) + (format "%S" result) + (format "%s" result))) (org-babel-reassemble-table result (org-babel-pick-name (cdr (assoc :colname-names params)) diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el index 22d2bcf28..681362ffd 100644 --- a/lisp/ob-eval.el +++ b/lisp/ob-eval.el @@ -50,8 +50,8 @@ STDERR with `org-babel-eval-error-notify'." (with-temp-buffer (insert body) (setq exit-code - (org-babel-shell-command-on-region - (point-min) (point-max) cmd t 'replace err-buff)) + (org-babel--shell-command-on-region + (point-min) (point-max) cmd err-buff)) (if (or (not (numberp exit-code)) (> exit-code 0)) (progn (with-current-buffer err-buff @@ -64,79 +64,15 @@ STDERR with `org-babel-eval-error-notify'." (with-temp-buffer (insert-file-contents file) (buffer-string))) -(defun org-babel-shell-command-on-region (start end command - &optional output-buffer replace - error-buffer display-error-buffer) +(defun org-babel--shell-command-on-region (start end command error-buffer) "Execute COMMAND in an inferior shell with region as input. -Fixes bugs in the emacs 23.1.1 version of `shell-command-on-region' - -Normally display output (if any) in temp buffer `*Shell Command Output*'; -Prefix arg means replace the region with it. Return the exit code of -COMMAND. - -To specify a coding system for converting non-ASCII characters in -the input and output to the shell command, use -\\[universal-coding-system-argument] before this command. By -default, the input (from the current buffer) is encoded in the -same coding system that will be used to save the file, -`buffer-file-coding-system'. If the output is going to replace -the region, then it is decoded from that same coding system. - -The noninteractive arguments are START, END, COMMAND, -OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER. -Noninteractive callers can specify coding systems by binding -`coding-system-for-read' and `coding-system-for-write'. - -If the command generates output, the output may be displayed -in the echo area or in a buffer. -If the output is short enough to display in the echo area -\(determined by the variable `max-mini-window-height' if -`resize-mini-windows' is non-nil), it is shown there. Otherwise -it is displayed in the buffer `*Shell Command Output*'. The output -is available in that buffer in both cases. - -If there is output and an error, a message about the error -appears at the end of the output. - -If there is no output, or if output is inserted in the current buffer, -then `*Shell Command Output*' is deleted. - -If the optional fourth argument OUTPUT-BUFFER is non-nil, -that says to put the output in some other buffer. -If OUTPUT-BUFFER is a buffer or buffer name, put the output there. -If OUTPUT-BUFFER is not a buffer and not nil, -insert output in the current buffer. -In either case, the output is inserted after point (leaving mark after it). - -If REPLACE, the optional fifth argument, is non-nil, that means insert -the output in place of text from START to END, putting point and mark -around it. - -If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer -or buffer name to which to direct the command's standard error output. -If it is nil, error output is mingled with regular output. -If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there -were any errors. (This is always t, interactively.) -In an interactive call, the variable `shell-command-default-error-buffer' -specifies the value of ERROR-BUFFER." - (interactive (let (string) - (unless (mark) - (error "The mark is not set now, so there is no region")) - ;; Do this before calling region-beginning - ;; and region-end, in case subprocess output - ;; relocates them while we are in the minibuffer. - (setq string (read-shell-command "Shell command on region: ")) - ;; call-interactively recognizes region-beginning and - ;; region-end specially, leaving them in the history. - (list (region-beginning) (region-end) - string - current-prefix-arg - current-prefix-arg - shell-command-default-error-buffer - t))) - (let ((input-file (org-babel-temp-file "input-")) - (error-file (if error-buffer (org-babel-temp-file "scor-") nil)) +Stripped down version of shell-command-on-region for internal use +in Babel only. This lets us work around errors in the original +function in various versions of Emacs. +" + (let ((input-file (org-babel-temp-file "ob-input-")) + (error-file (if error-buffer (org-babel-temp-file "ob-error-") nil)) ;; Unfortunately, `executable-find' does not support file name ;; handlers. Therefore, we could use it in the local case ;; only. @@ -154,96 +90,26 @@ specifies the value of ERROR-BUFFER." ;; workaround for now. (unless (file-remote-p default-directory) (delete-file error-file)) - (if (or replace - (and output-buffer - (not (or (bufferp output-buffer) (stringp output-buffer))))) - ;; Replace specified region with output from command. - (let ((swap (and replace (< start end)))) - ;; Don't muck with mark unless REPLACE says we should. - (goto-char start) - (and replace (push-mark (point) 'nomsg)) - (write-region start end input-file) - (delete-region start end) - (setq exit-status - (process-file shell-file-name input-file - (if error-file - (list output-buffer error-file) - t) - nil shell-command-switch command)) - ;; It is rude to delete a buffer which the command is not using. - ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) - ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) - ;; (kill-buffer shell-buffer))) - ;; Don't muck with mark unless REPLACE says we should. - (and replace swap (exchange-point-and-mark))) - ;; No prefix argument: put the output in a temp buffer, - ;; replacing its entire contents. - (let ((buffer (get-buffer-create - (or output-buffer "*Shell Command Output*")))) - (unwind-protect - (if (eq buffer (current-buffer)) - ;; If the input is the same buffer as the output, - ;; delete everything but the specified region, - ;; then replace that region with the output. - (progn (setq buffer-read-only nil) - (delete-region (max start end) (point-max)) - (delete-region (point-min) (min start end)) - (write-region (point-min) (point-max) input-file) - (delete-region (point-min) (point-max)) - (setq exit-status - (process-file shell-file-name input-file - (if error-file - (list t error-file) - t) - nil shell-command-switch command))) - ;; Clear the output buffer, then run the command with - ;; output there. - (let ((directory default-directory)) - (with-current-buffer buffer - (setq buffer-read-only nil) - (if (not output-buffer) - (setq default-directory directory)) - (erase-buffer))) - (setq exit-status - (process-file shell-file-name nil - (if error-file - (list buffer error-file) - buffer) - nil shell-command-switch command))) - ;; Report the output. - (with-current-buffer buffer - (setq mode-line-process - (cond ((null exit-status) - " - Error") - ((stringp exit-status) - (format " - Signal [%s]" exit-status)) - ((not (equal 0 exit-status)) - (format " - Exit [%d]" exit-status))))) - (if (with-current-buffer buffer (> (point-max) (point-min))) - ;; There's some output, display it - (display-message-or-buffer buffer) - ;; No output; error? - (let ((output - (if (and error-file - (< 0 (nth 7 (file-attributes error-file)))) - "some error output" - "no output"))) - (cond ((null exit-status) - (message "(Shell command failed with error)")) - ((equal 0 exit-status) - (message "(Shell command succeeded with %s)" - output)) - ((stringp exit-status) - (message "(Shell command killed by signal %s)" - exit-status)) - (t - (message "(Shell command failed with code %d and %s)" - exit-status output)))) - ;; Don't kill: there might be useful info in the undo-log. - ;; (kill-buffer buffer) - )))) + ;; we always call this with 'replace, remove conditional + ;; Replace specified region with output from command. + (let ((swap (< start end))) + (goto-char start) + (push-mark (point) 'nomsg) + (write-region start end input-file) + (delete-region start end) + (setq exit-status + (process-file shell-file-name input-file + (if error-file + (list t error-file) + t) + nil shell-command-switch command)) + (when swap (exchange-point-and-mark))) - (when (and input-file (file-exists-p input-file)) + (when (and input-file (file-exists-p input-file) + ;; bind org-babel--debug-input around the call to keep + ;; the temporary input files available for inspection + (not (when (boundp 'org-babel--debug-input) + org-babel--debug-input))) (delete-file input-file)) (when (and error-file (file-exists-p error-file)) @@ -258,8 +124,7 @@ specifies the value of ERROR-BUFFER." (format-insert-file error-file nil) ;; Put point after the inserted errors. (goto-char (- (point-max) pos-from-end))) - (and display-error-buffer - (display-buffer (current-buffer))))) + (current-buffer))) (delete-file error-file)) exit-status)) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 37a9f71cf..d9fb294b2 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -23,8 +23,7 @@ ;; along with GNU Emacs. If not, see . ;;; Code: -(require 'ob) -(require 'org-exp-blocks) +(require 'ob-core) (eval-when-compile (require 'cl)) @@ -35,23 +34,31 @@ (declare-function org-babel-lob-get-info "ob-lob" ()) (declare-function org-babel-eval-wipe-error-buffer "ob-eval" ()) +(declare-function org-between-regexps-p "org" + (start-re end-re &optional lim-up lim-down)) +(declare-function org-get-indentation "org" (&optional line)) (declare-function org-heading-components "org" ()) +(declare-function org-in-block-p "org" (names)) +(declare-function org-in-verbatim-emphasis "org" ()) (declare-function org-link-search "org" (s &optional type avoid-pos stealth)) (declare-function org-fill-template "org" (template alist)) -(declare-function org-in-verbatim-emphasis "org" ()) -(declare-function org-in-block-p "org" (names)) -(declare-function org-between-regexps-p "org" (start-re end-re &optional lim-up lim-down)) - -(add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements)) -(org-export-blocks-add-block '(src org-babel-exp-src-block nil)) +(declare-function org-split-string "org" (string &optional separators)) +(declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-context "org-element" ()) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-escape-code-in-string "org-src" (s)) (defcustom org-export-babel-evaluate t "Switch controlling code evaluation during export. When set to nil no code will be evaluated as part of the export -process." +process. When set to 'inline-only, only inline code blocks will +be executed." :group 'org-babel :version "24.1" - :type 'boolean) + :type '(choice (const :tag "Never" nil) + (const :tag "Only inline code" inline-only) + (const :tag "Always" t))) (put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) (defun org-babel-exp-get-export-buffer () @@ -86,10 +93,10 @@ process." results))) (def-edebug-spec org-babel-exp-in-export-file (form body)) -(defun org-babel-exp-src-block (body &rest headers) +(defun org-babel-exp-src-block (&rest headers) "Process source block for export. -Depending on the 'export' headers argument in replace the source -code block with... +Depending on the 'export' headers argument, replace the source +code block like this: both ---- display the code and the results @@ -99,11 +106,12 @@ code ---- the default, display the code inside the block but do results - just like none only the block is run on export ensuring that it's results are present in the org-mode buffer -none ----- do not display either code or results upon export" +none ---- do not display either code or results upon export + +Assume point is at the beginning of block's starting line." (interactive) (unless noninteractive (message "org-babel-exp processing...")) (save-excursion - (goto-char (match-beginning 0)) (let* ((info (org-babel-get-src-block-info 'light)) (lang (nth 0 info)) (raw-params (nth 2 info)) hash) @@ -149,66 +157,156 @@ this template." (let ((m (make-marker))) (set-marker m end (current-buffer)) (setq end m))) - (let ((rx (concat "\\(" org-babel-inline-src-block-regexp + (let ((rx (concat "\\(?:" org-babel-inline-src-block-regexp "\\|" org-babel-lob-one-liner-regexp "\\)"))) - (while (and (< (point) (marker-position end)) - (re-search-forward rx end t)) - (if (save-excursion - (goto-char (match-beginning 0)) - (looking-at org-babel-inline-src-block-regexp)) - (progn - (forward-char 1) - (let* ((info (save-match-data - (org-babel-parse-inline-src-block-match))) - (params (nth 2 info))) - (save-match-data - (goto-char (match-beginning 2)) - (unless (org-babel-in-example-or-verbatim) - ;; expand noweb references in the original file - (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) - (org-babel-expand-noweb-references - info (org-babel-exp-get-export-buffer)) - (nth 1 info))) - (let ((code-replacement (save-match-data - (org-babel-exp-do-export - info 'inline)))) - (if code-replacement - (progn (replace-match code-replacement nil nil nil 1) - (delete-char 1)) - (org-babel-examplize-region (match-beginning 1) - (match-end 1)) - (forward-char 2))))))) - (unless (org-babel-in-example-or-verbatim) - (let* ((lob-info (org-babel-lob-get-info)) - (inlinep (match-string 11)) - (inline-start (match-end 11)) - (inline-end (match-end 0)) - (results (save-match-data - (org-babel-exp-do-export - (list "emacs-lisp" "results" - (org-babel-merge-params - org-babel-default-header-args - org-babel-default-lob-header-args - (org-babel-params-from-properties) - (org-babel-parse-header-arguments - (org-no-properties - (concat ":var results=" - (mapconcat #'identity - (butlast lob-info) - " "))))) - "" nil (car (last lob-info))) - 'lob))) - (rep (org-fill-template - org-babel-exp-call-line-template - `(("line" . ,(nth 0 lob-info)))))) - (if inlinep - (save-excursion - (goto-char inline-start) - (delete-region inline-start inline-end) - (insert rep)) - (replace-match rep t t))))))))) + (while (re-search-forward rx end t) + (save-excursion + (let* ((element (save-excursion + ;; If match is inline, point is at its + ;; end. Move backward so + ;; `org-element-context' can get the + ;; object, not the following one. + (backward-char) + (save-match-data (org-element-context)))) + (type (org-element-type element))) + (when (memq type '(babel-call inline-babel-call inline-src-block)) + (let ((beg-el (org-element-property :begin element)) + (end-el (org-element-property :end element))) + (case type + (inline-src-block + (let* ((info (org-babel-parse-inline-src-block-match)) + (params (nth 2 info))) + (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references + info (org-babel-exp-get-export-buffer)) + (nth 1 info))) + (goto-char beg-el) + (let ((replacement (org-babel-exp-do-export info 'inline))) + (if (equal replacement "") + ;; Replacement code is empty: completely + ;; remove inline src block, including extra + ;; white space that might have been created + ;; when inserting results. + (delete-region beg-el + (progn (goto-char end-el) + (skip-chars-forward " \t") + (point))) + ;; Otherwise: remove inline src block but + ;; preserve following white spaces. Then + ;; insert value. + (delete-region beg-el + (progn (goto-char end-el) + (skip-chars-backward " \t") + (point))) + (insert replacement))))) + ((babel-call inline-babel-call) + (let* ((lob-info (org-babel-lob-get-info)) + (results + (org-babel-exp-do-export + (list "emacs-lisp" "results" + (org-babel-merge-params + org-babel-default-header-args + org-babel-default-lob-header-args + (org-babel-params-from-properties) + (org-babel-parse-header-arguments + (org-no-properties + (concat ":var results=" + (mapconcat 'identity + (butlast lob-info) + " "))))) + "" nil (car (last lob-info))) + 'lob)) + (rep (org-fill-template + org-babel-exp-call-line-template + `(("line" . ,(nth 0 lob-info)))))) + ;; If replacement is empty, completely remove the + ;; object/element, including any extra white space + ;; that might have been created when including + ;; results. + (if (equal rep "") + (delete-region + beg-el + (progn (goto-char end-el) + (if (not (eq type 'babel-call)) + (progn (skip-chars-forward " \t") (point)) + (skip-chars-forward " \r\t\n") + (line-beginning-position)))) + ;; Otherwise, preserve following white + ;; spaces/newlines and then, insert replacement + ;; string. + (goto-char beg-el) + (delete-region beg-el + (progn (goto-char end-el) + (skip-chars-backward " \r\t\n") + (point))) + (insert rep))))))))))))) + +(defvar org-src-preserve-indentation) ; From org-src.el +(defun org-babel-exp-process-buffer () + "Execute all blocks in visible part of buffer." + (interactive) + (save-window-excursion + (let ((case-fold-search t) + (pos (point-min))) + (goto-char pos) + (while (re-search-forward "^[ \t]*#\\+BEGIN_SRC" nil t) + (let ((element (save-match-data (org-element-at-point)))) + (when (eq (org-element-type element) 'src-block) + (let* ((match-start (copy-marker (match-beginning 0))) + (begin (copy-marker (org-element-property :begin element))) + ;; Make sure we don't remove any blank lines after + ;; the block when replacing it. + (block-end (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (copy-marker (line-end-position)))) + (ind (org-get-indentation)) + (headers + (cons + (org-element-property :language element) + (let ((params (org-element-property :parameters element))) + (and params (org-split-string params "[ \t]+"))))) + (preserve-indent + (or org-src-preserve-indentation + (org-element-property :preserve-indent element)))) + ;; Execute all non-block elements between POS and + ;; current block. + (org-babel-exp-non-block-elements pos begin) + ;; Take care of matched block: compute replacement + ;; string. In particular, a nil REPLACEMENT means the + ;; block should be left as-is while an empty string + ;; should remove the block. + (let ((replacement (progn (goto-char match-start) + (org-babel-exp-src-block headers)))) + (cond ((not replacement) (goto-char block-end)) + ((equal replacement "") + (delete-region begin + (progn (goto-char block-end) + (skip-chars-forward " \r\t\n") + (if (eobp) (point) + (line-beginning-position))))) + (t + (goto-char match-start) + (delete-region (point) block-end) + (insert replacement) + (if preserve-indent + ;; Indent only the code block markers. + (save-excursion (skip-chars-backward " \r\t\n") + (indent-line-to ind) + (goto-char match-start) + (indent-line-to ind)) + ;; Indent everything. + (indent-rigidly match-start (point) ind))))) + (setq pos (line-beginning-position)) + ;; Cleanup markers. + (set-marker match-start nil) + (set-marker begin nil) + (set-marker block-end nil))))) + ;; Eventually execute all non-block Babel elements between last + ;; src-block and end of buffer. + (org-babel-exp-non-block-elements pos (point-max))))) (defun org-babel-in-example-or-verbatim () "Return true if point is in example or verbatim code. @@ -269,9 +367,7 @@ replaced with its value." (org-fill-template org-babel-exp-code-template `(("lang" . ,(nth 0 info)) - ("body" . ,(if (string= (nth 0 info) "org") - (replace-regexp-in-string "^" "," (nth 1 info)) - (nth 1 info))) + ("body" . ,(org-escape-code-in-string (nth 1 info))) ,@(mapcar (lambda (pair) (cons (substring (symbol-name (car pair)) 1) (format "%S" (cdr pair)))) @@ -285,7 +381,9 @@ Results are prepared in a manner suitable for export by org-mode. This function is called by `org-babel-exp-do-export'. The code block will be evaluated. Optional argument SILENT can be used to inhibit insertion of results into the buffer." - (when (and org-export-babel-evaluate + (when (and (or (eq org-export-babel-evaluate t) + (and (eq type 'inline) + (eq org-export-babel-evaluate 'inline-only))) (not (and hash (equal hash (org-babel-current-result-hash))))) (let ((lang (nth 0 info)) (body (if (org-babel-noweb-p (nth 2 info) :eval) @@ -318,10 +416,10 @@ inhibit insertion of results into the buffer." ((equal type 'lob) (save-excursion (re-search-backward org-babel-lob-one-liner-regexp nil t) - (org-babel-execute-src-block nil info))))))))) + (let (org-confirm-babel-evaluate) + (org-babel-execute-src-block nil info)))))))))) + (provide 'ob-exp) - - ;;; ob-exp.el ends here diff --git a/lisp/ob-fortran.el b/lisp/ob-fortran.el index 8d5012fb8..1eab03e14 100644 --- a/lisp/ob-fortran.el +++ b/lisp/ob-fortran.el @@ -28,7 +28,6 @@ ;;; Code: (require 'ob) -(require 'ob-eval) (require 'cc-mode) (declare-function org-entry-get "org" @@ -62,11 +61,11 @@ (org-babel-process-file-name tmp-src-file)) "")))) ((lambda (results) (org-babel-reassemble-table - (if (member "vector" (cdr (assoc :result-params params))) - (let ((tmp-file (org-babel-temp-file "f-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file)) - (org-babel-read results)) + (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-read results) + (let ((tmp-file (org-babel-temp-file "f-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el index 488d2508e..4b3a1c60e 100644 --- a/lisp/ob-gnuplot.el +++ b/lisp/ob-gnuplot.el @@ -39,8 +39,6 @@ ;;; Code: (require 'ob) -(require 'ob-ref) -(require 'ob-comint) (eval-when-compile (require 'cl)) (declare-function org-time-string-to-time "org" (s)) diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el index eca6d829c..6f0fbcdf2 100644 --- a/lisp/ob-haskell.el +++ b/lisp/ob-haskell.el @@ -40,7 +40,6 @@ ;;; Code: (require 'ob) -(require 'ob-comint) (require 'comint) (eval-when-compile (require 'cl)) @@ -79,11 +78,12 @@ (cdr (member org-babel-haskell-eoe (reverse (mapcar #'org-babel-trim raw))))))) (org-babel-reassemble-table - (cond - ((equal result-type 'output) - (mapconcat #'identity (reverse (cdr results)) "\n")) - ((equal result-type 'value) - (org-babel-haskell-table-or-string (car results)))) + ((lambda (result) + (org-babel-result-cond (cdr (assoc :result-params params)) + result (org-babel-haskell-table-or-string result))) + (case result-type + ('output (mapconcat #'identity (reverse (cdr results)) "\n")) + ('value (car results)))) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colname-names params))) (org-babel-pick-name (cdr (assoc :rowname-names params)) @@ -147,8 +147,9 @@ specifying a variable of the same value." (format "%S" var))) (defvar org-src-preserve-indentation) -(declare-function org-export-as-latex "org-latex" - (arg &optional ext-plist to-buffer body-only pub-dir)) +(declare-function org-export-to-file "ox" + (backend file + &optional subtreep visible-only body-only ext-plist)) (defun org-babel-haskell-export-to-lhs (&optional arg) "Export to a .lhs file with all haskell code blocks escaped. When called with a prefix argument the resulting @@ -192,7 +193,11 @@ constructs (header arguments, no-web syntax etc...) are ignored." (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))) (save-excursion ;; export to latex w/org and save as .lhs - (find-file tmp-org-file) (funcall 'org-export-as-latex nil) + (require 'ox-latex) + (find-file tmp-org-file) + ;; Ensure we do not clutter kill ring with incomplete results. + (let (org-export-copy-to-kill-ring) + (org-export-to-file 'latex tmp-tex-file)) (kill-buffer nil) (delete-file tmp-org-file) (find-file tmp-tex-file) diff --git a/lisp/ob-io.el b/lisp/ob-io.el index d4686a98e..af18f7468 100644 --- a/lisp/ob-io.el +++ b/lisp/ob-io.el @@ -33,9 +33,6 @@ ;;; Code: (require 'ob) -(require 'ob-ref) -(require 'ob-comint) -(require 'ob-eval) (eval-when-compile (require 'cl)) (defvar org-babel-tangle-lang-exts) ;; Autoloaded @@ -98,8 +95,8 @@ in BODY as elisp." (wrapper (format org-babel-io-wrapper-method body))) (with-temp-file src-file (insert wrapper)) ((lambda (raw) - (if (member "code" result-params) - raw + (org-babel-result-cond result-params + raw (org-babel-io-table-or-string raw))) (org-babel-eval (concat org-babel-io-command " " src-file) "")))))) diff --git a/lisp/ob-java.el b/lisp/ob-java.el index 96128ed15..c0e9a5384 100644 --- a/lisp/ob-java.el +++ b/lisp/ob-java.el @@ -28,7 +28,6 @@ ;;; Code: (require 'ob) -(require 'ob-eval) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("java" . "java")) @@ -58,11 +57,11 @@ (make-directory packagename 'parents)) ((lambda (results) (org-babel-reassemble-table - (if (member "vector" (cdr (assoc :result-params params))) - (let ((tmp-file (org-babel-temp-file "c-"))) + (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-read results) + (let ((tmp-file (org-babel-temp-file "c-"))) (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file)) - (org-babel-read results)) + (org-babel-import-elisp-from-file tmp-file))) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name diff --git a/lisp/ob-js.el b/lisp/ob-js.el index 4e4c3abfa..78914bc2c 100644 --- a/lisp/ob-js.el +++ b/lisp/ob-js.el @@ -39,9 +39,6 @@ ;;; Code: (require 'ob) -(require 'ob-ref) -(require 'ob-comint) -(require 'ob-eval) (eval-when-compile (require 'cl)) (declare-function run-mozilla "ext:moz" (arg)) @@ -68,30 +65,32 @@ This function is called by `org-babel-execute-src-block'" (let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd)) (result-type (cdr (assoc :result-type params))) (full-body (org-babel-expand-body:generic - body params (org-babel-variable-assignments:js params)))) - (org-babel-js-read - (if (not (string= (cdr (assoc :session params)) "none")) - ;; session evaluation - (let ((session (org-babel-prep-session:js - (cdr (assoc :session params)) params))) - (nth 1 - (org-babel-comint-with-output - (session (format "%S" org-babel-js-eoe) t body) - (mapc - (lambda (line) - (insert (org-babel-chomp line)) (comint-send-input nil t)) - (list body (format "%S" org-babel-js-eoe)))))) - ;; external evaluation - (let ((script-file (org-babel-temp-file "js-script-"))) - (with-temp-file script-file - (insert - ;; return the value or the output - (if (string= result-type "value") - (format org-babel-js-function-wrapper full-body) - full-body))) - (org-babel-eval - (format "%s %s" org-babel-js-cmd - (org-babel-process-file-name script-file)) "")))))) + body params (org-babel-variable-assignments:js params))) + (result (if (not (string= (cdr (assoc :session params)) "none")) + ;; session evaluation + (let ((session (org-babel-prep-session:js + (cdr (assoc :session params)) params))) + (nth 1 + (org-babel-comint-with-output + (session (format "%S" org-babel-js-eoe) t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) + (comint-send-input nil t)) + (list body (format "%S" org-babel-js-eoe)))))) + ;; external evaluation + (let ((script-file (org-babel-temp-file "js-script-"))) + (with-temp-file script-file + (insert + ;; return the value or the output + (if (string= result-type "value") + (format org-babel-js-function-wrapper full-body) + full-body))) + (org-babel-eval + (format "%s %s" org-babel-js-cmd + (org-babel-process-file-name script-file)) ""))))) + (org-babel-result-cond (cdr (assoc :result-params params)) + result (org-babel-js-read result)))) (defun org-babel-js-read (results) "Convert RESULTS into an appropriate elisp value. diff --git a/lisp/ob-keys.el b/lisp/ob-keys.el index 01a54ca87..6cc7387e1 100644 --- a/lisp/ob-keys.el +++ b/lisp/ob-keys.el @@ -29,7 +29,7 @@ ;; functions and their associated keys. ;;; Code: -(require 'ob) +(require 'ob-core) (defvar org-babel-key-prefix "\C-c\C-v" "The key prefix for Babel interactive key-bindings. diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el index 104f971c6..94d513321 100644 --- a/lisp/ob-latex.el +++ b/lisp/ob-latex.el @@ -35,19 +35,16 @@ (declare-function org-create-formula-image "org" (string tofile options buffer)) (declare-function org-splice-latex-header "org" (tpl def-pkg pkg snippets-p &optional extra)) -(declare-function org-export-latex-fix-inputenc "org-latex" ()) +(declare-function org-latex-guess-inputenc "ox-latex" (header)) +(declare-function org-latex-compile "ox-latex" (file)) + (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) -(defvar org-format-latex-header) -(defvar org-format-latex-header-extra) -(defvar org-export-latex-packages-alist) -(defvar org-export-latex-default-packages-alist) -(defvar org-export-pdf-logfiles) -(defvar org-latex-to-pdf-process) -(defvar org-export-pdf-remove-logfiles) -(defvar org-format-latex-options) -(defvar org-export-latex-packages-alist) +(defvar org-format-latex-header) ; From org.el +(defvar org-format-latex-options) ; From org.el +(defvar org-latex-default-packages-alist) ; From org.el +(defvar org-latex-packages-alist) ; From org.el (defvar org-babel-default-header-args:latex '((:results . "latex") (:exports . "results")) @@ -81,28 +78,28 @@ This function is called by `org-babel-execute-src-block'." (width (and fit (cdr (assoc :pdfwidth params)))) (headers (cdr (assoc :headers params))) (in-buffer (not (string= "no" (cdr (assoc :buffer params))))) - (org-export-latex-packages-alist - (append (cdr (assoc :packages params)) - org-export-latex-packages-alist))) + (org-latex-packages-alist + (append (cdr (assoc :packages params)) org-latex-packages-alist))) (cond ((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) - (require 'org-latex) (with-temp-file tex-file + (require 'ox-latex) (insert - (org-splice-latex-header - org-format-latex-header - (delq - nil - (mapcar - (lambda (el) - (unless (and (listp el) (string= "hyperref" (cadr el))) - el)) - org-export-latex-default-packages-alist)) - org-export-latex-packages-alist - org-format-latex-header-extra) + (org-latex-guess-inputenc + (org-splice-latex-header + org-format-latex-header + (delq + nil + (mapcar + (lambda (el) + (unless (and (listp el) (string= "hyperref" (cadr el))) + el)) + org-latex-default-packages-alist)) + org-latex-packages-alist + nil)) (if fit "\n\\usepackage[active, tightpage]{preview}\n" "") (if border (format "\\setlength{\\PreviewBorder}{%s}" border) "") (if height (concat "\n" (format "\\pdfpageheight %s" height)) "") @@ -113,14 +110,10 @@ This function is called by `org-babel-execute-src-block'." (mapconcat #'identity headers "\n") headers) "\n") "") - (if org-format-latex-header-extra - (concat "\n" org-format-latex-header-extra) - "") (if fit (concat "\n\\begin{document}\n\\begin{preview}\n" body "\n\\end{preview}\n\\end{document}\n") - (concat "\n\\begin{document}\n" body "\n\\end{document}\n"))) - (org-export-latex-fix-inputenc)) + (concat "\n\\begin{document}\n" body "\n\\end{document}\n")))) (when (file-exists-p out-file) (delete-file out-file)) (let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file))) (cond @@ -137,7 +130,6 @@ This function is called by `org-babel-execute-src-block'." nil) ;; signal that output has already been written to file body)) - (defun convert-pdf (pdffile out-file im-in-options im-out-options) "Generate a file from a pdf file using imagemagick." (let ((cmd (concat "convert " im-in-options " " pdffile " " @@ -146,55 +138,14 @@ This function is called by `org-babel-execute-src-block'." (shell-command cmd))) (defun org-babel-latex-tex-to-pdf (file) - "Generate a pdf file according to the contents FILE. -Extracted from `org-export-as-pdf' in org-latex.el." - (let* ((wconfig (current-window-configuration)) - (default-directory (file-name-directory file)) - (base (file-name-sans-extension file)) - (pdffile (concat base ".pdf")) - (cmds org-latex-to-pdf-process) - (outbuf (get-buffer-create "*Org PDF LaTeX Output*")) - output-dir cmd) - (with-current-buffer outbuf (erase-buffer)) - (message (concat "Processing LaTeX file " file "...")) - (setq output-dir (file-name-directory file)) - (if (and cmds (symbolp cmds)) - (funcall cmds (shell-quote-argument file)) - (while cmds - (setq cmd (pop cmds)) - (while (string-match "%b" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument base)) - t t cmd))) - (while (string-match "%f" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument file)) - t t cmd))) - (while (string-match "%o" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument output-dir)) - t t cmd))) - (shell-command cmd outbuf))) - (message (concat "Processing LaTeX file " file "...done")) - (if (not (file-exists-p pdffile)) - (error (concat "PDF file " pdffile " was not produced")) - (set-window-configuration wconfig) - (when org-export-pdf-remove-logfiles - (dolist (ext org-export-pdf-logfiles) - (setq file (concat base "." ext)) - (and (file-exists-p file) (delete-file file)))) - (message "Exporting to PDF...done") - pdffile))) + "Generate a pdf file according to the contents FILE." + (require 'ox-latex) + (org-latex-compile file)) (defun org-babel-prep-session:latex (session params) "Return an error because LaTeX doesn't support sessions." (error "LaTeX does not support sessions")) + (provide 'ob-latex) - - - ;;; ob-latex.el ends here diff --git a/lisp/ob-lilypond.el b/lisp/ob-lilypond.el index 0554a36ab..6080a5a7c 100644 --- a/lisp/ob-lilypond.el +++ b/lisp/ob-lilypond.el @@ -30,10 +30,7 @@ ;; http://lilypond.org/manuals.html ;;; Code: - (require 'ob) -(require 'ob-eval) -(require 'ob-tangle) (require 'outline) (defalias 'lilypond-mode 'LilyPond-mode) @@ -155,7 +152,11 @@ specific arguments to =org-babel-tangle=" " -dbackend=eps " "-dno-gs-load-fonts " "-dinclude-eps-fonts " - "--png " + (or (cdr (assoc (file-name-extension out-file) + '(("pdf" . "--pdf ") + ("ps" . "--ps ") + ("png" . "--png ")))) + "--png ") "--output=" (file-name-sans-extension out-file) " " diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el index 4ff971855..2bb1a25bf 100644 --- a/lisp/ob-lisp.el +++ b/lisp/ob-lisp.el @@ -76,8 +76,8 @@ current directory string." (require 'slime) (org-babel-reassemble-table ((lambda (result) - (if (member "output" (cdr (assoc :result-params params))) - (car result) + (org-babel-result-cond (cdr (assoc :result-params params)) + (car result) (condition-case nil (read (org-babel-lisp-vector-to-list (cadr result))) (error (cadr result))))) diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el index 372782935..802aa6027 100644 --- a/lisp/ob-lob.el +++ b/lisp/ob-lob.el @@ -25,7 +25,7 @@ ;;; Code: (eval-when-compile (require 'cl)) -(require 'ob) +(require 'ob-core) (require 'ob-table) (declare-function org-babel-in-example-or-verbatim "ob-exp" nil) @@ -116,27 +116,30 @@ if so then run the appropriate source block from the Library." (list (length (if (= (length (match-string 12)) 0) (match-string 2) (match-string 11))))))))) +(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)))) (pre-params (org-babel-merge-params org-babel-default-header-args + org-babel-default-header-args:emacs-lisp (org-babel-params-from-properties) (org-babel-parse-header-arguments (org-no-properties (concat ":var results=" (mapconcat #'identity (butlast info) " ")))))) (pre-info (funcall mkinfo pre-params)) - (cache? (and (cdr (assoc :cache pre-params)) - (string= "yes" (cdr (assoc :cache pre-params))))) - (new-hash (when cache? (org-babel-sha1-hash pre-info))) - (old-hash (when cache? (org-babel-current-result-hash)))) - (if (and cache? (equal new-hash old-hash)) + (cache-p (and (cdr (assoc :cache pre-params)) + (string= "yes" (cdr (assoc :cache pre-params))))) + (new-hash (when cache-p (org-babel-sha1-hash pre-info))) + (old-hash (when cache-p (org-babel-current-result-hash)))) + (if (and cache-p (equal new-hash old-hash)) (save-excursion (goto-char (org-babel-where-is-src-block-result)) (forward-line 1) (message "%S" (org-babel-read-result))) - (prog1 (org-babel-execute-src-block - nil (funcall mkinfo (org-babel-process-params pre-params))) + (prog1 (let* ((proc-params (org-babel-process-params pre-params)) + org-confirm-babel-evaluate) + (org-babel-execute-src-block nil (funcall mkinfo proc-params))) ;; update the hash (when new-hash (org-babel-set-current-result-hash new-hash)))))) diff --git a/lisp/ob-makefile.el b/lisp/ob-makefile.el new file mode 100644 index 000000000..7b0ff932c --- /dev/null +++ b/lisp/ob-makefile.el @@ -0,0 +1,47 @@ +;;; ob-makefile.el --- org-babel functions for makefile evaluation + +;; Copyright (C) 2009-2012 Free Software Foundation, Inc. + +;; Author: Eric Schulte and Thomas S. Dye +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This file exists solely for tangling a Makefile from org-mode files. + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:makefile '()) + +(defun org-babel-execute:makefile (body params) + "Execute a block of makefile code. +This function is called by `org-babel-execute-src-block'." + body) + +(defun org-babel-prep-session:makefile (session params) + "Return an error if the :session header argument is set. Make +does not support sessions." + (error "Makefile sessions are nonsensical")) + +(provide 'ob-makefile) + + + +;;; ob-makefile.el ends here diff --git a/lisp/ob-maxima.el b/lisp/ob-maxima.el index 4a91ca9b2..726d6863e 100644 --- a/lisp/ob-maxima.el +++ b/lisp/ob-maxima.el @@ -83,16 +83,15 @@ called by `org-babel-execute-src-block'." (mapcar (lambda (line) (unless (or (string-match "batch" line) (string-match "^rat: replaced .*$" line) + (string-match "^;;; Loading #P" line) (= 0 (length line))) line)) (split-string raw "[\r\n]"))) "\n")) (org-babel-eval cmd ""))))) (if (org-babel-maxima-graphical-output-file params) nil - (if (or (member "scalar" result-params) - (member "verbatim" result-params) - (member "output" result-params)) - result + (org-babel-result-cond result-params + result (let ((tmp-file (org-babel-temp-file "maxima-res-"))) (with-temp-file tmp-file (insert result)) (org-babel-import-elisp-from-file tmp-file)))))) diff --git a/lisp/ob-mscgen.el b/lisp/ob-mscgen.el index 5838d7dec..209ad7dcc 100644 --- a/lisp/ob-mscgen.el +++ b/lisp/ob-mscgen.el @@ -55,7 +55,6 @@ ;;; Code: (require 'ob) -(require 'ob-eval) (defvar org-babel-default-header-args:mscgen '((:results . "file") (:exports . "results")) diff --git a/lisp/ob-ocaml.el b/lisp/ob-ocaml.el index bff41f8f1..6a839080b 100644 --- a/lisp/ob-ocaml.el +++ b/lisp/ob-ocaml.el @@ -36,11 +36,11 @@ ;;; Code: (require 'ob) -(require 'ob-comint) (require 'comint) (eval-when-compile (require 'cl)) (declare-function tuareg-run-caml "ext:tuareg" ()) +(declare-function tuareg-run-ocaml "ext:tuareg" ()) (declare-function tuareg-interactive-send-input "ext:tuareg" ()) (defvar org-babel-tangle-lang-exts) @@ -74,7 +74,11 @@ (progn (setq out t) nil)))) (mapcar #'org-babel-trim (reverse raw)))))))) (org-babel-reassemble-table - (org-babel-ocaml-parse-output (org-babel-trim clean)) + (let ((raw (org-babel-trim clean))) + (org-babel-result-cond (cdr (assoc :result-params params)) + ;; strip type information from output + (if (string-match "= \\(.+\\)$" raw) (match-string 1 raw) raw) + (org-babel-ocaml-parse-output raw))) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name @@ -89,8 +93,9 @@ (stringp session)) session tuareg-interactive-buffer-name))) - (save-window-excursion (tuareg-run-caml) - (get-buffer tuareg-interactive-buffer-name)))) + (save-window-excursion + (if (fboundp 'tuareg-run-caml) (tuareg-run-caml) (tuareg-run-ocaml)) + (get-buffer tuareg-interactive-buffer-name)))) (defun org-babel-variable-assignments:ocaml (params) "Return list of ocaml statements assigning the block's variables." diff --git a/lisp/ob-octave.el b/lisp/ob-octave.el index 3394d579a..c2a3abb5f 100644 --- a/lisp/ob-octave.el +++ b/lisp/ob-octave.el @@ -30,9 +30,6 @@ ;;; Code: (require 'ob) -(require 'ob-ref) -(require 'ob-comint) -(require 'ob-eval) (eval-when-compile (require 'cl)) (declare-function matlab-shell "ext:matlab-mode") diff --git a/lisp/ob-org.el b/lisp/ob-org.el index a5cd96a75..18cce3b9c 100644 --- a/lisp/ob-org.el +++ b/lisp/ob-org.el @@ -29,7 +29,8 @@ ;;; Code: (require 'ob) -(declare-function org-export-string "org-exp" (string fmt &optional dir)) +(declare-function org-export-string-as "ox" + (string backend &optional body-only ext-plist)) (defvar org-babel-default-header-args:org '((:results . "raw silent") (:exports . "code")) @@ -53,10 +54,10 @@ This function is called by `org-babel-execute-src-block'." (body (org-babel-expand-body:org (replace-regexp-in-string "^," "" body) params))) (cond - ((member "latex" result-params) (org-export-string - (concat "#+Title: \n" body) "latex")) - ((member "html" result-params) (org-export-string body "html")) - ((member "ascii" result-params) (org-export-string body "ascii")) + ((member "latex" result-params) + (org-export-string-as (concat "#+Title: \n" body) 'latex t)) + ((member "html" result-params) (org-export-string-as body 'html t)) + ((member "ascii" result-params) (org-export-string-as body 'ascii t)) (t body)))) (defun org-babel-prep-session:org (session params) diff --git a/lisp/ob-perl.el b/lisp/ob-perl.el index b37df807a..43ab9467c 100644 --- a/lisp/ob-perl.el +++ b/lisp/ob-perl.el @@ -28,7 +28,6 @@ ;;; Code: (require 'ob) -(require 'ob-eval) (eval-when-compile (require 'cl)) (defvar org-babel-tangle-lang-exts) @@ -49,7 +48,7 @@ This function is called by `org-babel-execute-src-block'." body params (org-babel-variable-assignments:perl params))) (session (org-babel-perl-initiate-session session))) (org-babel-reassemble-table - (org-babel-perl-evaluate session full-body result-type) + (org-babel-perl-evaluate session full-body result-type result-params) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name @@ -63,20 +62,33 @@ This function is called by `org-babel-execute-src-block'." "Return list of perl statements assigning the block's variables." (mapcar (lambda (pair) - (format "$%s=%s;" - (car pair) - (org-babel-perl-var-to-perl (cdr pair)))) + (org-babel-perl--var-to-perl (cdr pair) (car pair))) (mapcar #'cdr (org-babel-get-header params :var)))) ;; helper functions -(defun org-babel-perl-var-to-perl (var) +(defvar org-babel-perl-var-wrap "q(%s)" + "Wrapper for variables inserted into Perl code.") + +(defvar org-babel-perl--lvl) +(defun org-babel-perl--var-to-perl (var &optional varn) "Convert an elisp value to a perl variable. The elisp value, VAR, is converted to a string of perl source code specifying a var of the same value." - (if (listp var) - (concat "[" (mapconcat #'org-babel-perl-var-to-perl var ", ") "]") - (format "%S" var))) + (if varn + (let ((org-babel-perl--lvl 0) (lvar (listp var)) prefix) + (concat "my $" (symbol-name varn) "=" (when lvar "\n") + (org-babel-perl--var-to-perl var) + ";\n")) + (let ((prefix (make-string (* 2 org-babel-perl--lvl) ?\ ))) + (concat prefix + (if (listp var) + (let ((org-babel-perl--lvl (1+ org-babel-perl--lvl))) + (concat "[\n" + (mapconcat #'org-babel-perl--var-to-perl var "") + prefix "]")) + (format "q(%s)" var)) + (unless (zerop org-babel-perl--lvl) ",\n"))))) (defvar org-babel-perl-buffers '(:default . nil)) @@ -84,32 +96,60 @@ specifying a var of the same value." "Return nil because sessions are not supported by perl." nil) -(defvar org-babel-perl-wrapper-method - " -sub main { -%s -} -@r = main; -open(o, \">%s\"); -print o join(\"\\n\", @r), \"\\n\"") +(defvar org-babel-perl-wrapper-method "{ + my $babel_sub = sub { + %s + }; + open my $BOH, qq(>%s) or die qq(Perl: Could not open output file.$/); + my $rv = &$babel_sub(); + my $rt = ref $rv; + select $BOH; + if (qq(ARRAY) eq $rt) { + local $\\=$/; + local $,=qq(\t); + foreach my $rv ( @$rv ) { + my $rt = ref $rv; + if (qq(ARRAY) eq $rt) { + print @$rv; + } else { + print $rv; + } + } + } else { + print $rv; + } +}") + +(defvar org-babel-perl-preface nil) (defvar org-babel-perl-pp-wrapper-method nil) -(defun org-babel-perl-evaluate (session body &optional result-type) +(defun org-babel-perl-evaluate (session ibody &optional result-type result-params) "Pass BODY to the Perl process in SESSION. If RESULT-TYPE equals 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." (when session (error "Sessions are not supported for Perl")) - (case result-type - (output (org-babel-eval org-babel-perl-command body)) - (value (let ((tmp-file (org-babel-temp-file "perl-"))) - (org-babel-eval - org-babel-perl-command - (format org-babel-perl-wrapper-method body - (org-babel-process-file-name tmp-file 'noquote))) - (org-babel-eval-read-file tmp-file))))) + (let* ((body (concat org-babel-perl-preface ibody)) + (tmp-file (org-babel-temp-file "perl-")) + (tmp-babel-file (org-babel-process-file-name + tmp-file 'noquote))) + ((lambda (results) + (when results + (org-babel-result-cond result-params + (org-babel-eval-read-file tmp-file) + (org-babel-import-elisp-from-file tmp-file '(16))))) + (case result-type + (output + (with-temp-file tmp-file + (insert + (org-babel-eval org-babel-perl-command body)) + (buffer-string))) + (value + (org-babel-eval org-babel-perl-command + (format org-babel-perl-wrapper-method + body tmp-babel-file))))))) (provide 'ob-perl) diff --git a/lisp/ob-picolisp.el b/lisp/ob-picolisp.el index 1029b6f2a..1d1791926 100644 --- a/lisp/ob-picolisp.el +++ b/lisp/ob-picolisp.el @@ -54,8 +54,6 @@ ;;; Code: (require 'ob) -(require 'ob-eval) -(require 'ob-comint) (require 'comint) (eval-when-compile (require 'cl)) @@ -80,7 +78,7 @@ :version "24.1" :type 'string) -(defun org-babel-expand-body:picolisp (body params &optional processed-params) +(defun org-babel-expand-body:picolisp (body params) "Expand BODY according to PARAMS, return the expanded body." (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) (result-params (cdr (assoc :result-params params))) @@ -123,13 +121,8 @@ (t full-body)))) ((lambda (result) - (if (or (member "verbatim" result-params) - (member "scalar" result-params) - (member "output" result-params) - (member "code" result-params) - (member "pp" result-params) - (= (length result) 0)) - result + (org-babel-result-cond result-params + result (read result))) (if (not (string= session-name "none")) ;; session based evaluation diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el index bb52c376b..c17d4448a 100644 --- a/lisp/ob-plantuml.el +++ b/lisp/ob-plantuml.el @@ -35,7 +35,6 @@ ;;; Code: (require 'ob) -(require 'ob-eval) (defvar org-babel-default-header-args:plantuml '((:results . "file") (:exports . "results")) diff --git a/lisp/ob-python.el b/lisp/ob-python.el index 79cc53ea0..eca4c82cd 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -28,9 +28,6 @@ ;;; Code: (require 'ob) -(require 'ob-ref) -(require 'ob-comint) -(require 'ob-eval) (eval-when-compile (require 'cl)) (declare-function org-remove-indentation "org" ) @@ -43,15 +40,38 @@ (defvar org-babel-default-header-args:python '()) -(defvar org-babel-python-command "python" - "Name of the command for executing Python code.") +(defcustom org-babel-python-command "python" + "Name of the command for executing Python code." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-babel + :type 'string) -(defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python) +(defcustom org-babel-python-mode + (if (or (featurep 'xemacs) (featurep 'python-mode)) 'python-mode 'python) "Preferred python mode for use in running python interactively. -This will typically be either 'python or 'python-mode.") +This will typically be either 'python or 'python-mode." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) (defvar org-src-preserve-indentation) +(defcustom org-babel-python-hline-to "None" + "Replace hlines in incoming tables with this when translating to python." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-babel-python-None-to 'hline + "Replace 'None' in python tables with this before returning." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + (defun org-babel-execute:python (body params) "Execute a block of Python code with Babel. This function is called by `org-babel-execute-src-block'." @@ -114,7 +134,7 @@ specifying a variable of the same value." (if (listp var) (concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]") (if (equal var 'hline) - "None" + org-babel-python-hline-to (format (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S") var)))) @@ -123,14 +143,34 @@ specifying a variable of the same value." "Convert RESULTS into an appropriate elisp value. If the results look like a list or tuple, then convert them into an Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape results)) + ((lambda (res) + (if (listp res) + (mapcar (lambda (el) (if (equal el 'None) + org-babel-python-None-to el)) + res) + res)) + (org-babel-script-escape results))) -(defvar org-babel-python-buffers '((:default . nil))) +(defvar org-babel-python-buffers '((:default . "*Python*"))) (defun org-babel-python-session-buffer (session) "Return the buffer associated with SESSION." (cdr (assoc session org-babel-python-buffers))) +(defun org-babel-python-with-earmufs (session) + (let ((name (if (stringp session) session (format "%s" session)))) + (if (and (string= "*" (substring name 0 1)) + (string= "*" (substring name (- (length name) 1)))) + name + (format "*%s*" name)))) + +(defun org-babel-python-without-earmufs (session) + (let ((name (if (stringp session) session (format "%s" session)))) + (if (and (string= "*" (substring name 0 1)) + (string= "*" (substring name (- (length name) 1)))) + (substring name 1 (- (length name) 1)) + name))) + (defvar py-default-interpreter) (defun org-babel-python-initiate-session-by-key (&optional session) "Initiate a python session. @@ -144,7 +184,15 @@ then create. Return the initialized session." ((and (eq 'python org-babel-python-mode) (fboundp 'run-python)) ; python.el (if (version< "24.1" emacs-version) - (run-python org-babel-python-command) + (progn + (unless python-buffer + (setq python-buffer (org-babel-python-with-earmufs session))) + (let ((python-shell-buffer-name + (org-babel-python-without-earmufs python-buffer))) + (run-python + (if (member system-type '(cygwin windows-nt ms-dos)) + (concat org-babel-python-command " -i") + org-babel-python-command)))) (run-python))) ((and (eq 'python-mode org-babel-python-mode) (fboundp 'py-shell)) ; python-mode.el @@ -160,7 +208,7 @@ then create. Return the initialized session." (concat "Python-" (symbol-name session)))) (py-which-bufname bufname)) (py-shell) - (setq python-buffer (concat "*" bufname "*")))) + (setq python-buffer (org-babel-python-with-earmufs bufname)))) (t (error "No function available for running an inferior Python"))) (setq org-babel-python-buffers @@ -206,11 +254,8 @@ If RESULT-TYPE equals 'output then return standard output as a string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." ((lambda (raw) - (if (or (member "code" result-params) - (member "pp" result-params) - (and (member "output" result-params) - (not (member "table" result-params)))) - raw + (org-babel-result-cond result-params + raw (org-babel-python-table-or-string (org-babel-trim raw)))) (case result-type (output (org-babel-eval org-babel-python-command @@ -259,11 +304,8 @@ last statement in BODY, as elisp." (funcall send-wait)))) ((lambda (results) (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results) - (if (or (member "code" result-params) - (member "pp" result-params) - (and (member "output" result-params) - (not (member "table" result-params)))) - results + (org-babel-result-cond result-params + results (org-babel-python-table-or-string results)))) (case result-type (output diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index 389c36318..a2814eae3 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -40,7 +40,7 @@ ;; So an example of a simple src block referencing table data in the ;; same file would be -;; #+TBLNAME: sandbox +;; #+NAME: sandbox ;; | 1 | 2 | 3 | ;; | 4 | org-babel | 6 | ;; @@ -49,7 +49,7 @@ ;; #+end_src ;;; Code: -(require 'ob) +(require 'ob-core) (eval-when-compile (require 'cl)) diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el index 747c6fc3d..20fb418aa 100644 --- a/lisp/ob-ruby.el +++ b/lisp/ob-ruby.el @@ -37,9 +37,6 @@ ;;; Code: (require 'ob) -(require 'ob-ref) -(require 'ob-comint) -(require 'ob-eval) (eval-when-compile (require 'cl)) (declare-function run-ruby "ext:inf-ruby" (&optional command name)) @@ -71,7 +68,9 @@ This function is called by `org-babel-execute-src-block'." (org-babel-ruby-evaluate session full-body result-type result-params)))) (org-babel-reassemble-table - result + (org-babel-result-cond result-params + result + (org-babel-ruby-table-or-string result)) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name (cdr (assoc :rowname-names params)) @@ -206,31 +205,27 @@ return the value of the last statement in BODY, as elisp." (comint-send-input nil t)) 2) "\n") "[\r\n]")) "\n")) (value - ((lambda (results) - (if (or (member "code" result-params) (member "pp" result-params)) - results - (org-babel-ruby-table-or-string results))) - (let* ((tmp-file (org-babel-temp-file "ruby-")) - (ppp (or (member "code" result-params) - (member "pp" result-params)))) - (org-babel-comint-with-output - (buffer org-babel-ruby-eoe-indicator t body) - (when ppp (insert "require 'pp';") (comint-send-input nil t)) - (mapc - (lambda (line) - (insert (org-babel-chomp line)) (comint-send-input nil t)) - (append - (list body) - (if (not ppp) - (list (format org-babel-ruby-f-write - (org-babel-process-file-name tmp-file 'noquote))) - (list - "results=_" "require 'pp'" "orig_out = $stdout" - (format org-babel-ruby-pp-f-write - (org-babel-process-file-name tmp-file 'noquote)))) - (list org-babel-ruby-eoe-indicator))) - (comint-send-input nil t)) - (org-babel-eval-read-file tmp-file))))))) + (let* ((tmp-file (org-babel-temp-file "ruby-")) + (ppp (or (member "code" result-params) + (member "pp" result-params)))) + (org-babel-comint-with-output + (buffer org-babel-ruby-eoe-indicator t body) + (when ppp (insert "require 'pp';") (comint-send-input nil t)) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (append + (list body) + (if (not ppp) + (list (format org-babel-ruby-f-write + (org-babel-process-file-name tmp-file 'noquote))) + (list + "results=_" "require 'pp'" "orig_out = $stdout" + (format org-babel-ruby-pp-f-write + (org-babel-process-file-name tmp-file 'noquote)))) + (list org-babel-ruby-eoe-indicator))) + (comint-send-input nil t)) + (org-babel-eval-read-file tmp-file)))))) (defun org-babel-ruby-read-string (string) "Strip \\\"s from around a ruby string." diff --git a/lisp/ob-sass.el b/lisp/ob-sass.el index 60a10dbee..cdb75bea0 100644 --- a/lisp/ob-sass.el +++ b/lisp/ob-sass.el @@ -39,7 +39,6 @@ ;;; Code: (require 'ob) -(require 'ob-eval) (defvar org-babel-default-header-args:sass '()) diff --git a/lisp/ob-scala.el b/lisp/ob-scala.el index 3a07b344b..7cb3099c0 100644 --- a/lisp/ob-scala.el +++ b/lisp/ob-scala.el @@ -31,9 +31,6 @@ ;;; Code: (require 'ob) -(require 'ob-ref) -(require 'ob-comint) -(require 'ob-eval) (eval-when-compile (require 'cl)) (defvar org-babel-tangle-lang-exts) ;; Autoloaded @@ -104,8 +101,8 @@ in BODY as elisp." (wrapper (format org-babel-scala-wrapper-method body))) (with-temp-file src-file (insert wrapper)) ((lambda (raw) - (if (member "code" result-params) - raw + (org-babel-result-cond result-params + raw (org-babel-scala-table-or-string raw))) (org-babel-eval (concat org-babel-scala-command " " src-file) "")))))) diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el index bd7ea823f..89dd00331 100644 --- a/lisp/ob-scheme.el +++ b/lisp/ob-scheme.el @@ -38,9 +38,6 @@ ;;; Code: (require 'ob) -(require 'ob-ref) -(require 'ob-comint) -(require 'ob-eval) (eval-when-compile (require 'cl)) (declare-function run-scheme "ext:cmuscheme" (cmd)) @@ -75,29 +72,31 @@ 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))) - (read - (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)) "")))))) + (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." diff --git a/lisp/ob-screen.el b/lisp/ob-screen.el index 621110b2d..f26337697 100644 --- a/lisp/ob-screen.el +++ b/lisp/ob-screen.el @@ -34,7 +34,6 @@ ;;; Code: (require 'ob) -(require 'ob-ref) (defvar org-babel-screen-location "screen" "The command location for screen. diff --git a/lisp/ob-sh.el b/lisp/ob-sh.el index c0e6b15fe..f11b799f6 100644 --- a/lisp/ob-sh.el +++ b/lisp/ob-sh.el @@ -27,9 +27,6 @@ ;;; Code: (require 'ob) -(require 'ob-ref) -(require 'ob-comint) -(require 'ob-eval) (require 'shell) (eval-when-compile (require 'cl)) @@ -141,10 +138,8 @@ return the value of the last statement in BODY." ((lambda (results) (when results (let ((result-params (cdr (assoc :result-params params)))) - (if (or (member "scalar" result-params) - (member "verbatim" result-params) - (member "output" result-params)) - results + (org-babel-result-cond result-params + results (let ((tmp-file (org-babel-temp-file "sh-"))) (with-temp-file tmp-file (insert results)) (org-babel-import-elisp-from-file tmp-file)))))) diff --git a/lisp/ob-shen.el b/lisp/ob-shen.el index ec31546a0..a41580fe2 100644 --- a/lisp/ob-shen.el +++ b/lisp/ob-shen.el @@ -66,9 +66,8 @@ This function is called by `org-babel-execute-src-block'" (result-params (cdr (assoc :result-params params))) (full-body (org-babel-expand-body:shen body params))) ((lambda (results) - (if (or (member 'scalar result-params) - (member 'verbatim result-params)) - results + (org-babel-result-cond result-params + results (condition-case nil (org-babel-script-escape results) (error results)))) (with-temp-buffer diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el index 131fa46f1..658a54f1d 100644 --- a/lisp/ob-sql.el +++ b/lisp/ob-sql.el @@ -32,12 +32,24 @@ ;; ;; Also SQL evaluation generally takes place inside of a database. ;; -;; For now lets just allow a generic ':cmdline' header argument. +;; Header args used: +;; - engine +;; - cmdline +;; - dbhost +;; - dbuser +;; - dbpassword +;; - database +;; - colnames (default, nil, means "yes") +;; - result-params +;; - out-file +;; The following are used but not really implemented for SQL: +;; - colname-names +;; - rownames +;; - rowname-names ;; ;; TODO: ;; ;; - support for sessions -;; - add more useful header arguments (user, passwd, database, etc...) ;; - support for more engines (currently only supports mysql) ;; - what's a reasonable way to drop table data into SQL? ;; @@ -52,30 +64,49 @@ (defvar org-babel-default-header-args:sql '()) -(defvar org-babel-header-args:sql - '((engine . :any) - (out-file . :any))) +(defconst org-babel-header-args:sql + '((engine . :any) + (out-file . :any) + (dbhost . :any) + (dbuser . :any) + (dbpassword . :any) + (database . :any)) + "SQL-specific header arguments.") (defun org-babel-expand-body:sql (body params) "Expand BODY according to the values of PARAMS." (org-babel-sql-expand-vars body (mapcar #'cdr (org-babel-get-header params :var)))) +(defun dbstring-mysql (host user password database) + "Make MySQL cmd line args for database connection. Pass nil to omit that arg." + (combine-and-quote-strings + (remq nil + (list (when host (concat "-h" host)) + (when user (concat "-u" user)) + (when password (concat "-p" password)) + (when database (concat "-D" database)))))) + (defun org-babel-execute:sql (body params) "Execute a block of Sql code with Babel. This function is called by `org-babel-execute-src-block'." (let* ((result-params (cdr (assoc :result-params params))) (cmdline (cdr (assoc :cmdline params))) + (dbhost (cdr (assoc :dbhost params))) + (dbuser (cdr (assoc :dbuser params))) + (dbpassword (cdr (assoc :dbpassword params))) + (database (cdr (assoc :database params))) (engine (cdr (assoc :engine params))) + (colnames-p (not (equal "no" (cdr (assoc :colnames params))))) (in-file (org-babel-temp-file "sql-in-")) (out-file (or (cdr (assoc :out-file params)) (org-babel-temp-file "sql-out-"))) (header-delim "") (command (case (intern engine) - ('dbi (format "dbish --batch '%s' < %s | sed '%s' > %s" + ('dbi (format "dbish --batch %s < %s | sed '%s' > %s" (or cmdline "") (org-babel-process-file-name in-file) - "/^+/d;s/^\|//;$d" + "/^+/d;s/^\|//;s/(NULL)/ /g;$d" (org-babel-process-file-name out-file))) ('monetdb (format "mclient -f tab %s < %s > %s" (or cmdline "") @@ -85,7 +116,9 @@ This function is called by `org-babel-execute-src-block'." (or cmdline "") (org-babel-process-file-name in-file) (org-babel-process-file-name out-file))) - ('mysql (format "mysql %s < %s > %s" + ('mysql (format "mysql %s %s %s < %s > %s" + (dbstring-mysql dbhost dbuser dbpassword database) + (if colnames-p "" "-N") (or cmdline "") (org-babel-process-file-name in-file) (org-babel-process-file-name out-file))) @@ -102,28 +135,39 @@ This function is called by `org-babel-execute-src-block'." (t "")) (org-babel-expand-body:sql body params))) (message command) - (shell-command command) - (if (or (member "scalar" result-params) - (member "verbatim" result-params) - (member "html" result-params) - (member "code" result-params) - (equal (point-min) (point-max))) - (with-temp-buffer + (org-babel-eval command "") + (org-babel-result-cond result-params + (with-temp-buffer (progn (insert-file-contents-literally out-file) (buffer-string))) (with-temp-buffer - ;; need to figure out what the delimiter is for the header row - (with-temp-buffer - (insert-file-contents out-file) - (goto-char (point-min)) - (when (re-search-forward "^\\(-+\\)[^-]" nil t) - (setq header-delim (match-string-no-properties 1))) - (goto-char (point-max)) - (forward-char -1) - (while (looking-at "\n") - (delete-char 1) - (goto-char (point-max)) - (forward-char -1)) - (write-file out-file)) + (cond + ((or (eq (intern engine) 'mysql) + (eq (intern engine) 'dbi) + (eq (intern engine) 'postgresql)) + ;; Add header row delimiter after column-names header in first line + (cond + (colnames-p + (with-temp-buffer + (insert-file-contents out-file) + (goto-char (point-min)) + (forward-line 1) + (insert "-\n") + (setq header-delim "-") + (write-file out-file))))) + (t + ;; Need to figure out the delimiter for the header row + (with-temp-buffer + (insert-file-contents out-file) + (goto-char (point-min)) + (when (re-search-forward "^\\(-+\\)[^-]" nil t) + (setq header-delim (match-string-no-properties 1))) + (goto-char (point-max)) + (forward-char -1) + (while (looking-at "\n") + (delete-char 1) + (goto-char (point-max)) + (forward-char -1)) + (write-file out-file)))) (org-table-import out-file '(16)) (org-babel-reassemble-table (mapcar (lambda (x) diff --git a/lisp/ob-sqlite.el b/lisp/ob-sqlite.el index c25e786fb..84d4688ab 100644 --- a/lisp/ob-sqlite.el +++ b/lisp/ob-sqlite.el @@ -27,8 +27,6 @@ ;;; Code: (require 'ob) -(require 'ob-eval) -(require 'ob-ref) (declare-function org-fill-template "org" (template alist)) (declare-function org-table-convert-region "org-table" @@ -98,23 +96,21 @@ This function is called by `org-babel-execute-src-block'." (cons "db " db))) ;; body of the code block (org-babel-expand-body:sqlite body params))) - (if (or (member "scalar" result-params) - (member "verbatim" result-params) - (member "html" result-params) - (member "code" result-params) - (equal (point-min) (point-max))) - (buffer-string) - (org-table-convert-region (point-min) (point-max) - (if (or (member :csv others) - (member :column others) - (member :line others) - (member :list others) - (member :html others) separator) - nil - '(4))) - (org-babel-sqlite-table-or-scalar - (org-babel-sqlite-offset-colnames - (org-table-to-lisp) headers-p)))))) + (org-babel-result-cond result-params + (buffer-string) + (if (equal (point-min) (point-max)) + "" + (org-table-convert-region (point-min) (point-max) + (if (or (member :csv others) + (member :column others) + (member :line others) + (member :list others) + (member :html others) separator) + nil + '(4))) + (org-babel-sqlite-table-or-scalar + (org-babel-sqlite-offset-colnames + (org-table-to-lisp) headers-p))))))) (defun org-babel-sqlite-expand-vars (body vars) "Expand the variables held in VARS in BODY." @@ -147,7 +143,7 @@ This function is called by `org-babel-execute-src-block'." (mapcar (lambda (row) (if (equal 'hline row) 'hline - (mapcar #'org-babel-read row))) result))) + (mapcar #'org-babel-string-read row))) result))) (defun org-babel-sqlite-offset-colnames (table headers-p) "If HEADERS-P is non-nil then offset the first row as column names." diff --git a/lisp/ob-table.el b/lisp/ob-table.el index 99951cab7..869d99206 100644 --- a/lisp/ob-table.el +++ b/lisp/ob-table.el @@ -50,7 +50,7 @@ ;; #+TBLFM: $2='(sbe 'fibbd (n $1)) ;;; Code: -(require 'ob) +(require 'ob-core) (defun org-babel-table-truncate-at-newline (string) "Replace newline character with ellipses. diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index c3b6a483e..f15567fda 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -26,7 +26,6 @@ ;; Extract the code from source blocks out into raw source-code files. ;;; Code: -(require 'ob) (require 'org-src) (eval-when-compile (require 'cl)) @@ -136,27 +135,6 @@ evaluating BODY." ,temp-result))) (def-edebug-spec org-babel-with-temp-filebuffer (form body)) -;;;###autoload -(defun org-babel-load-file (file) - "Load Emacs Lisp source code blocks in the Org-mode FILE. -This function exports the source code using -`org-babel-tangle' and then loads the resulting file using -`load-file'." - (interactive "fFile to load: ") - (let* ((age (lambda (file) - (float-time - (time-subtract (current-time) - (nth 5 (or (file-attributes (file-truename file)) - (file-attributes file))))))) - (base-name (file-name-sans-extension file)) - (exported-file (concat base-name ".el"))) - ;; tangle if the org-mode file is newer than the elisp file - (unless (and (file-exists-p exported-file) - (> (funcall age file) (funcall age exported-file))) - (org-babel-tangle-file file exported-file "emacs-lisp")) - (load-file exported-file) - (message "Loaded %s" exported-file))) - ;;;###autoload (defun org-babel-tangle-file (file &optional target-file lang) "Extract the bodies of source code blocks in FILE. @@ -179,26 +157,25 @@ used to limit the exported source code blocks by language." (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) ;;;###autoload -(defun org-babel-tangle (&optional only-this-block target-file lang) +(defun org-babel-tangle (&optional arg target-file lang) "Write code blocks to source-specific files. Extract the bodies of all source code blocks from the current -file into their own source-specific files. Optional argument -TARGET-FILE can be used to specify a default export file for all -source blocks. Optional argument LANG can be used to limit the -exported source code blocks by language." +file into their own source-specific files. +With one universal prefix argument, only tangle the block at point. +When two universal prefix arguments, only tangle blocks for the +tangle file of the block at point. +Optional argument TARGET-FILE can be used to specify a default +export file for all source blocks. Optional argument LANG can be +used to limit the exported source code blocks by language." (interactive "P") (run-hooks 'org-babel-pre-tangle-hook) - ;; possibly restrict the buffer to the current code block + ;; Possibly Restrict the buffer to the current code block (save-restriction - (when only-this-block - (unless (org-babel-where-is-src-block-head) - (error "Point is not currently inside of a code block")) - (save-match-data - (unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info)))) - target-file) - (setq target-file - (read-from-minibuffer "Tangle to: " (buffer-file-name))))) - (narrow-to-region (match-beginning 0) (match-end 0))) + (when (equal arg '(4)) + (let ((head (org-babel-where-is-src-block-head))) + (if head + (goto-char head) + (user-error "Point is not in a source code block")))) (save-excursion (let ((block-counter 0) (org-babel-default-header-args @@ -206,6 +183,10 @@ exported source code blocks by language." (org-babel-merge-params org-babel-default-header-args (list (cons :tangle target-file))) org-babel-default-header-args)) + (tangle-file + (when (equal arg '(16)) + (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info)))) + (user-error "Point is not in a source code block")))) path-collector) (mapc ;; map over all languages (lambda (by-lang) @@ -266,7 +247,9 @@ exported source code blocks by language." (setq block-counter (+ 1 block-counter)) (add-to-list 'path-collector file-name))))) specs))) - (org-babel-tangle-collect-blocks lang)) + (if (equal arg '(4)) + (org-babel-tangle-single-block 1 t) + (org-babel-tangle-collect-blocks lang tangle-file))) (message "Tangled %d code block%s from %s" block-counter (if (= block-counter 1) "" "s") (file-name-nondirectory @@ -298,12 +281,12 @@ references." (defvar org-bracket-link-regexp) (defun org-babel-spec-to-string (spec) "Insert SPEC into the current file. -Insert the source-code specified by SPEC into the current -source code file. This function uses `comment-region' which -assumes that the appropriate major-mode is set. SPEC has the -form - (start-line file link source-name params body comment)" +Insert the source-code specified by SPEC into the current source +code file. This function uses `comment-region' which assumes +that the appropriate major-mode is set. SPEC has the form: + + \(start-line file link source-name params body comment)" (let* ((start-line (nth 0 spec)) (file (nth 1 spec)) (link (nth 2 spec)) @@ -335,116 +318,137 @@ form (insert (format "%s\n" - (replace-regexp-in-string - "^," "" + (org-unescape-code-in-string (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]"))))) (when link-p (funcall insert-comment (org-fill-template org-babel-tangle-comment-format-end link-data))))) -(defun org-babel-tangle-collect-blocks (&optional language) +(defvar org-comment-string) ;; Defined in org.el +(defun org-babel-tangle-collect-blocks (&optional language tangle-file) "Collect source blocks in the current Org-mode file. Return an association list of source-code block specifications of the form used by `org-babel-spec-to-string' grouped by language. -Optional argument LANG can be used to limit the collected source -code blocks by language." - (let ((block-counter 1) (current-heading "") blocks) +Optional argument LANGUAGE can be used to limit the collected +source code blocks by language. Optional argument TANGLE-FILE +can be used to limit the collected code blocks by target file." + (let ((block-counter 1) (current-heading "") blocks by-lang) (org-babel-map-src-blocks (buffer-file-name) - ((lambda (new-heading) - (if (not (string= new-heading current-heading)) - (progn - (setq block-counter 1) - (setq current-heading new-heading)) - (setq block-counter (+ 1 block-counter)))) - (replace-regexp-in-string "[ \t]" "-" - (condition-case nil - (or (nth 4 (org-heading-components)) - "(dummy for heading without text)") - (error (buffer-file-name))))) - (let* ((start-line (save-restriction (widen) - (+ 1 (line-number-at-pos (point))))) - (file (buffer-file-name)) - (info (org-babel-get-src-block-info 'light)) - (src-lang (nth 0 info))) - (unless (string= (cdr (assoc :tangle (nth 2 info))) "no") + (lambda (new-heading) + (if (not (string= new-heading current-heading)) + (progn + (setq block-counter 1) + (setq current-heading new-heading)) + (setq block-counter (+ 1 block-counter)))) + (replace-regexp-in-string "[ \t]" "-" + (condition-case nil + (or (nth 4 (org-heading-components)) + "(dummy for heading without text)") + (error (buffer-file-name)))) + (let* ((info (org-babel-get-src-block-info 'light)) + (src-lang (nth 0 info)) + (src-tfile (cdr (assoc :tangle (nth 2 info))))) + (unless (or (string-match (concat "^" org-comment-string) current-heading) + (string= (cdr (assoc :tangle (nth 2 info))) "no") + (and tangle-file (not (equal tangle-file src-tfile)))) (unless (and language (not (string= language src-lang))) - (let* ((info (org-babel-get-src-block-info)) - (params (nth 2 info)) - (extra (nth 3 info)) - (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra) - (match-string 1 extra)) - org-coderef-label-format)) - (link ((lambda (link) - (and (string-match org-bracket-link-regexp link) - (match-string 1 link))) - (org-no-properties - (org-store-link nil)))) - (source-name - (intern (or (nth 4 info) - (format "%s:%d" - current-heading block-counter)))) - (expand-cmd - (intern (concat "org-babel-expand-body:" src-lang))) - (assignments-cmd - (intern (concat "org-babel-variable-assignments:" src-lang))) - (body - ((lambda (body) ;; run the tangle-body-hook - (with-temp-buffer - (insert body) - (when (string-match "-r" extra) - (goto-char (point-min)) - (while (re-search-forward - (replace-regexp-in-string "%s" ".+" cref-fmt) nil t) - (replace-match ""))) - (run-hooks 'org-babel-tangle-body-hook) - (buffer-string))) - ((lambda (body) ;; expand the body in language specific manner - (if (assoc :no-expand params) - body - (if (fboundp expand-cmd) - (funcall expand-cmd body params) - (org-babel-expand-body:generic - body params - (and (fboundp assignments-cmd) - (funcall assignments-cmd params)))))) - (if (org-babel-noweb-p params :tangle) - (org-babel-expand-noweb-references info) - (nth 1 info))))) - (comment - (when (or (string= "both" (cdr (assoc :comments params))) - (string= "org" (cdr (assoc :comments params)))) - ;; from the previous heading or code-block end - (funcall - org-babel-process-comment-text - (buffer-substring - (max (condition-case nil - (save-excursion - (org-back-to-heading t) ; sets match data - (match-end 0)) - (error (point-min))) - (save-excursion - (if (re-search-backward - org-babel-src-block-regexp nil t) - (match-end 0) - (point-min)))) - (point))))) - by-lang) - ;; add the spec for this block to blocks under it's language - (setq by-lang (cdr (assoc src-lang blocks))) - (setq blocks (delq (assoc src-lang blocks) blocks)) - (setq blocks (cons - (cons src-lang - (cons (list start-line file link - source-name params body comment) - by-lang)) blocks))))))) - ;; ensure blocks in the correct order + ;; Add the spec for this block to blocks under it's language + (setq by-lang (cdr (assoc src-lang blocks))) + (setq blocks (delq (assoc src-lang blocks) blocks)) + (setq blocks (cons + (cons src-lang + (cons + (org-babel-tangle-single-block + block-counter) + by-lang)) blocks)))))) + ;; Ensure blocks are in the correct order (setq blocks (mapcar (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) blocks)) blocks)) +(defun org-babel-tangle-single-block + (block-counter &optional only-this-block) + "Collect the tangled source for current block. +Return the list of block attributes needed by +`org-babel-tangle-collect-blocks'. +When ONLY-THIS-BLOCK is non-nil, return the full association +list to be used by `org-babel-tangle' directly." + (let* ((info (org-babel-get-src-block-info)) + (start-line + (save-restriction (widen) + (+ 1 (line-number-at-pos (point))))) + (file (buffer-file-name)) + (src-lang (nth 0 info)) + (params (nth 2 info)) + (extra (nth 3 info)) + (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra) + (match-string 1 extra)) + org-coderef-label-format)) + (link ((lambda (link) + (and (string-match org-bracket-link-regexp link) + (match-string 1 link))) + (org-no-properties + (org-store-link nil)))) + (source-name + (intern (or (nth 4 info) + (format "%s:%d" + (or (ignore-errors (nth 4 (org-heading-components))) + "No heading") + block-counter)))) + (expand-cmd + (intern (concat "org-babel-expand-body:" src-lang))) + (assignments-cmd + (intern (concat "org-babel-variable-assignments:" src-lang))) + (body + ((lambda (body) ;; Run the tangle-body-hook + (with-temp-buffer + (insert body) + (when (string-match "-r" extra) + (goto-char (point-min)) + (while (re-search-forward + (replace-regexp-in-string "%s" ".+" cref-fmt) nil t) + (replace-match ""))) + (run-hooks 'org-babel-tangle-body-hook) + (buffer-string))) + ((lambda (body) ;; Expand the body in language specific manner + (if (assoc :no-expand params) + body + (if (fboundp expand-cmd) + (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params + (and (fboundp assignments-cmd) + (funcall assignments-cmd params)))))) + (if (org-babel-noweb-p params :tangle) + (org-babel-expand-noweb-references info) + (nth 1 info))))) + (comment + (when (or (string= "both" (cdr (assoc :comments params))) + (string= "org" (cdr (assoc :comments params)))) + ;; From the previous heading or code-block end + (funcall + org-babel-process-comment-text + (buffer-substring + (max (condition-case nil + (save-excursion + (org-back-to-heading t) ; Sets match data + (match-end 0)) + (error (point-min))) + (save-excursion + (if (re-search-backward + org-babel-src-block-regexp nil t) + (match-end 0) + (point-min)))) + (point))))) + (result + (list start-line file link source-name params body comment))) + (if only-this-block + (list (cons src-lang (list result))) + result))) + (defun org-babel-tangle-comment-links ( &optional info) "Return a list of begin and end link comments for the code block at point." (let* ((start-line (org-babel-where-is-src-block-head)) diff --git a/lisp/ob.el b/lisp/ob.el index 724571481..6cacac7ae 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -3,7 +3,6 @@ ;; Copyright (C) 2009-2013 Free Software Foundation, Inc. ;; Authors: Eric Schulte -;; Dan Davison ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org @@ -23,2564 +22,15 @@ ;; along with GNU Emacs. If not, see . ;;; Code: -(eval-when-compile - (require 'cl)) (require 'ob-eval) -(require 'org-macs) -(require 'org-compat) - -(defconst org-babel-exeext - (if (memq system-type '(windows-nt cygwin)) - ".exe" - nil)) -(defvar org-babel-call-process-region-original) -(defvar org-src-lang-modes) -(defvar org-babel-library-of-babel) -(declare-function show-all "outline" ()) -(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) -(declare-function org-mark-ring-push "org" (&optional pos buffer)) -(declare-function tramp-compat-make-temp-file "tramp-compat" - (filename &optional dir-flag)) -(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) -(declare-function tramp-file-name-user "tramp" (vec)) -(declare-function tramp-file-name-host "tramp" (vec)) -(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) -(declare-function org-icompleting-read "org" (&rest args)) -(declare-function org-edit-src-code "org-src" - (&optional context code edit-buffer-name quietp)) -(declare-function org-edit-src-exit "org-src" (&optional context)) -(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) -(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body)) -(declare-function org-outline-overlay-data "org" (&optional use-markers)) -(declare-function org-set-outline-overlay-data "org" (data)) -(declare-function org-narrow-to-subtree "org" ()) -(declare-function org-entry-get "org" - (pom property &optional inherit literal-nil)) -(declare-function org-make-options-regexp "org" (kwds &optional extra)) -(declare-function org-do-remove-indentation "org" (&optional n)) -(declare-function org-show-context "org" (&optional key)) -(declare-function org-at-table-p "org" (&optional table-type)) -(declare-function org-cycle "org" (&optional arg)) -(declare-function org-uniquify "org" (list)) -(declare-function org-current-level "org" ()) -(declare-function org-table-import "org-table" (file arg)) -(declare-function org-add-hook "org-compat" - (hook function &optional append local)) -(declare-function org-table-align "org-table" ()) -(declare-function org-table-end "org-table" (&optional table-type)) -(declare-function orgtbl-to-generic "org-table" (table params)) -(declare-function orgtbl-to-orgtbl "org-table" (table params)) -(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) -(declare-function org-babel-lob-get-info "ob-lob" nil) -(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) -(declare-function org-babel-ref-parse "ob-ref" (assignment)) -(declare-function org-babel-ref-resolve "ob-ref" (ref)) -(declare-function org-babel-ref-goto-headline-id "ob-ref" (id)) -(declare-function org-babel-ref-headline-body "ob-ref" ()) -(declare-function org-babel-lob-execute-maybe "ob-lob" ()) -(declare-function org-number-sequence "org-compat" (from &optional to inc)) -(declare-function org-at-item-p "org-list" ()) -(declare-function org-list-parse-list "org-list" (&optional delete)) -(declare-function org-list-to-generic "org-list" (LIST PARAMS)) -(declare-function org-list-struct "org-list" ()) -(declare-function org-list-prevs-alist "org-list" (struct)) -(declare-function org-list-get-list-end "org-list" (item struct prevs)) -(declare-function org-remove-if "org" (predicate seq)) -(declare-function org-completing-read "org" (&rest args)) -(declare-function org-escape-code-in-region "org-src" (beg end)) -(declare-function org-unescape-code-in-string "org-src" (s)) -(declare-function org-table-to-lisp "org-table" (&optional txt)) - -(defgroup org-babel nil - "Code block evaluation and management in `org-mode' documents." - :tag "Babel" - :group 'org) - -(defcustom org-confirm-babel-evaluate t - "Confirm before evaluation. -Require confirmation before interactively evaluating code -blocks in Org-mode buffers. The default value of this variable -is t, meaning confirmation is required for any code block -evaluation. This variable can be set to nil to inhibit any -future confirmation requests. This variable can also be set to a -function which takes two arguments the language of the code block -and the body of the code block. Such a function should then -return a non-nil value if the user should be prompted for -execution or nil if no prompt is required. - -Warning: Disabling confirmation may result in accidental -evaluation of potentially harmful code. It may be advisable -remove code block execution from C-c C-c as further protection -against accidental code block evaluation. The -`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to -remove code block execution from the C-c C-c keybinding." - :group 'org-babel - :version "24.1" - :type '(choice boolean function)) -;; don't allow this variable to be changed through file settings -(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t))) - -(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil - "Remove code block evaluation from the C-c C-c key binding." - :group 'org-babel - :version "24.1" - :type 'boolean) - -(defcustom org-babel-results-keyword "RESULTS" - "Keyword used to name results generated by code blocks. -Should be either RESULTS or NAME however any capitalization may -be used." - :group 'org-babel - :type 'string) - -(defcustom org-babel-noweb-wrap-start "<<" - "String used to begin a noweb reference in a code block. -See also `org-babel-noweb-wrap-end'." - :group 'org-babel - :type 'string) - -(defcustom org-babel-noweb-wrap-end ">>" - "String used to end a noweb reference in a code block. -See also `org-babel-noweb-wrap-start'." - :group 'org-babel - :type 'string) - -(defun org-babel-noweb-wrap (&optional regexp) - (concat org-babel-noweb-wrap-start - (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") - org-babel-noweb-wrap-end)) - -(defvar org-babel-src-name-regexp - "^[ \t]*#\\+name:[ \t]*" - "Regular expression used to match a source name line.") - -(defvar org-babel-multi-line-header-regexp - "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$" - "Regular expression used to match multi-line header arguments.") - -(defvar org-babel-src-name-w-name-regexp - (concat org-babel-src-name-regexp - "\\(" - org-babel-multi-line-header-regexp - "\\)*" - "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)") - "Regular expression matching source name lines with a name.") - -(defvar org-babel-src-block-regexp - (concat - ;; (1) indentation (2) lang - "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*" - ;; (3) switches - "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)" - ;; (4) header arguments - "\\([^\n]*\\)\n" - ;; (5) body - "\\([^\000]*?\n\\)?[ \t]*#\\+end_src") - "Regexp used to identify code blocks.") - -(defvar org-babel-inline-src-block-regexp - (concat - ;; (1) replacement target (2) lang - "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)" - ;; (3,4) (unused, headers) - "\\(\\|\\[\\(.*?\\)\\]\\)" - ;; (5) body - "{\\([^\f\n\r\v]+?\\)}\\)") - "Regexp used to identify inline src-blocks.") - -(defun org-babel-get-header (params key &optional others) - "Select only header argument of type KEY from a list. -Optional argument OTHERS indicates that only the header that do -not match KEY should be returned." - (delq nil - (mapcar - (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p)) - params))) - -(defun org-babel-get-inline-src-block-matches() - "Set match data if within body of an inline source block. -Returns non-nil if match-data set" - (let ((src-at-0-p (save-excursion - (beginning-of-line 1) - (string= "src" (thing-at-point 'word)))) - (first-line-p (= 1 (line-number-at-pos))) - (orig (point))) - (let ((search-for (cond ((and src-at-0-p first-line-p "src_")) - (first-line-p "[[:punct:] \t]src_") - (t "[[:punct:] \f\t\n\r\v]src_"))) - (lower-limit (if first-line-p - nil - (- (point-at-bol) 1)))) - (save-excursion - (when (or (and src-at-0-p (bobp)) - (and (re-search-forward "}" (point-at-eol) t) - (re-search-backward search-for lower-limit t) - (> orig (point)))) - (when (looking-at org-babel-inline-src-block-regexp) - t )))))) - -(defvar org-babel-inline-lob-one-liner-regexp) -(defun org-babel-get-lob-one-liner-matches() - "Set match data if on line of an lob one liner. -Returns non-nil if match-data set" - (save-excursion - (unless (= (point) (point-at-bol)) ;; move before inline block - (re-search-backward "[ \f\t\n\r\v]" nil t)) - (if (looking-at org-babel-inline-lob-one-liner-regexp) - t - nil))) - -(defun org-babel-get-src-block-info (&optional light) - "Get information on the current source block. - -Optional argument LIGHT does not resolve remote variable -references; a process which could likely result in the execution -of other code blocks. - -Returns a list - (language body header-arguments-alist switches name indent)." - (let ((case-fold-search t) head info name indent) - ;; full code block - (if (setq head (org-babel-where-is-src-block-head)) - (save-excursion - (goto-char head) - (setq info (org-babel-parse-src-block-match)) - (setq indent (car (last info))) - (setq info (butlast info)) - (while (and (forward-line -1) - (looking-at org-babel-multi-line-header-regexp)) - (setf (nth 2 info) - (org-babel-merge-params - (nth 2 info) - (org-babel-parse-header-arguments (match-string 1))))) - (when (looking-at org-babel-src-name-w-name-regexp) - (setq name (org-no-properties (match-string 3))) - (when (and (match-string 5) (> (length (match-string 5)) 0)) - (setf (nth 2 info) ;; merge functional-syntax vars and header-args - (org-babel-merge-params - (mapcar - (lambda (ref) (cons :var ref)) - (mapcar - (lambda (var) ;; check that each variable is initialized - (if (string-match ".+=.+" var) - var - (error - "variable \"%s\"%s must be assigned a default value" - var (if name (format " in block \"%s\"" name) "")))) - (org-babel-ref-split-args (match-string 5)))) - (nth 2 info)))))) - ;; inline source block - (when (org-babel-get-inline-src-block-matches) - (setq info (org-babel-parse-inline-src-block-match)))) - ;; resolve variable references and add summary parameters - (when (and info (not light)) - (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) - (when info (append info (list name indent))))) - -(defvar org-current-export-file) ; dynamically bound -(defun org-babel-confirm-evaluate (info) - "Confirm evaluation of the code block INFO. -This behavior can be suppressed by setting the value of -`org-confirm-babel-evaluate' to nil, in which case all future -interactive code block evaluations will proceed without any -confirmation from the user. - -Note disabling confirmation may result in accidental evaluation -of potentially harmful code." - (let* ((eval (or (cdr (assoc :eval (nth 2 info))) - (when (assoc :noeval (nth 2 info)) "no"))) - (query (cond ((equal eval "query") t) - ((and (boundp 'org-current-export-file) - org-current-export-file - (equal eval "query-export")) t) - ((functionp org-confirm-babel-evaluate) - (funcall org-confirm-babel-evaluate - (nth 0 info) (nth 1 info))) - (t org-confirm-babel-evaluate)))) - (if (or (equal eval "never") (equal eval "no") - (and (boundp 'org-current-export-file) - org-current-export-file - (or (equal eval "no-export") - (equal eval "never-export"))) - (and query - (not (yes-or-no-p - (format "Evaluate this%scode block%son your system? " - (if info (format " %s " (nth 0 info)) " ") - (if (nth 4 info) - (format " (%s) " (nth 4 info)) " ")))))) - (prog1 nil (message "Evaluation %s" - (if (or (equal eval "never") (equal eval "no") - (equal eval "no-export") - (equal eval "never-export")) - "Disabled" "Aborted"))) - t))) - -;;;###autoload -(defun org-babel-execute-safely-maybe () - (unless org-babel-no-eval-on-ctrl-c-ctrl-c - (org-babel-execute-maybe))) - -(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe) - -;;;###autoload -(defun org-babel-execute-maybe () - (interactive) - (or (org-babel-execute-src-block-maybe) - (org-babel-lob-execute-maybe))) - -(defun org-babel-execute-src-block-maybe () - "Conditionally execute a source block. -Detect if this is context for a Babel src-block and if so -then run `org-babel-execute-src-block'." - (interactive) - (let ((info (org-babel-get-src-block-info))) - (if info - (progn (org-babel-eval-wipe-error-buffer) - (org-babel-execute-src-block current-prefix-arg info) t) nil))) - -;;;###autoload -(defun org-babel-view-src-block-info () - "Display information on the current source block. -This includes header arguments, language and name, and is largely -a window into the `org-babel-get-src-block-info' function." - (interactive) - (let ((info (org-babel-get-src-block-info 'light)) - (full (lambda (it) (> (length it) 0))) - (printf (lambda (fmt &rest args) (princ (apply #'format fmt args))))) - (when info - (with-help-window (help-buffer) - (let ((name (nth 4 info)) - (lang (nth 0 info)) - (switches (nth 3 info)) - (header-args (nth 2 info))) - (when name (funcall printf "Name: %s\n" name)) - (when lang (funcall printf "Lang: %s\n" lang)) - (when (funcall full switches) (funcall printf "Switches: %s\n" switches)) - (funcall printf "Header Arguments:\n") - (dolist (pair (sort header-args - (lambda (a b) (string< (symbol-name (car a)) - (symbol-name (car b)))))) - (when (funcall full (cdr pair)) - (funcall printf "\t%S%s\t%s\n" - (car pair) - (if (> (length (format "%S" (car pair))) 7) "" "\t") - (cdr pair))))))))) - -;;;###autoload -(defun org-babel-expand-src-block-maybe () - "Conditionally expand a source block. -Detect if this is context for a org-babel src-block and if so -then run `org-babel-expand-src-block'." - (interactive) - (let ((info (org-babel-get-src-block-info))) - (if info - (progn (org-babel-expand-src-block current-prefix-arg info) t) - nil))) - -;;;###autoload -(defun org-babel-load-in-session-maybe () - "Conditionally load a source block in a session. -Detect if this is context for a org-babel src-block and if so -then run `org-babel-load-in-session'." - (interactive) - (let ((info (org-babel-get-src-block-info))) - (if info - (progn (org-babel-load-in-session current-prefix-arg info) t) - nil))) - -(add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe) - -;;;###autoload -(defun org-babel-pop-to-session-maybe () - "Conditionally pop to a session. -Detect if this is context for a org-babel src-block and if so -then run `org-babel-pop-to-session'." - (interactive) - (let ((info (org-babel-get-src-block-info))) - (if info (progn (org-babel-pop-to-session current-prefix-arg info) t) nil))) - -(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe) - -(defconst org-babel-common-header-args-w-values - '((cache . ((no yes))) - (cmdline . :any) - (colnames . ((nil no yes))) - (comments . ((no link yes org both noweb))) - (dir . :any) - (eval . ((never query))) - (exports . ((code results both none))) - (file . :any) - (file-desc . :any) - (hlines . ((no yes))) - (mkdirp . ((yes no))) - (no-expand) - (noeval) - (noweb . ((yes no tangle no-export strip-export))) - (noweb-ref . :any) - (noweb-sep . :any) - (padline . ((yes no))) - (results . ((file list vector table scalar verbatim) - (raw html latex org code pp drawer) - (replace silent append prepend) - (output value))) - (rownames . ((no yes))) - (sep . :any) - (session . :any) - (shebang . :any) - (tangle . ((tangle yes no :any))) - (var . :any) - (wrap . :any))) - -(defconst org-babel-header-arg-names - (mapcar #'car org-babel-common-header-args-w-values) - "Common header arguments used by org-babel. -Note that individual languages may define their own language -specific header arguments as well.") - -(defvar org-babel-default-header-args - '((:session . "none") (:results . "replace") (:exports . "code") - (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no") - (:padnewline . "yes")) - "Default arguments to use when evaluating a source block.") - -(defvar org-babel-default-inline-header-args - '((:session . "none") (:results . "replace") (:exports . "results")) - "Default arguments to use when evaluating an inline source block.") - -(defvar org-babel-data-names '("tblname" "results" "name")) - -(defvar org-babel-result-regexp - (concat "^[ \t]*#\\+" - (regexp-opt org-babel-data-names t) - "\\(\\[\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*") - "Regular expression used to match result lines. -If the results are associated with a hash key then the hash will -be saved in the second match data.") - -(defvar org-babel-result-w-name-regexp - (concat org-babel-result-regexp - "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")) - -(defvar org-babel-min-lines-for-block-output 10 - "The minimum number of lines for block output. -If number of lines of output is equal to or exceeds this -value, the output is placed in a #+begin_example...#+end_example -block. Otherwise the output is marked as literal by inserting -colons at the starts of the lines. This variable only takes -effect if the :results output option is in effect.") - -(defvar org-babel-noweb-error-langs nil - "Languages for which Babel will raise literate programming errors. -List of languages for which errors should be raised when the -source code block satisfying a noweb reference in this language -can not be resolved.") - -(defvar org-babel-hash-show 4 - "Number of initial characters to show of a hidden results hash.") - -(defvar org-babel-after-execute-hook nil - "Hook for functions to be called after `org-babel-execute-src-block'") - -(defun org-babel-named-src-block-regexp-for-name (name) - "This generates a regexp used to match a src block named NAME." - (concat org-babel-src-name-regexp (regexp-quote name) - "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*" - (substring org-babel-src-block-regexp 1))) - -(defun org-babel-named-data-regexp-for-name (name) - "This generates a regexp used to match data named NAME." - (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)")) - -;;; functions -(defvar call-process-region) - -;;;###autoload -(defun org-babel-execute-src-block (&optional arg info params) - "Execute the current source code block. -Insert the results of execution into the buffer. Source code -execution and the collection and formatting of results can be -controlled through a variety of header arguments. - -With prefix argument ARG, force re-execution even if an existing -result cached in the buffer would otherwise have been returned. - -Optionally supply a value for INFO in the form returned by -`org-babel-get-src-block-info'. - -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 (or info (org-babel-get-src-block-info)))) - (when (org-babel-confirm-evaluate - (let ((i info)) - (setf (nth 2 i) (org-babel-merge-params (nth 2 info) params)) - i)) - (let* ((lang (nth 0 info)) - (params (if params - (org-babel-process-params - (org-babel-merge-params (nth 2 info) params)) - (nth 2 info))) - (cache? (and (not arg) (cdr (assoc :cache params)) - (string= "yes" (cdr (assoc :cache params))))) - (result-params (cdr (assoc :result-params params))) - (new-hash (when cache? (org-babel-sha1-hash info))) - (old-hash (when cache? (org-babel-current-result-hash))) - (body (setf (nth 1 info) - (if (org-babel-noweb-p params :eval) - (org-babel-expand-noweb-references info) - (nth 1 info)))) - (dir (cdr (assoc :dir params))) - (default-directory - (or (and dir (file-name-as-directory (expand-file-name dir))) - default-directory)) - (org-babel-call-process-region-original - (if (boundp 'org-babel-call-process-region-original) - org-babel-call-process-region-original - (symbol-function 'call-process-region))) - (indent (car (last info))) - result cmd) - (unwind-protect - (let ((call-process-region - (lambda (&rest args) - (apply 'org-babel-tramp-handle-call-process-region args)))) - (let ((lang-check (lambda (f) - (let ((f (intern (concat "org-babel-execute:" f)))) - (when (fboundp f) f))))) - (setq cmd - (or (funcall lang-check lang) - (funcall lang-check (symbol-name - (cdr (assoc lang org-src-lang-modes)))) - (error "No org-babel-execute function for %s!" lang)))) - (if (and (not arg) new-hash (equal new-hash old-hash)) - (save-excursion ;; return cached result - (goto-char (org-babel-where-is-src-block-result nil info)) - (end-of-line 1) (forward-char 1) - (setq result (org-babel-read-result)) - (message (replace-regexp-in-string - "%" "%%" (format "%S" result))) result) - (message "executing %s code block%s..." - (capitalize lang) - (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) - (setq result - ((lambda (result) - (if (and (eq (cdr (assoc :result-type params)) 'value) - (or (member "vector" result-params) - (member "table" result-params)) - (not (listp result))) - (list (list result)) result)) - (funcall cmd body params))) - ;; if non-empty result and :file then write to :file - (when (cdr (assoc :file params)) - (when result - (with-temp-file (cdr (assoc :file params)) - (insert - (org-babel-format-result - result (cdr (assoc :sep (nth 2 info))))))) - (setq result (cdr (assoc :file params)))) - (org-babel-insert-result - result result-params info new-hash indent lang) - (run-hooks 'org-babel-after-execute-hook) - result)) - (setq call-process-region 'org-babel-call-process-region-original)))))) - -(defun org-babel-expand-body:generic (body params &optional var-lines) - "Expand BODY with PARAMS. -Expand a block of code with org-babel according to its header -arguments. This generic implementation of body expansion is -called for languages which have not defined their own specific -org-babel-expand-body:lang function." - (mapconcat #'identity (append var-lines (list body)) "\n")) - -;;;###autoload -(defun org-babel-expand-src-block (&optional arg info params) - "Expand the current source code block. -Expand according to the source code block's header -arguments and pop open the results in a preview buffer." - (interactive) - (let* ((info (or info (org-babel-get-src-block-info))) - (lang (nth 0 info)) - (params (setf (nth 2 info) - (sort (org-babel-merge-params (nth 2 info) params) - (lambda (el1 el2) (string< (symbol-name (car el1)) - (symbol-name (car el2))))))) - (body (setf (nth 1 info) - (if (org-babel-noweb-p params :eval) - (org-babel-expand-noweb-references info) (nth 1 info)))) - (expand-cmd (intern (concat "org-babel-expand-body:" lang))) - (assignments-cmd (intern (concat "org-babel-variable-assignments:" - lang))) - (expanded - (if (fboundp expand-cmd) (funcall expand-cmd body params) - (org-babel-expand-body:generic - body params (and (fboundp assignments-cmd) - (funcall assignments-cmd params)))))) - (org-edit-src-code - nil expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")))) - -(defun org-babel-edit-distance (s1 s2) - "Return the edit (levenshtein) distance between strings S1 S2." - (let* ((l1 (length s1)) - (l2 (length s2)) - (dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil)) - (number-sequence 1 (1+ l1))))) - (in (lambda (i j) (aref (aref dist i) j))) - (mmin (lambda (&rest lst) (apply #'min (remove nil lst))))) - (setf (aref (aref dist 0) 0) 0) - (dolist (i (number-sequence 1 l1)) - (dolist (j (number-sequence 1 l2)) - (setf (aref (aref dist i) j) - (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1) - (funcall mmin (funcall in (1- i) j) - (funcall in i (1- j)) - (funcall in (1- i) (1- j))))))) - (funcall in l1 l2))) - -(defun org-babel-combine-header-arg-lists (original &rest others) - "Combine a number of lists of header argument names and arguments." - (let ((results (copy-sequence original))) - (dolist (new-list others) - (dolist (arg-pair new-list) - (let ((header (car arg-pair)) - (args (cdr arg-pair))) - (setq results - (cons arg-pair (org-remove-if - (lambda (pair) (equal header (car pair))) - results)))))) - results)) - -;;;###autoload -(defun org-babel-check-src-block () - "Check for misspelled header arguments in the current code block." - (interactive) - ;; TODO: report malformed code block - ;; TODO: report incompatible combinations of header arguments - ;; TODO: report uninitialized variables - (let ((too-close 2) ;; <- control closeness to report potential match - (names (mapcar #'symbol-name org-babel-header-arg-names))) - (dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1)) - (and (org-babel-where-is-src-block-head) - (org-babel-parse-header-arguments - (org-no-properties - (match-string 4)))))) - (dolist (name names) - (when (and (not (string= header name)) - (<= (org-babel-edit-distance header name) too-close) - (not (member header names))) - (error "Supplied header \"%S\" is suspiciously close to \"%S\"" - header name)))) - (message "No suspicious header arguments found."))) - -;;;###autoload -(defun org-babel-insert-header-arg () - "Insert a header argument selecting from lists of common args and values." - (interactive) - (let* ((lang (car (org-babel-get-src-block-info 'light))) - (lang-headers (intern (concat "org-babel-header-args:" lang))) - (headers (org-babel-combine-header-arg-lists - org-babel-common-header-args-w-values - (if (boundp lang-headers) (eval lang-headers) nil))) - (arg (org-icompleting-read - "Header Arg: " - (mapcar - (lambda (header-spec) (symbol-name (car header-spec))) - headers)))) - (insert ":" arg) - (let ((vals (cdr (assoc (intern arg) headers)))) - (when vals - (insert - " " - (cond - ((eq vals :any) - (read-from-minibuffer "value: ")) - ((listp vals) - (mapconcat - (lambda (group) - (let ((arg (org-icompleting-read - "value: " - (cons "default" (mapcar #'symbol-name group))))) - (if (and arg (not (string= "default" arg))) - (concat arg " ") - ""))) - vals "")))))))) - -;; Add support for completing-read insertion of header arguments after ":" -(defun org-babel-header-arg-expand () - "Call `org-babel-enter-header-arg-w-completion' in appropriate contexts." - (when (and (equal (char-before) ?\:) (org-babel-where-is-src-block-head)) - (org-babel-enter-header-arg-w-completion (match-string 2)))) - -(defun org-babel-enter-header-arg-w-completion (&optional lang) - "Insert header argument appropriate for LANG with completion." - (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang))) - (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var))) - (headers-w-values (org-babel-combine-header-arg-lists - org-babel-common-header-args-w-values lang-headers)) - (headers (mapcar #'symbol-name (mapcar #'car headers-w-values))) - (header (org-completing-read "Header Arg: " headers)) - (args (cdr (assoc (intern header) headers-w-values))) - (arg (when (and args (listp args)) - (org-completing-read - (format "%s: " header) - (mapcar #'symbol-name (apply #'append args)))))) - (insert (concat header " " (or arg ""))) - (cons header arg))) - -(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand) - -;;;###autoload -(defun org-babel-load-in-session (&optional arg info) - "Load the body of the current source-code block. -Evaluate the header arguments for the source block before -entering the session. After loading the body this pops open the -session." - (interactive) - (let* ((info (or info (org-babel-get-src-block-info))) - (lang (nth 0 info)) - (params (nth 2 info)) - (body (setf (nth 1 info) - (if (org-babel-noweb-p params :eval) - (org-babel-expand-noweb-references info) - (nth 1 info)))) - (session (cdr (assoc :session params))) - (dir (cdr (assoc :dir params))) - (default-directory - (or (and dir (file-name-as-directory dir)) default-directory)) - (cmd (intern (concat "org-babel-load-session:" lang)))) - (unless (fboundp cmd) - (error "No org-babel-load-session function for %s!" lang)) - (pop-to-buffer (funcall cmd session body params)) - (end-of-line 1))) - -;;;###autoload -(defun org-babel-initiate-session (&optional arg info) - "Initiate session for current code block. -If called with a prefix argument then resolve any variable -references in the header arguments and assign these variables in -the session. Copy the body of the code block to the kill ring." - (interactive "P") - (let* ((info (or info (org-babel-get-src-block-info (not arg)))) - (lang (nth 0 info)) - (body (nth 1 info)) - (params (nth 2 info)) - (session (cdr (assoc :session params))) - (dir (cdr (assoc :dir params))) - (default-directory - (or (and dir (file-name-as-directory dir)) default-directory)) - (init-cmd (intern (format "org-babel-%s-initiate-session" lang))) - (prep-cmd (intern (concat "org-babel-prep-session:" lang)))) - (if (and (stringp session) (string= session "none")) - (error "This block is not using a session!")) - (unless (fboundp init-cmd) - (error "No org-babel-initiate-session function for %s!" lang)) - (with-temp-buffer (insert (org-babel-trim body)) - (copy-region-as-kill (point-min) (point-max))) - (when arg - (unless (fboundp prep-cmd) - (error "No org-babel-prep-session function for %s!" lang)) - (funcall prep-cmd session params)) - (funcall init-cmd session params))) - -;;;###autoload -(defun org-babel-switch-to-session (&optional arg info) - "Switch to the session of the current code block. -Uses `org-babel-initiate-session' to start the session. If called -with a prefix argument then this is passed on to -`org-babel-initiate-session'." - (interactive "P") - (pop-to-buffer (org-babel-initiate-session arg info)) - (end-of-line 1)) - -(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) - -;;;###autoload -(defun org-babel-switch-to-session-with-code (&optional arg info) - "Switch to code buffer and display session." - (interactive "P") - (let ((swap-windows - (lambda () - (let ((other-window-buffer (window-buffer (next-window)))) - (set-window-buffer (next-window) (current-buffer)) - (set-window-buffer (selected-window) other-window-buffer)) - (other-window 1))) - (info (org-babel-get-src-block-info)) - (org-src-window-setup 'reorganize-frame)) - (save-excursion - (org-babel-switch-to-session arg info)) - (org-edit-src-code) - (funcall swap-windows))) - -(defmacro org-babel-do-in-edit-buffer (&rest body) - "Evaluate BODY in edit buffer if there is a code block at point. -Return t if a code block was found at point, nil otherwise." - `(let ((org-src-window-setup 'switch-invisibly)) - (when (and (org-babel-where-is-src-block-head) - (org-edit-src-code nil nil nil)) - (unwind-protect (progn ,@body) - (if (org-bound-and-true-p org-edit-src-from-org-mode) - (org-edit-src-exit))) - t))) -(def-edebug-spec org-babel-do-in-edit-buffer (body)) - -(defun org-babel-do-key-sequence-in-edit-buffer (key) - "Read key sequence and execute the command in edit buffer. -Enter a key sequence to be executed in the language major-mode -edit buffer. For example, TAB will alter the contents of the -Org-mode code block according to the effect of TAB in the -language major-mode buffer. For languages that support -interactive sessions, this can be used to send code from the Org -buffer to the session for evaluation using the native major-mode -evaluation mechanisms." - (interactive "kEnter key-sequence to execute in edit buffer: ") - (org-babel-do-in-edit-buffer - (call-interactively - (key-binding (or key (read-key-sequence nil)))))) - -(defvar org-bracket-link-regexp) - -;;;###autoload -(defun org-babel-open-src-block-result (&optional re-run) - "If `point' is on a src block then open the results of the -source code block, otherwise return nil. With optional prefix -argument RE-RUN the source-code block is evaluated even if -results already exist." - (interactive "P") - (let ((info (org-babel-get-src-block-info))) - (when info - (save-excursion - ;; go to the results, if there aren't any then run the block - (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result)) - (progn (org-babel-execute-src-block) - (org-babel-where-is-src-block-result)))) - (end-of-line 1) - (while (looking-at "[\n\r\t\f ]") (forward-char 1)) - ;; open the results - (if (looking-at org-bracket-link-regexp) - ;; file results - (org-open-at-point) - (let ((r (org-babel-format-result - (org-babel-read-result) (cdr (assoc :sep (nth 2 info)))))) - (pop-to-buffer (get-buffer-create "*Org-Babel Results*")) - (delete-region (point-min) (point-max)) - (insert r))) - t)))) - -;;;###autoload -(defmacro org-babel-map-src-blocks (file &rest body) - "Evaluate BODY forms on each source-block in FILE. -If FILE is nil evaluate BODY forms on source blocks in current -buffer. During evaluation of BODY the following local variables -are set relative to the currently matched code block. - -full-block ------- string holding the entirety of the code block -beg-block -------- point at the beginning of the code block -end-block -------- point at the end of the matched code block -lang ------------- string holding the language of the code block -beg-lang --------- point at the beginning of the lang -end-lang --------- point at the end of the lang -switches --------- string holding the switches -beg-switches ----- point at the beginning of the switches -end-switches ----- point at the end of the switches -header-args ------ string holding the header-args -beg-header-args -- point at the beginning of the header-args -end-header-args -- point at the end of the header-args -body ------------- string holding the body of the code block -beg-body --------- point at the beginning of the body -end-body --------- point at the end of the body" - (declare (indent 1)) - (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) - (visited-p (or (null ,tempvar) - (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) - (save-window-excursion - (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) - (goto-char (point-min)) - (while (re-search-forward org-babel-src-block-regexp nil t) - (goto-char (match-beginning 0)) - (let ((full-block (match-string 0)) - (beg-block (match-beginning 0)) - (end-block (match-end 0)) - (lang (match-string 2)) - (beg-lang (match-beginning 2)) - (end-lang (match-end 2)) - (switches (match-string 3)) - (beg-switches (match-beginning 3)) - (end-switches (match-end 3)) - (header-args (match-string 4)) - (beg-header-args (match-beginning 4)) - (end-header-args (match-end 4)) - (body (match-string 5)) - (beg-body (match-beginning 5)) - (end-body (match-end 5))) - ,@body - (goto-char end-block)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-src-blocks (form body)) - -;;;###autoload -(defmacro org-babel-map-inline-src-blocks (file &rest body) - "Evaluate BODY forms on each inline source-block in FILE. -If FILE is nil evaluate BODY forms on source blocks in current -buffer." - (declare (indent 1)) - (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) - (visited-p (or (null ,tempvar) - (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) - (save-window-excursion - (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) - (goto-char (point-min)) - (while (re-search-forward org-babel-inline-src-block-regexp nil t) - (goto-char (match-beginning 1)) - (save-match-data ,@body) - (goto-char (match-end 0)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-inline-src-blocks (form body)) - -(defvar org-babel-lob-one-liner-regexp) - -;;;###autoload -(defmacro org-babel-map-call-lines (file &rest body) - "Evaluate BODY forms on each call line in FILE. -If FILE is nil evaluate BODY forms on source blocks in current -buffer." - (declare (indent 1)) - (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) - (visited-p (or (null ,tempvar) - (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) - (save-window-excursion - (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) - (goto-char (point-min)) - (while (re-search-forward org-babel-lob-one-liner-regexp nil t) - (goto-char (match-beginning 1)) - (save-match-data ,@body) - (goto-char (match-end 0)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-call-lines (form body)) - -;;;###autoload -(defmacro org-babel-map-executables (file &rest body) - (declare (indent 1)) - (let ((tempvar (make-symbol "file")) - (rx (make-symbol "rx"))) - `(let* ((,tempvar ,file) - (,rx (concat "\\(" org-babel-src-block-regexp - "\\|" org-babel-inline-src-block-regexp - "\\|" org-babel-lob-one-liner-regexp "\\)")) - (visited-p (or (null ,tempvar) - (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) - (save-window-excursion - (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) - (goto-char (point-min)) - (while (re-search-forward ,rx nil t) - (goto-char (match-beginning 1)) - (when (looking-at org-babel-inline-src-block-regexp)(forward-char 1)) - (save-match-data ,@body) - (goto-char (match-end 0)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-executables (form body)) - -;;;###autoload -(defun org-babel-execute-buffer (&optional arg) - "Execute source code blocks in a buffer. -Call `org-babel-execute-src-block' on every source block in -the current buffer." - (interactive "P") - (org-babel-eval-wipe-error-buffer) - (org-save-outline-visibility t - (org-babel-map-executables nil - (if (looking-at org-babel-lob-one-liner-regexp) - (org-babel-lob-execute-maybe) - (org-babel-execute-src-block arg))))) - -;;;###autoload -(defun org-babel-execute-subtree (&optional arg) - "Execute source code blocks in a subtree. -Call `org-babel-execute-src-block' on every source block in -the current subtree." - (interactive "P") - (save-restriction - (save-excursion - (org-narrow-to-subtree) - (org-babel-execute-buffer arg) - (widen)))) - -;;;###autoload -(defun org-babel-sha1-hash (&optional info) - "Generate an sha1 hash based on the value of info." - (interactive) - (let ((print-level nil) - (info (or info (org-babel-get-src-block-info)))) - (setf (nth 2 info) - (sort (copy-sequence (nth 2 info)) - (lambda (a b) (string< (car a) (car b))))) - (let* ((rm (lambda (lst) - (dolist (p '("replace" "silent" "append" "prepend")) - (setq lst (remove p lst))) - lst)) - (norm (lambda (arg) - (let ((v (if (and (listp (cdr arg)) (null (cddr arg))) - (copy-sequence (cdr arg)) - (cdr arg)))) - (when (and v (not (and (sequencep v) - (not (consp v)) - (= (length v) 0)))) - (cond - ((and (listp v) ; lists are sorted - (member (car arg) '(:result-params))) - (sort (funcall rm v) #'string<)) - ((and (stringp v) ; strings are sorted - (member (car arg) '(:results :exports))) - (mapconcat #'identity (sort (funcall rm (split-string v)) - #'string<) " ")) - (t v))))))) - ((lambda (hash) - (when (org-called-interactively-p 'interactive) (message hash)) hash) - (let ((it (format "%s-%s" - (mapconcat - #'identity - (delq nil (mapcar (lambda (arg) - (let ((normalized (funcall norm arg))) - (when normalized - (format "%S" normalized)))) - (nth 2 info))) ":") - (nth 1 info)))) - (sha1 it)))))) - -(defun org-babel-current-result-hash () - "Return the current in-buffer hash." - (org-babel-where-is-src-block-result) - (org-no-properties (match-string 3))) - -(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) - (org-babel-hide-hash))) - -(defun org-babel-hide-hash () - "Hide the hash in the current results line. -Only the initial `org-babel-hash-show' characters of the hash -will remain visible." - (add-to-invisibility-spec '(org-babel-hide-hash . t)) - (save-excursion - (when (and (re-search-forward org-babel-result-regexp nil t) - (match-string 3)) - (let* ((start (match-beginning 3)) - (hide-start (+ org-babel-hash-show start)) - (end (match-end 3)) - (hash (match-string 3)) - ov1 ov2) - (setq ov1 (make-overlay start hide-start)) - (setq ov2 (make-overlay hide-start end)) - (overlay-put ov2 'invisible 'org-babel-hide-hash) - (overlay-put ov1 'babel-hash hash))))) - -(defun org-babel-hide-all-hashes () - "Hide the hash in the current buffer. -Only the initial `org-babel-hash-show' characters of each hash -will remain visible. This function should be called as part of -the `org-mode-hook'." - (save-excursion - (while (re-search-forward org-babel-result-regexp nil t) - (goto-char (match-beginning 0)) - (org-babel-hide-hash) - (goto-char (match-end 0))))) -(add-hook 'org-mode-hook 'org-babel-hide-all-hashes) - -(defun org-babel-hash-at-point (&optional point) - "Return the value of the hash at POINT. -The hash is also added as the last element of the kill ring. -This can be called with C-c C-c." - (interactive) - (let ((hash (car (delq nil (mapcar - (lambda (ol) (overlay-get ol 'babel-hash)) - (overlays-at (or point (point)))))))) - (when hash (kill-new hash) (message hash)))) -(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point) - -(defun org-babel-result-hide-spec () - "Hide portions of results lines. -Add `org-babel-hide-result' as an invisibility spec for hiding -portions of results lines." - (add-to-invisibility-spec '(org-babel-hide-result . t))) -(add-hook 'org-mode-hook 'org-babel-result-hide-spec) - -(defvar org-babel-hide-result-overlays nil - "Overlays hiding results.") - -(defun org-babel-result-hide-all () - "Fold all results in the current buffer." - (interactive) - (org-babel-show-result-all) - (save-excursion - (while (re-search-forward org-babel-result-regexp nil t) - (save-excursion (goto-char (match-beginning 0)) - (org-babel-hide-result-toggle-maybe))))) - -(defun org-babel-show-result-all () - "Unfold all results in the current buffer." - (mapc 'delete-overlay org-babel-hide-result-overlays) - (setq org-babel-hide-result-overlays nil)) - -;;;###autoload -(defun org-babel-hide-result-toggle-maybe () - "Toggle visibility of result at point." - (interactive) - (let ((case-fold-search t)) - (if (save-excursion - (beginning-of-line 1) - (looking-at org-babel-result-regexp)) - (progn (org-babel-hide-result-toggle) - t) ;; to signal that we took action - nil))) ;; to signal that we did not - -(defun org-babel-hide-result-toggle (&optional force) - "Toggle the visibility of the current result." - (interactive) - (save-excursion - (beginning-of-line) - (if (re-search-forward org-babel-result-regexp nil t) - (let ((start (progn (beginning-of-line 2) (- (point) 1))) - (end (progn - (while (looking-at org-babel-multi-line-header-regexp) - (forward-line 1)) - (goto-char (- (org-babel-result-end) 1)) (point))) - ov) - (if (memq t (mapcar (lambda (overlay) - (eq (overlay-get overlay 'invisible) - 'org-babel-hide-result)) - (overlays-at start))) - (if (or (not force) (eq force 'off)) - (mapc (lambda (ov) - (when (member ov org-babel-hide-result-overlays) - (setq org-babel-hide-result-overlays - (delq ov org-babel-hide-result-overlays))) - (when (eq (overlay-get ov 'invisible) - 'org-babel-hide-result) - (delete-overlay ov))) - (overlays-at start))) - (setq ov (make-overlay start end)) - (overlay-put ov 'invisible 'org-babel-hide-result) - ;; make the block accessible to isearch - (overlay-put - ov 'isearch-open-invisible - (lambda (ov) - (when (member ov org-babel-hide-result-overlays) - (setq org-babel-hide-result-overlays - (delq ov org-babel-hide-result-overlays))) - (when (eq (overlay-get ov 'invisible) - 'org-babel-hide-result) - (delete-overlay ov)))) - (push ov org-babel-hide-result-overlays))) - (error "Not looking at a result line")))) - -;; org-tab-after-check-for-cycling-hook -(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe) -;; Remove overlays when changing major mode -(add-hook 'org-mode-hook - (lambda () (org-add-hook 'change-major-mode-hook - 'org-babel-show-result-all 'append 'local))) - -(defvar org-file-properties) -(defun org-babel-params-from-properties (&optional lang) - "Retrieve parameters specified as properties. -Return an association list of any source block params which -may be specified in the properties of the current outline entry." - (save-match-data - (let (val sym) - (org-babel-parse-multiple-vars - (delq nil - (mapcar - (lambda (header-arg) - (and (setq val (org-entry-get (point) header-arg t)) - (cons (intern (concat ":" header-arg)) - (org-babel-read val)))) - (mapcar - #'symbol-name - (mapcar - #'car - (org-babel-combine-header-arg-lists - org-babel-common-header-args-w-values - (progn - (setq sym (intern (concat "org-babel-header-args:" lang))) - (and (boundp sym) (eval sym)))))))))))) - -(defvar org-src-preserve-indentation) -(defun org-babel-parse-src-block-match () - "Parse the results from a match of the `org-babel-src-block-regexp'." - (let* ((block-indentation (length (match-string 1))) - (lang (org-no-properties (match-string 2))) - (lang-headers (intern (concat "org-babel-default-header-args:" lang))) - (switches (match-string 3)) - (body (org-no-properties - (let* ((body (match-string 5)) - (sub-length (- (length body) 1))) - (if (and (> sub-length 0) - (string= "\n" (substring body sub-length))) - (substring body 0 sub-length) - (or body ""))))) - (preserve-indentation (or org-src-preserve-indentation - (save-match-data - (string-match "-i\\>" switches))))) - (list lang - ;; get block body less properties, protective commas, and indentation - (with-temp-buffer - (save-match-data - (insert (org-unescape-code-in-string body)) - (unless preserve-indentation (org-do-remove-indentation)) - (buffer-string))) - (org-babel-merge-params - org-babel-default-header-args - (org-babel-params-from-properties lang) - (if (boundp lang-headers) (eval lang-headers) nil) - (org-babel-parse-header-arguments - (org-no-properties (or (match-string 4) "")))) - switches - block-indentation))) - -(defun org-babel-parse-inline-src-block-match () - "Parse the results from a match of the `org-babel-inline-src-block-regexp'." - (let* ((lang (org-no-properties (match-string 2))) - (lang-headers (intern (concat "org-babel-default-header-args:" lang)))) - (list lang - (org-unescape-code-in-string (org-no-properties (match-string 5))) - (org-babel-merge-params - org-babel-default-inline-header-args - (org-babel-params-from-properties lang) - (if (boundp lang-headers) (eval lang-headers) nil) - (org-babel-parse-header-arguments - (org-no-properties (or (match-string 4) ""))))))) - -(defun org-babel-balanced-split (string alts) - "Split STRING on instances of ALTS. -ALTS is a cons of two character options where each option may be -either the numeric code of a single character or a list of -character alternatives. For example to split on balanced -instances of \"[ \t]:\" set ALTS to '((32 9) . 58)." - (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))) - (matched (lambda (ch last) - (if (consp alts) - (and (funcall matches ch (cdr alts)) - (funcall matches last (car alts))) - (funcall matches ch alts)))) - (balance 0) (last 0) - quote partial lst) - (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]: - (setq balance (+ balance - (cond ((or (equal 91 ch) (equal 40 ch)) 1) - ((or (equal 93 ch) (equal 41 ch)) -1) - (t 0)))) - (when (and (equal 34 ch) (not (equal 92 last))) - (setq quote (not quote))) - (setq partial (cons ch partial)) - (when (and (= balance 0) (not quote) (funcall matched ch last)) - (setq lst (cons (apply #'string (nreverse - (if (consp alts) - (cddr partial) - (cdr partial)))) - lst)) - (setq partial nil)) - (setq last ch)) - (string-to-list string)) - (nreverse (cons (apply #'string (nreverse partial)) lst)))) - -(defun org-babel-join-splits-near-ch (ch list) - "Join splits where \"=\" is on either end of the split." - (let ((last= (lambda (str) (= ch (aref str (1- (length str)))))) - (first= (lambda (str) (= ch (aref str 0))))) - (reverse - (org-reduce (lambda (acc el) - (let ((head (car acc))) - (if (and head (or (funcall last= head) (funcall first= el))) - (cons (concat head el) (cdr acc)) - (cons el acc)))) - list :initial-value nil)))) - -(defun org-babel-parse-header-arguments (arg-string) - "Parse a string of header arguments returning an alist." - (when (> (length arg-string) 0) - (org-babel-parse-multiple-vars - (delq nil - (mapcar - (lambda (arg) - (if (string-match - "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" - arg) - (cons (intern (match-string 1 arg)) - (org-babel-read (org-babel-chomp (match-string 2 arg)))) - (cons (intern (org-babel-chomp arg)) nil))) - ((lambda (raw) - (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw)))) - (org-babel-balanced-split arg-string '((32 9) . 58)))))))) - -(defun org-babel-parse-multiple-vars (header-arguments) - "Expand multiple variable assignments behind a single :var keyword. - -This allows expression of multiple variables with one :var as -shown below. - -#+PROPERTY: var foo=1, bar=2" - (let (results) - (mapc (lambda (pair) - (if (eq (car pair) :var) - (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results)) - (org-babel-join-splits-near-ch - 61 (org-babel-balanced-split (cdr pair) 32))) - (push pair results))) - header-arguments) - (nreverse results))) - -(defun org-babel-process-params (params) - "Expand variables in PARAMS and add summary parameters." - (let* ((processed-vars (mapcar (lambda (el) - (if (consp (cdr el)) - (cdr el) - (org-babel-ref-parse (cdr el)))) - (org-babel-get-header params :var))) - (vars-and-names (if (and (assoc :colname-names params) - (assoc :rowname-names params)) - (list processed-vars) - (org-babel-disassemble-tables - processed-vars - (cdr (assoc :hlines params)) - (cdr (assoc :colnames params)) - (cdr (assoc :rownames params))))) - (raw-result (or (cdr (assoc :results params)) "")) - (result-params (append - (split-string (if (stringp raw-result) - raw-result - (eval raw-result))) - (cdr (assoc :result-params params))))) - (append - (mapcar (lambda (var) (cons :var var)) (car vars-and-names)) - (list - (cons :colname-names (or (cdr (assoc :colname-names params)) - (cadr vars-and-names))) - (cons :rowname-names (or (cdr (assoc :rowname-names params)) - (caddr vars-and-names))) - (cons :result-params result-params) - (cons :result-type (cond ((member "output" result-params) 'output) - ((member "value" result-params) 'value) - (t 'value)))) - (org-babel-get-header params :var 'other)))) - -;; row and column names -(defun org-babel-del-hlines (table) - "Remove all 'hlines from TABLE." - (remove 'hline table)) - -(defun org-babel-get-colnames (table) - "Return the column 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." - (if (equal 'hline (nth 1 table)) - (cons (cddr table) (car table)) - (cons (cdr table) (car table)))) - -(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))))) - -(defun org-babel-put-colnames (table colnames) - "Add COLNAMES to TABLE if they exist." - (if colnames (apply 'list colnames 'hline table) table)) - -(defun org-babel-put-rownames (table rownames) - "Add ROWNAMES to TABLE if they exist." - (if rownames - (mapcar (lambda (row) - (if (listp row) - (cons (or (pop rownames) "") row) - row)) table) - table)) - -(defun org-babel-pick-name (names selector) - "Select one out of an alist of row or column names. -SELECTOR can be either a list of names in which case those names -will be returned directly, or an index into the list NAMES in -which case the indexed names will be return." - (if (listp selector) - selector - (when names - (if (and selector (symbolp selector) (not (equal t selector))) - (cdr (assoc selector names)) - (if (integerp selector) - (nth (- selector 1) names) - (cdr (car (last names)))))))) - -(defun org-babel-disassemble-tables (vars hlines colnames rownames) - "Parse tables for further processing. -Process the variables in VARS according to the HLINES, -ROWNAMES and COLNAMES header arguments. Return a list consisting -of the vars, cnames and rnames." - (let (cnames rnames) - (list - (mapcar - (lambda (var) - (when (listp (cdr var)) - (when (and (not (equal colnames "no")) - (or colnames (and (equal (nth 1 (cdr var)) 'hline) - (not (member 'hline (cddr (cdr var))))))) - (let ((both (org-babel-get-colnames (cdr var)))) - (setq cnames (cons (cons (car var) (cdr both)) - cnames)) - (setq var (cons (car var) (car both))))) - (when (and rownames (not (equal rownames "no"))) - (let ((both (org-babel-get-rownames (cdr var)))) - (setq rnames (cons (cons (car var) (cdr both)) - rnames)) - (setq var (cons (car var) (car both))))) - (when (and hlines (not (equal hlines "yes"))) - (setq var (cons (car var) (org-babel-del-hlines (cdr var)))))) - var) - vars) - (reverse cnames) (reverse rnames)))) - -(defun org-babel-reassemble-table (table colnames rownames) - "Add column and row names to a table. -Given a TABLE and set of COLNAMES and ROWNAMES add the names -to the table for reinsertion to org-mode." - (if (listp table) - ((lambda (table) - (if (and colnames (listp (car table)) (= (length (car table)) - (length colnames))) - (org-babel-put-colnames table colnames) table)) - (if (and rownames (= (length table) (length rownames))) - (org-babel-put-rownames table rownames) table)) - table)) - -(defun org-babel-where-is-src-block-head () - "Find where the current source block begins. -Return the point at the beginning of the current source -block. Specifically at the beginning of the #+BEGIN_SRC line. -If the point is not on a source block then return nil." - (let ((initial (point)) (case-fold-search t) top bottom) - (or - (save-excursion ;; on a source name line or a #+header line - (beginning-of-line 1) - (and (or (looking-at org-babel-src-name-regexp) - (looking-at org-babel-multi-line-header-regexp)) - (progn - (while (and (forward-line 1) - (or (looking-at org-babel-src-name-regexp) - (looking-at org-babel-multi-line-header-regexp)))) - (looking-at org-babel-src-block-regexp)) - (point))) - (save-excursion ;; on a #+begin_src line - (beginning-of-line 1) - (and (looking-at org-babel-src-block-regexp) - (point))) - (save-excursion ;; inside a src block - (and - (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point)) - (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point)) - (< top initial) (< initial bottom) - (progn (goto-char top) (beginning-of-line 1) - (looking-at org-babel-src-block-regexp)) - (point)))))) - -;;;###autoload -(defun org-babel-goto-src-block-head () - "Go to the beginning of the current code block." - (interactive) - ((lambda (head) - (if head (goto-char head) (error "Not currently in a code block"))) - (org-babel-where-is-src-block-head))) - -;;;###autoload -(defun org-babel-goto-named-src-block (name) - "Go to a named source-code block." - (interactive - (let ((completion-ignore-case t) - (case-fold-search t) - (under-point (thing-at-point 'line))) - (list (org-icompleting-read - "source-block name: " (org-babel-src-block-names) nil t - (cond - ;; noweb - ((string-match (org-babel-noweb-wrap) under-point) - (let ((block-name (match-string 1 under-point))) - (string-match "[^(]*" block-name) - (match-string 0 block-name))) - ;; #+call: - ((string-match org-babel-lob-one-liner-regexp under-point) - (let ((source-info (car (org-babel-lob-get-info)))) - (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info) - (let ((source-name (match-string 1 source-info))) - source-name)))) - ;; #+results: - ((string-match (concat "#\\+" org-babel-results-keyword - "\\:\s+\\([^\\(]*\\)") under-point) - (match-string 1 under-point)) - ;; symbol-at-point - ((and (thing-at-point 'symbol)) - (org-babel-find-named-block (thing-at-point 'symbol)) - (thing-at-point 'symbol)) - ("")))))) - (let ((point (org-babel-find-named-block name))) - (if point - ;; taken from `org-open-at-point' - (progn (org-mark-ring-push) (goto-char point) (org-show-context)) - (message "source-code block '%s' not found in this buffer" name)))) - -(defun org-babel-find-named-block (name) - "Find a named source-code block. -Return the location of the source block identified by source -NAME, or nil if no such block exists. Set match data according to -org-babel-named-src-block-regexp." - (save-excursion - (let ((case-fold-search t) - (regexp (org-babel-named-src-block-regexp-for-name name)) msg) - (goto-char (point-min)) - (when (or (re-search-forward regexp nil t) - (re-search-backward regexp nil t)) - (match-beginning 0))))) - -(defun org-babel-src-block-names (&optional file) - "Returns the names of source blocks in FILE or the current buffer." - (save-excursion - (when file (find-file file)) (goto-char (point-min)) - (let ((case-fold-search t) names) - (while (re-search-forward org-babel-src-name-w-name-regexp nil t) - (setq names (cons (match-string 3) names))) - names))) - -;;;###autoload -(defun org-babel-goto-named-result (name) - "Go to a named result." - (interactive - (let ((completion-ignore-case t)) - (list (org-icompleting-read "source-block name: " - (org-babel-result-names) nil t)))) - (let ((point (org-babel-find-named-result name))) - (if point - ;; taken from `org-open-at-point' - (progn (goto-char point) (org-show-context)) - (message "result '%s' not found in this buffer" name)))) - -(defun org-babel-find-named-result (name &optional point) - "Find a named result. -Return the location of the result named NAME in the current -buffer or nil if no such result exists." - (save-excursion - (let ((case-fold-search t)) - (goto-char (or point (point-min))) - (catch 'is-a-code-block - (when (re-search-forward - (concat org-babel-result-regexp - "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t) - (when (and (string= "name" (downcase (match-string 1))) - (or (beginning-of-line 1) - (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp))) - (throw 'is-a-code-block (org-babel-find-named-result name (point)))) - (beginning-of-line 0) (point)))))) - -(defun org-babel-result-names (&optional file) - "Returns the names of results in FILE or the current buffer." - (save-excursion - (when file (find-file file)) (goto-char (point-min)) - (let ((case-fold-search t) names) - (while (re-search-forward org-babel-result-w-name-regexp nil t) - (setq names (cons (match-string 4) names))) - names))) - -;;;###autoload -(defun org-babel-next-src-block (&optional arg) - "Jump to the next source block. -With optional prefix argument ARG, jump forward ARG many source blocks." - (interactive "P") - (when (looking-at org-babel-src-block-regexp) (forward-char 1)) - (condition-case nil - (re-search-forward org-babel-src-block-regexp nil nil (or arg 1)) - (error (error "No further code blocks"))) - (goto-char (match-beginning 0)) (org-show-context)) - -;;;###autoload -(defun org-babel-previous-src-block (&optional arg) - "Jump to the previous source block. -With optional prefix argument ARG, jump backward ARG many source blocks." - (interactive "P") - (condition-case nil - (re-search-backward org-babel-src-block-regexp nil nil (or arg 1)) - (error (error "No previous code blocks"))) - (goto-char (match-beginning 0)) (org-show-context)) - -(defvar org-babel-load-languages) - -;;;###autoload -(defun org-babel-mark-block () - "Mark current src block." - (interactive) - ((lambda (head) - (when head - (save-excursion - (goto-char head) - (looking-at org-babel-src-block-regexp)) - (push-mark (match-end 5) nil t) - (goto-char (match-beginning 5)))) - (org-babel-where-is-src-block-head))) - -(defun org-babel-demarcate-block (&optional arg) - "Wrap or split the code in the region or on the point. -When called from inside of a code block the current block is -split. When called from outside of a code block a new code block -is created. In both cases if the region is demarcated and if the -region is not active then the point is demarcated." - (interactive "P") - (let ((info (org-babel-get-src-block-info 'light)) - (headers (progn (org-babel-where-is-src-block-head) - (match-string 4))) - (stars (concat (make-string (or (org-current-level) 1) ?*) " "))) - (if info - (mapc - (lambda (place) - (save-excursion - (goto-char place) - (let ((lang (nth 0 info)) - (indent (make-string (nth 5 info) ? ))) - (when (string-match "^[[:space:]]*$" - (buffer-substring (point-at-bol) - (point-at-eol))) - (delete-region (point-at-bol) (point-at-eol))) - (insert (concat - (if (looking-at "^") "" "\n") - indent "#+end_src\n" - (if arg stars indent) "\n" - indent "#+begin_src " lang - (if (> (length headers) 1) - (concat " " headers) headers) - (if (looking-at "[\n\r]") - "" - (concat "\n" (make-string (current-column) ? ))))))) - (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))) - (body (delete-and-extract-region - (if (org-region-active-p) (mark) (point)) (point)))) - (insert (concat (if (looking-at "^") "" "\n") - (if arg (concat stars "\n") "") - "#+begin_src " lang "\n" - body - (if (or (= (length body) 0) - (string-match "[\r\n]$" body)) "" "\n") - "#+end_src\n")) - (goto-char start) (move-end-of-line 1))))) - -(defvar org-babel-lob-one-liner-regexp) -(defun org-babel-where-is-src-block-result (&optional insert info hash indent) - "Find where the current source block results begin. -Return the point at the beginning of the result of the current -source block. Specifically at the beginning of the results line. -If no result exists for this block then create a results line -following the source block." - (save-excursion - (let* ((case-fold-search t) - (on-lob-line (save-excursion - (beginning-of-line 1) - (looking-at org-babel-lob-one-liner-regexp))) - (inlinep (when (org-babel-get-inline-src-block-matches) - (match-end 0))) - (name (if on-lob-line - (mapconcat #'identity (butlast (org-babel-lob-get-info)) "") - (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)) - (setq - found ;; was there a result (before we potentially insert one) - (or - inlinep - (and - ;; named results: - ;; - return t if it is found, else return nil - ;; - if it does not need to be rebuilt, then don't set end - ;; - if it does need to be rebuilt then do set end - name (setq beg (org-babel-find-named-result name)) - (prog1 beg - (when (and hash (not (string= hash (match-string 3)))) - (goto-char beg) (setq end beg) ;; beginning of result - (forward-line 1) - (delete-region end (org-babel-result-end)) nil))) - (and - ;; unnamed results: - ;; - return t if it is found, else return nil - ;; - if it is found, and the hash doesn't match, delete and set end - (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t)) - (progn (end-of-line 1) - (if (eobp) (insert "\n") (forward-char 1)) - (setq end (point)) - (or (and (not name) - (progn ;; unnamed results line already exists - (re-search-forward "[^ \f\t\n\r\v]" nil t) - (beginning-of-line 1) - (looking-at - (concat org-babel-result-regexp "\n"))) - (prog1 (point) - ;; must remove and rebuild if hash!=old-hash - (if (and hash (not (string= hash (match-string 3)))) - (prog1 nil - (forward-line 1) - (delete-region - end (org-babel-result-end))) - (setq end nil))))))))) - (if (and insert end) - (progn - (goto-char end) - (unless beg - (if (looking-at "[\n\r]") (forward-char 1) (insert "\n"))) - (insert (concat - (if indent - (mapconcat - (lambda (el) " ") - (org-number-sequence 1 indent) "") - "") - "#+" org-babel-results-keyword - (when hash (concat "["hash"]")) - ":" - (when name (concat " " name)) "\n")) - (unless beg (insert "\n") (backward-char)) - (beginning-of-line 0) - (if hash (org-babel-hide-hash)) - (point)) - found)))) - -(defvar org-block-regexp) -(defun org-babel-read-result () - "Read the result at `point' into emacs-lisp." - (let ((case-fold-search t) result-string) - (cond - ((org-at-table-p) (org-babel-read-table)) - ((org-at-item-p) (org-babel-read-list)) - ((looking-at org-bracket-link-regexp) (org-babel-read-link)) - ((looking-at org-block-regexp) (org-babel-trim (match-string 4))) - ((looking-at "^[ \t]*: ") - (setq result-string - (org-babel-trim - (mapconcat (lambda (line) - (if (and (> (length line) 1) - (string-match "^[ \t]*: \\(.+\\)" line)) - (match-string 1 line) - line)) - (split-string - (buffer-substring - (point) (org-babel-result-end)) "[\r\n]+") - "\n"))) - (or (org-babel-number-p result-string) result-string)) - ((looking-at org-babel-result-regexp) - (save-excursion (forward-line 1) (org-babel-read-result)))))) - -(defun org-babel-read-table () - "Read the table at `point' into emacs-lisp." - (mapcar (lambda (row) - (if (and (symbolp row) (equal row 'hline)) row - (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row))) - (org-table-to-lisp))) - -(defun org-babel-read-list () - "Read the list at `point' into emacs-lisp." - (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) - (mapcar #'cadr (cdr (org-list-parse-list))))) - -(defvar org-link-types-re) -(defun org-babel-read-link () - "Read the link at `point' into emacs-lisp. -If the path of the link is a file path it is expanded using -`expand-file-name'." - (let* ((case-fold-search t) - (raw (and (looking-at org-bracket-link-regexp) - (org-no-properties (match-string 1)))) - (type (and (string-match org-link-types-re raw) - (match-string 1 raw)))) - (cond - ((not type) (expand-file-name raw)) - ((string= type "file") - (and (string-match "file\\(.*\\):\\(.+\\)" raw) - (expand-file-name (match-string 2 raw)))) - (t raw)))) - -(defun org-babel-format-result (result &optional sep) - "Format RESULT for writing to file." - (let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r))))) - (if (listp result) - ;; table result - (orgtbl-to-generic - result (list :sep (or sep "\t") :fmt echo-res)) - ;; scalar result - (funcall echo-res result)))) - -(defun org-babel-insert-result - (result &optional result-params info hash indent lang) - "Insert RESULT into the current buffer. -By default RESULT is inserted after the end of the -current source block. With optional argument RESULT-PARAMS -controls insertion of results in the org-mode file. -RESULT-PARAMS can take the following values: - -replace - (default option) insert results after the source block - replacing any previously inserted results - -silent -- no results are inserted - -file ---- the results are interpreted as a file path, and are - inserted into the buffer using the Org-mode file syntax - -list ---- the results are interpreted as an Org-mode list. - -raw ----- results are added directly to the Org-mode file. This - is a good option if you code block will output org-mode - formatted text. - -drawer -- results are added directly to the Org-mode file as with - \"raw\", but are wrapped in a RESULTS drawer, allowing - them to later be replaced or removed automatically. - -org ----- results are added inside of a \"#+BEGIN_SRC org\" block. - They are not comma-escaped when inserted, but Org syntax - here will be discarded when exporting the file. - -html ---- results are added inside of a #+BEGIN_HTML block. This - is a good option if you code block will output html - formatted text. - -latex --- results are added inside of a #+BEGIN_LATEX block. - This is a good option if you code block will output - latex formatted text. - -code ---- the results are extracted in the syntax of the source - code of the language being evaluated and are added - inside of a #+BEGIN_SRC block with the source-code - language set appropriately. Note this relies on the - optional LANG argument." - (if (stringp result) - (progn - (setq result (org-no-properties result)) - (when (member "file" result-params) - (setq result (org-babel-result-to-file - result (when (assoc :file-desc (nth 2 info)) - (or (cdr (assoc :file-desc (nth 2 info))) - result)))))) - (unless (listp result) (setq result (format "%S" result)))) - (if (and result-params (member "silent" result-params)) - (progn - (message (replace-regexp-in-string "%" "%%" (format "%S" result))) - result) - (save-excursion - (let* ((inlinep - (save-excursion - (when (or (org-babel-get-inline-src-block-matches) - (org-babel-get-lob-one-liner-matches)) - (goto-char (match-end 0)) - (insert (if (listp result) "\n" " ")) - (point)))) - (existing-result (unless inlinep - (org-babel-where-is-src-block-result - t info hash indent))) - (results-switches - (cdr (assoc :results_switches (nth 2 info)))) - beg end) - (when (and (stringp result) ; ensure results end in a newline - (not inlinep) - (> (length result) 0) - (not (or (string-equal (substring result -1) "\n") - (string-equal (substring result -1) "\r")))) - (setq result (concat result "\n"))) - (if (not existing-result) - (setq beg (or inlinep (point))) - (goto-char existing-result) - (save-excursion - (re-search-forward "#" nil t) - (setq indent (- (current-column) 1))) - (forward-line 1) - (setq beg (point)) - (cond - ((member "replace" result-params) - (delete-region (point) (org-babel-result-end))) - ((member "append" result-params) - (goto-char (org-babel-result-end)) (setq beg (point-marker))) - ((member "prepend" result-params)))) ; already there - (setq results-switches - (if results-switches (concat " " results-switches) "")) - (let ((wrap (lambda (start finish) - (goto-char end) (insert (concat finish "\n")) - (goto-char beg) (insert (concat start "\n")) - (org-escape-code-in-region (point) end) - (goto-char end) (goto-char (point-at-eol)) - (setq end (point-marker)))) - (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it))))))) - ;; insert results based on type - (cond - ;; do nothing for an empty result - ((null result)) - ;; insert a list if preferred - ((member "list" result-params) - (insert - (org-babel-trim - (org-list-to-generic - (cons 'unordered - (mapcar - (lambda (el) (list nil (if (stringp el) el (format "%S" el)))) - (if (listp result) result (list result)))) - '(:splicep nil :istart "- " :iend "\n"))) - "\n")) - ;; assume the result is a table if it's not a string - ((funcall proper-list-p result) - (goto-char beg) - (insert (concat (orgtbl-to-orgtbl - (if (or (eq 'hline (car result)) - (and (listp (car result)) - (listp (cdr (car result))))) - result (list result)) - '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) - (goto-char beg) (when (org-at-table-p) (org-table-align))) - ((and (listp result) (not (funcall proper-list-p result))) - (insert (format "%s\n" result))) - ((member "file" result-params) - (when inlinep (goto-char inlinep)) - (insert result)) - (t (goto-char beg) (insert result))) - (when (funcall proper-list-p result) (goto-char (org-table-end))) - (setq end (point-marker)) - ;; possibly wrap result - (cond - ((assoc :wrap (nth 2 info)) - (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS"))) - (funcall wrap (concat "#+BEGIN_" name) (concat "#+END_" name)))) - ((member "html" result-params) - (funcall wrap "#+BEGIN_HTML" "#+END_HTML")) - ((member "latex" result-params) - (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX")) - ((member "org" result-params) - (funcall wrap "#+BEGIN_SRC org" "#+END_SRC")) - ((member "code" result-params) - (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches) - "#+END_SRC")) - ((member "raw" result-params) - (goto-char beg) (if (org-at-table-p) (org-cycle))) - ((or (member "drawer" result-params) - ;; Stay backward compatible with <7.9.2 - (member "wrap" result-params)) - (funcall wrap ":RESULTS:" ":END:")) - ((and (not (funcall proper-list-p result)) - (not (member "file" result-params))) - (org-babel-examplize-region beg end results-switches) - (setq end (point))))) - ;; possibly indent the results to match the #+results line - (when (and (not inlinep) (numberp indent) indent (> indent 0) - ;; in this case `table-align' does the work for us - (not (and (listp result) - (member "append" result-params)))) - (indent-rigidly beg end indent)))) - (if (null result) - (if (member "value" result-params) - (message "Code block returned no value.") - (message "Code block produced no output.")) - (message "Code block evaluation complete.")))) - -(defun org-babel-remove-result (&optional info) - "Remove the result of the current source block." - (interactive) - (let ((location (org-babel-where-is-src-block-result nil info)) start) - (when location - (setq start (- location 1)) - (save-excursion - (goto-char location) (forward-line 1) - (delete-region start (org-babel-result-end)))))) - -(defun org-babel-result-end () - "Return the point at the end of the current set of results." - (save-excursion - (cond - ((org-at-table-p) (progn (goto-char (org-table-end)) (point))) - ((org-at-item-p) (let* ((struct (org-list-struct)) - (prvs (org-list-prevs-alist struct))) - (org-list-get-list-end (point-at-bol) struct prvs))) - ((let ((case-fold-search t)) (looking-at "^\\([ \t]*\\):results:")) - (progn (re-search-forward (concat "^" (match-string 1) ":END:")) - (forward-char 1) (point))) - (t - (let ((case-fold-search t)) - (if (looking-at (concat "[ \t]*#\\+begin_\\([^ \t\n\r]+\\)")) - (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1)) - nil t) - (forward-char 1)) - (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)") - (forward-line 1)))) - (point))))) - -(defun org-babel-result-to-file (result &optional description) - "Convert RESULT into an `org-mode' link with optional DESCRIPTION. -If the `default-directory' is different from the containing -file's directory then expand relative links." - (when (stringp result) - (format "[[file:%s]%s]" - (if (and default-directory - buffer-file-name - (not (string= (expand-file-name default-directory) - (expand-file-name - (file-name-directory buffer-file-name))))) - (expand-file-name result default-directory) - result) - (if description (concat "[" description "]") "")))) - -(defvar org-babel-capitalize-examplize-region-markers nil - "Make true to capitalize begin/end example markers inserted by code blocks.") - -(defun org-babel-examplize-region (beg end &optional results-switches) - "Comment out region using the inline '==' or ': ' org example quote." - (interactive "*r") - (let ((chars-between (lambda (b e) - (not (string-match "^[\\s]*$" (buffer-substring b e))))) - (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers - (upcase str) str)))) - (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg) - (funcall chars-between end (save-excursion (goto-char end) (point-at-eol)))) - (save-excursion - (goto-char beg) - (insert (format "=%s=" (prog1 (buffer-substring beg end) - (delete-region beg end))))) - (let ((size (count-lines beg end))) - (save-excursion - (cond ((= size 0)) ; do nothing for an empty result - ((< size org-babel-min-lines-for-block-output) - (goto-char beg) - (dotimes (n size) - (beginning-of-line 1) (insert ": ") (forward-line 1))) - (t - (goto-char beg) - (insert (if results-switches - (format "%s%s\n" - (funcall maybe-cap "#+begin_example") - results-switches) - (funcall maybe-cap "#+begin_example\n"))) - (if (markerp end) (goto-char end) (forward-char (- end beg))) - (insert (funcall maybe-cap "#+end_example\n"))))))))) - -(defun org-babel-update-block-body (new-body) - "Update the body of the current code block to NEW-BODY." - (if (not (org-babel-where-is-src-block-head)) - (error "Not in a source block") - (save-match-data - (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5)) - (indent-rigidly (match-beginning 5) (match-end 5) 2))) - -(defun org-babel-merge-params (&rest plists) - "Combine all parameter association lists in PLISTS. -Later elements of PLISTS override the values of previous elements. -This takes into account some special considerations for certain -parameters when merging lists." - (let* ((results-exclusive-groups - (mapcar (lambda (group) (mapcar #'symbol-name group)) - (cdr (assoc 'results org-babel-common-header-args-w-values)))) - (exports-exclusive-groups - (mapcar (lambda (group) (mapcar #'symbol-name group)) - (cdr (assoc 'exports org-babel-common-header-args-w-values)))) - (variable-index 0) - (e-merge (lambda (exclusive-groups &rest result-params) - ;; maintain exclusivity of mutually exclusive parameters - (let (output) - (mapc (lambda (new-params) - (mapc (lambda (new-param) - (mapc (lambda (exclusive-group) - (when (member new-param exclusive-group) - (mapcar (lambda (excluded-param) - (setq output - (delete - excluded-param - output))) - exclusive-group))) - exclusive-groups) - (setq output (org-uniquify - (cons new-param output)))) - new-params)) - result-params) - output))) - params results exports tangle noweb cache vars shebang comments padline) - - (mapc - (lambda (plist) - (mapc - (lambda (pair) - (case (car pair) - (:var - (let ((name (if (listp (cdr pair)) - (cadr pair) - (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" - (cdr pair)) - (intern (match-string 1 (cdr pair))))))) - (if name - (setq vars - (append - (if (member name (mapcar #'car vars)) - (delq nil - (mapcar - (lambda (p) - (unless (equal (car p) name) p)) - vars)) - vars) - (list (cons name pair)))) - ;; if no name is given and we already have named variables - ;; then assign to named variables in order - (if (and vars (nth variable-index vars)) - (prog1 (setf (cddr (nth variable-index vars)) - (concat (symbol-name - (car (nth variable-index vars))) - "=" (cdr pair))) - (incf variable-index)) - (error "Variable \"%s\" must be assigned a default value" - (cdr pair)))))) - (:results - (setq results (funcall e-merge results-exclusive-groups - results - (split-string - (let ((r (cdr pair))) - (if (stringp r) r (eval r))))))) - (:file - (when (cdr pair) - (setq results (funcall e-merge results-exclusive-groups - results '("file"))) - (unless (or (member "both" exports) - (member "none" exports) - (member "code" exports)) - (setq exports (funcall e-merge exports-exclusive-groups - exports '("results")))) - (setq params (cons pair (assq-delete-all (car pair) params))))) - (:exports - (setq exports (funcall e-merge exports-exclusive-groups - exports (split-string (cdr pair))))) - (:tangle ;; take the latest -- always overwrite - (setq tangle (or (list (cdr pair)) tangle))) - (:noweb - (setq noweb (funcall e-merge - '(("yes" "no" "tangle" "no-export" - "strip-export" "eval")) - noweb - (split-string (or (cdr pair) ""))))) - (:cache - (setq cache (funcall e-merge '(("yes" "no")) cache - (split-string (or (cdr pair) ""))))) - (:padline - (setq padline (funcall e-merge '(("yes" "no")) padline - (split-string (or (cdr pair) ""))))) - (:shebang ;; take the latest -- always overwrite - (setq shebang (or (list (cdr pair)) shebang))) - (:comments - (setq comments (funcall e-merge '(("yes" "no")) comments - (split-string (or (cdr pair) ""))))) - (t ;; replace: this covers e.g. :session - (setq params (cons pair (assq-delete-all (car pair) params)))))) - plist)) - plists) - (setq vars (reverse vars)) - (while vars (setq params (cons (cons :var (cddr (pop vars))) params))) - (mapc - (lambda (hd) - (let ((key (intern (concat ":" (symbol-name hd)))) - (val (eval hd))) - (setf params (cons (cons key (mapconcat 'identity val " ")) params)))) - '(results exports tangle noweb padline cache shebang comments)) - params)) - -(defvar *org-babel-use-quick-and-dirty-noweb-expansion* nil - "Set to true to use regular expressions to expand noweb references. -This results in much faster noweb reference expansion but does -not properly allow code blocks to inherit the \":noweb-ref\" -header argument from buffer or subtree wide properties.") - -(defun org-babel-noweb-p (params context) - "Check if PARAMS require expansion in CONTEXT. -CONTEXT may be one of :tangle, :export or :eval." - (let* (intersect - (intersect (lambda (as bs) - (when as - (if (member (car as) bs) - (car as) - (funcall intersect (cdr as) bs)))))) - (funcall intersect (case context - (:tangle '("yes" "tangle" "no-export" "strip-export")) - (:eval '("yes" "no-export" "strip-export" "eval")) - (:export '("yes"))) - (split-string (or (cdr (assoc :noweb params)) ""))))) - -(defun org-babel-expand-noweb-references (&optional info parent-buffer) - "Expand Noweb references in the body of the current source code block. - -For example the following reference would be replaced with the -body of the source-code block named 'example-block'. - -<> - -Note that any text preceding the <> construct on a line will -be interposed between the lines of the replacement text. So for -example if <> is placed behind a comment, then the entire -replacement text will also be commented. - -This function must be called from inside of the buffer containing -the source-code block which holds BODY. - -In addition the following syntax can be used to insert the -results of evaluating the source-code block named 'example-block'. - -<> - -Any optional arguments can be passed to example-block by placing -the arguments inside the parenthesis following the convention -defined by `org-babel-lob'. For example - -<> - -would set the value of argument \"a\" equal to \"9\". Note that -these arguments are not evaluated in the current source-code -block but are passed literally to the \"example-block\"." - (let* ((parent-buffer (or parent-buffer (current-buffer))) - (info (or info (org-babel-get-src-block-info))) - (lang (nth 0 info)) - (body (nth 1 info)) - (ob-nww-start org-babel-noweb-wrap-start) - (ob-nww-end org-babel-noweb-wrap-end) - (comment (string= "noweb" (cdr (assoc :comments (nth 2 info))))) - (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|" - ":noweb-ref[ \t]+" "\\)")) - (new-body "") - (nb-add (lambda (text) (setq new-body (concat new-body text)))) - (c-wrap (lambda (text) - (with-temp-buffer - (funcall (intern (concat lang "-mode"))) - (comment-region (point) (progn (insert text) (point))) - (org-babel-trim (buffer-string))))) - index source-name evaluate prefix blocks-in-buffer) - (with-temp-buffer - (org-set-local 'org-babel-noweb-wrap-start ob-nww-start) - (org-set-local 'org-babel-noweb-wrap-end ob-nww-end) - (insert body) (goto-char (point-min)) - (setq index (point)) - (while (and (re-search-forward (org-babel-noweb-wrap) nil t)) - (save-match-data (setf source-name (match-string 1))) - (save-match-data (setq evaluate (string-match "\(.*\)" source-name))) - (save-match-data - (setq prefix - (buffer-substring (match-beginning 0) - (save-excursion - (beginning-of-line 1) (point))))) - ;; add interval to new-body (removing noweb reference) - (goto-char (match-beginning 0)) - (funcall nb-add (buffer-substring index (point))) - (goto-char (match-end 0)) - (setq index (point)) - (funcall nb-add - (with-current-buffer parent-buffer - (save-restriction - (widen) - (mapconcat ;; interpose PREFIX between every line - #'identity - (split-string - (if evaluate - (let ((raw (org-babel-ref-resolve source-name))) - (if (stringp raw) raw (format "%S" raw))) - (or - ;; retrieve from the library of babel - (nth 2 (assoc (intern source-name) - org-babel-library-of-babel)) - ;; return the contents of headlines literally - (save-excursion - (when (org-babel-ref-goto-headline-id source-name) - (org-babel-ref-headline-body))) - ;; find the expansion of reference in this buffer - (let ((rx (concat rx-prefix source-name "[ \t\n]")) - expansion) - (save-excursion - (goto-char (point-min)) - (if *org-babel-use-quick-and-dirty-noweb-expansion* - (while (re-search-forward rx nil t) - (let* ((i (org-babel-get-src-block-info 'light)) - (body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) - "\n")) - (full (if comment - ((lambda (cs) - (concat (funcall c-wrap (car cs)) "\n" - body "\n" - (funcall c-wrap (cadr cs)))) - (org-babel-tangle-comment-links i)) - body))) - (setq expansion (cons sep (cons full expansion))))) - (org-babel-map-src-blocks nil - (let ((i (org-babel-get-src-block-info 'light))) - (when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) - (nth 4 i)) - source-name) - (let* ((body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) - "\n")) - (full (if comment - ((lambda (cs) - (concat (funcall c-wrap (car cs)) "\n" - body "\n" - (funcall c-wrap (cadr cs)))) - (org-babel-tangle-comment-links i)) - body))) - (setq expansion - (cons sep (cons full expansion))))))))) - (and expansion - (mapconcat #'identity (nreverse (cdr expansion)) ""))) - ;; possibly raise an error if named block doesn't exist - (if (member lang org-babel-noweb-error-langs) - (error "%s" (concat - (org-babel-noweb-wrap source-name) - "could not be resolved (see " - "`org-babel-noweb-error-langs')")) - ""))) - "[\n\r]") (concat "\n" prefix)))))) - (funcall nb-add (buffer-substring index (point-max)))) - new-body)) - -(defun org-babel-script-escape (str &optional force) - "Safely convert tables into elisp lists." - (let (in-single in-double out) - ((lambda (escaped) (condition-case nil (org-babel-read escaped) (error escaped))) - (if (or force - (and (stringp str) - (> (length str) 2) - (or (and (string-equal "[" (substring str 0 1)) - (string-equal "]" (substring str -1))) - (and (string-equal "{" (substring str 0 1)) - (string-equal "}" (substring str -1))) - (and (string-equal "(" (substring str 0 1)) - (string-equal ")" (substring str -1)))))) - (org-babel-read - (concat - "'" - (progn - (mapc - (lambda (ch) - (setq - out - (case ch - (91 (if (or in-double in-single) ; [ - (cons 91 out) - (cons 40 out))) - (93 (if (or in-double in-single) ; ] - (cons 93 out) - (cons 41 out))) - (123 (if (or in-double in-single) ; { - (cons 123 out) - (cons 40 out))) - (125 (if (or in-double in-single) ; } - (cons 125 out) - (cons 41 out))) - (44 (if (or in-double in-single) ; , - (cons 44 out) (cons 32 out))) - (39 (if in-double ; ' - (cons 39 out) - (setq in-single (not in-single)) (cons 34 out))) - (34 (if in-single ; " - (append (list 34 32) out) - (setq in-double (not in-double)) (cons 34 out))) - (t (cons ch out))))) - (string-to-list str)) - (apply #'string (reverse out))))) - str)))) - -(defun org-babel-read (cell &optional inhibit-lisp-eval) - "Convert the string value of CELL to a number if appropriate. -Otherwise if cell looks like lisp (meaning it starts with a -\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, otherwise -return it unmodified as a string. Optional argument NO-LISP-EVAL -inhibits lisp evaluation for situations in which is it not -appropriate." - (if (and (stringp cell) (not (equal cell ""))) - (or (org-babel-number-p cell) - (if (and (not inhibit-lisp-eval) - (member (substring cell 0 1) '("(" "'" "`" "["))) - (eval (read cell)) - (if (string= (substring cell 0 1) "\"") - (read cell) - (progn (set-text-properties 0 (length cell) nil cell) cell)))) - cell)) - -(defun org-babel-number-p (string) - "If STRING represents a number return its value." - (if (and (string-match "^-?[0-9]*\\.?[0-9]*$" string) - (= (length (substring string (match-beginning 0) - (match-end 0))) - (length string))) - (string-to-number string))) - -(defun org-babel-import-elisp-from-file (file-name &optional separator) - "Read the results located at FILE-NAME into an elisp table. -If the table is trivial, then return it as a scalar." - (let (result) - (save-window-excursion - (with-temp-buffer - (condition-case err - (progn - (org-table-import file-name separator) - (delete-file file-name) - (setq result (mapcar (lambda (row) - (mapcar #'org-babel-string-read row)) - (org-table-to-lisp)))) - (error (message "Error reading results: %s" err) nil))) - (if (null (cdr result)) ;; if result is trivial vector, then scalarize it - (if (consp (car result)) - (if (null (cdr (car result))) - (caar result) - result) - (car result)) - result)))) - -(defun org-babel-string-read (cell) - "Strip nested \"s from around strings." - (org-babel-read (or (and (stringp cell) - (string-match "\\\"\\(.+\\)\\\"" cell) - (match-string 1 cell)) - cell) t)) - -(defun org-babel-reverse-string (string) - "Return the reverse of STRING." - (apply 'string (reverse (string-to-list string)))) - -(defun org-babel-chomp (string &optional regexp) - "Strip trailing spaces and carriage returns from STRING. -Default regexp used is \"[ \f\t\n\r\v]\" but can be -overwritten by specifying a regexp as a second argument." - (let ((regexp (or regexp "[ \f\t\n\r\v]"))) - (while (and (> (length string) 0) - (string-match regexp (substring string -1))) - (setq string (substring string 0 -1))) - string)) - -(defun org-babel-trim (string &optional regexp) - "Strip leading and trailing spaces and carriage returns from STRING. -Like `org-babel-chomp' only it runs on both the front and back -of the string." - (org-babel-chomp (org-babel-reverse-string - (org-babel-chomp (org-babel-reverse-string string) regexp)) - regexp)) - -(defvar org-babel-org-babel-call-process-region-original nil) -(defun org-babel-tramp-handle-call-process-region - (start end program &optional delete buffer display &rest args) - "Use Tramp to handle `call-process-region'. -Fixes a bug in `tramp-handle-call-process-region'." - (if (and (featurep 'tramp) (file-remote-p default-directory)) - (let ((tmpfile (tramp-compat-make-temp-file ""))) - (write-region start end tmpfile) - (when delete (delete-region start end)) - (unwind-protect - ;; (apply 'call-process program tmpfile buffer display args) - ;; bug in tramp - (apply 'process-file program tmpfile buffer display args) - (delete-file tmpfile))) - ;; org-babel-call-process-region-original is the original emacs - ;; definition. It is in scope from the let binding in - ;; org-babel-execute-src-block - (apply org-babel-call-process-region-original - start end program delete buffer display args))) - -(defun org-babel-local-file-name (file) - "Return the local name component of FILE." - (if (file-remote-p file) - (let (localname) - (with-parsed-tramp-file-name file nil - localname)) - file)) - -(defun org-babel-process-file-name (name &optional no-quote-p) - "Prepare NAME to be used in an external process. -If NAME specifies a remote location, the remote portion of the -name is removed, since in that case the process will be executing -remotely. The file name is then processed by `expand-file-name'. -Unless second argument NO-QUOTE-P is non-nil, the file name is -additionally processed by `shell-quote-argument'" - ((lambda (f) (if no-quote-p f (shell-quote-argument f))) - (expand-file-name (org-babel-local-file-name name)))) - -(defvar org-babel-temporary-directory) -(unless (or noninteractive (boundp 'org-babel-temporary-directory)) - (defvar org-babel-temporary-directory - (or (and (boundp 'org-babel-temporary-directory) - (file-exists-p org-babel-temporary-directory) - org-babel-temporary-directory) - (make-temp-file "babel-" t)) - "Directory to hold temporary files created to execute code blocks. -Used by `org-babel-temp-file'. This directory will be removed on -Emacs shutdown.")) - -(defun org-babel-temp-file (prefix &optional suffix) - "Create a temporary file in the `org-babel-temporary-directory'. -Passes PREFIX and SUFFIX directly to `make-temp-file' with the -value of `temporary-file-directory' temporarily set to the value -of `org-babel-temporary-directory'." - (let ((temporary-file-directory - (if (file-remote-p default-directory) - (concat (file-remote-p default-directory) "/tmp") - (or (and (boundp 'org-babel-temporary-directory) - (file-exists-p org-babel-temporary-directory) - org-babel-temporary-directory) - temporary-file-directory)))) - (make-temp-file prefix nil suffix))) - -(defun org-babel-remove-temporary-directory () - "Remove `org-babel-temporary-directory' on Emacs shutdown." - (when (and (boundp 'org-babel-temporary-directory) - (file-exists-p org-babel-temporary-directory)) - ;; taken from `delete-directory' in files.el - (condition-case nil - (progn - (mapc (lambda (file) - ;; This test is equivalent to - ;; (and (file-directory-p fn) (not (file-symlink-p fn))) - ;; but more efficient - (if (eq t (car (file-attributes file))) - (delete-directory file) - (delete-file file))) - ;; We do not want to delete "." and "..". - (directory-files org-babel-temporary-directory 'full - "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) - (delete-directory org-babel-temporary-directory)) - (error - (message "Failed to remove temporary Org-babel directory %s" - (if (boundp 'org-babel-temporary-directory) - org-babel-temporary-directory - "[directory not defined]")))))) - -(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) +(require 'ob-core) +(require 'ob-comint) +(require 'ob-exp) +(require 'ob-keys) +(require 'ob-table) +(require 'ob-lob) +(require 'ob-ref) +(require 'ob-tangle) (provide 'ob) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 48328d851..631c6d03c 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -242,6 +242,11 @@ you can \"misuse\" it to also add other text to the header." (defconst org-sorting-choice '(choice (const time-up) (const time-down) + (const timestamp-up) (const timestamp-down) + (const scheduled-up) (const scheduled-down) + (const deadline-up) (const deadline-down) + (const ts-up) (const ts-down) + (const tsia-up) (const tsia-down) (const category-keep) (const category-up) (const category-down) (const tag-down) (const tag-up) (const priority-up) (const priority-down) @@ -254,9 +259,50 @@ you can \"misuse\" it to also add other text to the header." ;; Keep custom values for `org-agenda-filter-preset' compatible with ;; the new variable `org-agenda-tag-filter-preset'. -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) - (defvaralias 'org-agenda-filter 'org-agenda-tag-filter)) +(org-defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) +(org-defvaralias 'org-agenda-filter 'org-agenda-tag-filter) + +(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) + "List of types searched for when creating the daily/weekly agenda. +This variable is a list of symbols that controls the types of +items that appear in the daily/weekly agenda. Allowed symbols in this +list are are + + :timestamp List items containing a date stamp or date range matching + the selected date. This includes sexp entries in angular + brackets. + + :sexp List entries resulting from plain diary-like sexps. + + :deadline List deadline due on that date. When the date is today, + also list any deadlines past due, or due within + `org-deadline-warning-days'. `:deadline' must appear before + `:scheduled' if the setting of + `org-agenda-skip-scheduled-if-deadline-is-shown' is to have + any effect. + + :deadline* Same as above, but only include the deadline if it has an + hour specification as [h]h:mm. + + :scheduled List all items which are scheduled for the given date. + The diary for *today* also contains items which were + scheduled earlier and are not yet marked DONE. + + :scheduled* Same as above, but only include the scheduled item if it + has an hour specification as [h]h:mm. + +By default, all four non-starred types are turned on. + +When :scheduled* or :deadline* are included, :schedule or :deadline +will be ignored. + +Never set this variable globally using `setq', because then it +will apply to all future agenda commands. Instead, bind it with +`let' to scope it dynamically into the agenda-constructing +command. A good way to set it is through options in +`org-agenda-custom-commands'. For a more flexible (though +somewhat less efficient) way of determining what is included in +the daily/weekly agenda, see `org-agenda-skip-function'.") (defconst org-agenda-custom-commands-local-options `(repeat :tag "Local settings for this command. Remember to quote values" @@ -311,13 +357,21 @@ you can \"misuse\" it to also add other text to the header." (const :format "" quote) (repeat (string :tag "+tag or -tag")))) + (list :tag "Regexp filter preset" + (const org-agenda-regexp-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+regexp or -regexp")))) (list :tag "Set daily/weekly entry types" (const org-agenda-entry-types) (list (const :format "" quote) - (set :greedy t :value (:deadline :scheduled :timestamp :sexp) + (set :greedy t :value ,org-agenda-entry-types (const :deadline) (const :scheduled) + (const :deadline*) + (const :scheduled*) (const :timestamp) (const :sexp)))) (list :tag "Standard skipping condition" @@ -371,8 +425,8 @@ This will be spliced into the custom type of `org-agenda-custom-commands'.") -(defcustom org-agenda-custom-commands '(("n" "Agenda and all TODO's" - ((agenda "") (alltodo)))) +(defcustom org-agenda-custom-commands + '(("n" "Agenda and all TODO's" ((agenda "") (alltodo "")))) "Custom commands for the agenda. These commands will be offered on the splash screen displayed by the agenda dispatcher \\[org-agenda]. Each entry is a list like this: @@ -603,6 +657,13 @@ that are marked with the ARCHIVE tag will be included anyway. When this is t, also all archive files associated with the current selection of agenda files will be included.") +(defcustom org-agenda-restriction-lock-highlight-subtree t + "Non-nil means highlight the whole subtree when restriction is active. +Otherwise only highlight the headline. Highlighting the whole subtree is +useful to ensure no edits happen beyond the restricted region." + :group 'org-agenda + :type 'boolean) + (defcustom org-agenda-skip-comment-trees t "Non-nil means skip trees that start with the COMMENT keyword. When nil, these trees are also scanned by agenda commands." @@ -740,8 +801,24 @@ to make his option also apply to the tags-todo list." (const :tag "Show all TODOs, even if they have a deadline" nil) (integer :tag "Ignore if N or more days in past(-) or future(+)."))) +(defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil + "Time unit to use when possibly ignoring an agenda item. + +See the docstring of various `org-agenda-todo-ignore-*' options. +The default is to compare time stamps using days. An item is thus +considered to be in the future if it is at least one day after today. +Non-nil means to compare time stamps using seconds. An item is then +considered future if it has a time value later than current time." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Compare time with days" nil) + (const :tag "Compare time with seconds" t))) + (defcustom org-agenda-tags-todo-honor-ignore-options nil - "Non-nil means honor todo-list ...ignore options also in tags-todo search. + "Non-nil means honor todo-list ignores options also in tags-todo search. The variables `org-agenda-todo-ignore-with-date', `org-agenda-todo-ignore-timestamp', @@ -768,20 +845,29 @@ is DONE." (defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil "Non-nil means skip scheduling line if same entry shows because of deadline. -In the agenda of today, an entry can show up multiple times because -it is both scheduled and has a nearby deadline, and maybe a plain time -stamp as well. -When this variable is t, then only the deadline is shown and the fact that -the entry is scheduled today or was scheduled previously is not shown. -When this variable is nil, the entry will be shown several times. When -the variable is the symbol `not-today', then skip scheduled previously, -but not scheduled today." + +In the agenda of today, an entry can show up multiple times +because it is both scheduled and has a nearby deadline, and maybe +a plain time stamp as well. + +When this variable is nil, the entry will be shown several times. + +When set to t, then only the deadline is shown and the fact that +the entry is scheduled today or was scheduled previously is not +shown. + +When set to the symbol `not-today', skip scheduled previously, +but not scheduled today. + +When set to the symbol `repeated-after-deadline', skip scheduled +items if they are repeated beyond the current dealine." :group 'org-agenda-skip :group 'org-agenda-daily/weekly :type '(choice (const :tag "Never" nil) (const :tag "Always" t) - (const :tag "Not when scheduled today" not-today))) + (const :tag "Not when scheduled today" not-today) + (const :tag "When repeated past deadline" repeated-after-deadline))) (defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil "Non-nil means skip timestamp line if same entry shows because of deadline. @@ -813,9 +899,10 @@ deadlines are always turned off when the item is DONE." This will apply on all days where a prewarning for the deadline would be shown, but not at the day when the entry is actually due. On that day, the deadline will be shown anyway. -This variable may be set to nil, t, or a number which will then give -the number of days before the actual deadline when the prewarnings -should resume. +This variable may be set to nil, t, the symbol `pre-scheduled', +or a number which will then give the number of days before the actual +deadline when the prewarnings should resume. The symbol `pre-scheduled' +eliminates the deadline prewarning only prior to the scheduled date. This can be used in a workflow where the first showing of the deadline will trigger you to schedule it, and then you don't want to be reminded of it because you will take care of it on the day when scheduled." @@ -824,9 +911,26 @@ because you will take care of it on the day when scheduled." :version "24.1" :type '(choice (const :tag "Always show prewarning" nil) + (const :tag "Remove prewarning prior to scheduled date" pre-scheduled) (const :tag "Remove prewarning if entry is scheduled" t) (integer :tag "Restart prewarning N days before deadline"))) +(defcustom org-agenda-skip-scheduled-delay-if-deadline nil + "Non-nil means skip scheduled delay when entry also has a deadline. +This variable may be set to nil, t, the symbol `post-deadline', +or a number which will then give the number of days after the actual +scheduled date when the delay should expire. The symbol `post-deadline' +eliminates the schedule delay when the date is posterior to the deadline." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Always honor delay" nil) + (const :tag "Ignore delay if posterior to the deadline" post-deadline) + (const :tag "Ignore delay if entry has a deadline" t) + (integer :tag "Honor delay up until N days after the scheduled date"))) + (defcustom org-agenda-skip-additional-timestamps-same-entry nil "When nil, multiple same-day timestamps in entry make multiple agenda lines. When non-nil, after the search for timestamps has matched once in an @@ -840,7 +944,7 @@ entry, the rest of the entry will not be searched." :group 'org-agenda-daily/weekly :type 'boolean) -(defcustom org-agenda-dim-blocked-tasks nil +(defcustom org-agenda-dim-blocked-tasks t "Non-nil means dim blocked tasks in the agenda display. This causes some overhead during agenda construction, but if you have turned on `org-enforce-todo-dependencies', @@ -956,6 +1060,13 @@ removed from entry text before it is shown in the agenda." :group 'org-agenda :type '(repeat (regexp))) +(defcustom org-agenda-entry-text-leaders " > " + "Text prepended to the entry text in agenda buffers." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda + :type 'string) + (defvar org-agenda-entry-text-cleanup-hook nil "Hook that is run after basic cleanup of entry text to be shown in agenda. This cleanup is done in a temporary buffer, so the function may inspect and @@ -1030,7 +1141,7 @@ Custom commands can set this variable in the options section." (defcustom org-agenda-start-on-weekday 1 "Non-nil means start the overview always on the specified weekday. -0 denotes Sunday, 1 denotes Monday etc. +0 denotes Sunday, 1 denotes Monday, etc. When nil, always start on the current day. Custom commands can set this variable in the options section." :group 'org-agenda-daily/weekly @@ -1055,7 +1166,7 @@ a calendar-style date list like (month day year)." (function :tag "Function"))) (defun org-agenda-format-date-aligned (date) - "Format a date string for display in the daily/weekly agenda, or timeline. + "Format a DATE string for display in the daily/weekly agenda, or timeline. This function makes sure that dates are aligned for easy reading." (require 'cal-iso) (let* ((dayname (calendar-day-name date)) @@ -1108,8 +1219,7 @@ For example, 9:30am would become 09:30 rather than 9:30." ":" minute ampm))) (defun org-agenda-time-of-day-to-ampm-maybe (time) - "Conditionally convert TIME to AM/PM format -based on `org-agenda-timegrid-use-ampm'" + "Conditionally convert TIME to AM/PM format based on `org-agenda-timegrid-use-ampm'." (if org-agenda-timegrid-use-ampm (org-agenda-time-of-day-to-ampm time) time)) @@ -1164,7 +1274,7 @@ shown, either today or the nearest into the future." (const :tag "Don't show repeating stamps" nil))) (defcustom org-scheduled-past-days 10000 - "No. of days to continue listing scheduled items that are not marked DONE. + "Number of days to continue listing scheduled items not marked DONE. When an item is scheduled on a date, it shows up in the agenda on this day and will be listed until it is marked done for the number of days given here." @@ -1294,9 +1404,8 @@ boolean search." :version "24.1" :type 'boolean) -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-search-view-search-words-only - 'org-agenda-search-view-always-boolean)) +(org-defvaralias 'org-agenda-search-view-search-words-only + 'org-agenda-search-view-always-boolean) (defcustom org-agenda-search-view-force-full-words nil "Non-nil means, search words must be matches as complete words. @@ -1305,6 +1414,15 @@ When nil, they may also match part of a word." :version "24.1" :type 'boolean) +(defcustom org-agenda-search-view-max-outline-level nil + "Maximum outline level to display in search view. +E.g. when this is set to 1, the search view will only +show headlines of level 1." + :group 'org-agenda-search-view + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + (defgroup org-agenda-time-grid nil "Options concerning the time grid in the Org-mode Agenda." :tag "Org Agenda Time Grid" @@ -1393,6 +1511,16 @@ symbols are recognized: time-up Put entries with time-of-day indications first, early first time-down Put entries with time-of-day indications first, late first +timestamp-up Sort by any timestamp, early first +timestamp-down Sort by any timestamp, late first +scheduled-up Sort by scheduled timestamp, early first +scheduled-down Sort by scheduled timestamp, late first +deadline-up Sort by deadline timestamp, early first +deadline-down Sort by deadline timestamp, late first +ts-up Sort by active timestamp, early first +ts-down Sort by active timestamp, late first +tsia-up Sort by inactive timestamp, early first +tsia-down Sort by inactive timestamp, late first category-keep Keep the default order of categories, corresponding to the sequence in `org-agenda-files'. category-up Sort alphabetically by category, A-Z. @@ -1493,15 +1621,17 @@ This format works similar to a printf format, with the following meaning: %c the category of the item, \"Diary\" for entries from the diary, or as given by the CATEGORY keyword or derived from the file name %e the effort required by the item + %l the level of the item (insert X space(s) if item is of level X) %i the icon category of the item, see `org-agenda-category-icon-alist' %T the last tag of the item (ignore inherited tags, which come first) %t the HH:MM time-of-day specification if one applies to the entry %s Scheduling/Deadline information, a short string + %b show breadcrumbs, i.e., the names of the higher levels %(expression) Eval EXPRESSION and replace the control string by the result All specifiers work basically like the standard `%s' of printf, but may -contain two additional characters: a question mark just after the `%' +contain two additional characters: a question mark just after the `%' and a whitespace/punctuation character just before the final letter. If the first character after `%' is a question mark, the entire field @@ -1511,11 +1641,11 @@ present, but zero width when absent. For example, \"%?-12t\" will result in a 12 character time field if a time of the day is specified, but will completely disappear in entries which do not contain a time. -If there is punctuation or whitespace character just before the final -format letter, this character will be appended to the field value if -the value is not empty. For example, the format \"%-12:c\" leads to -\"Diary: \" if the category is \"Diary\". If the category were be -empty, no additional colon would be inserted. +If there is punctuation or whitespace character just before the +final format letter, this character will be appended to the field +value if the value is not empty. For example, the format +\"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If +the category is empty, no additional colon is inserted. The default value for the agenda sublist is \" %-12:c%?-12t% s\", which means: @@ -1588,6 +1718,8 @@ this item is scheduled, due to automatic rescheduling of unfinished items for the following day. So this number is one larger than the number of days that passed since this item was scheduled first." :group 'org-agenda-line-format + :version "24.4" + :package-version '(Org . "8.0") :type '(list (string :tag "Scheduled today ") (string :tag "Scheduled previously"))) @@ -1601,13 +1733,15 @@ These entries are added to the agenda when pressing \"[\"." (string :tag "Scheduled today ") (string :tag "Scheduled previously"))) -(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ") +(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ") "Text preceding deadline items in the agenda view. -This is a list with two strings. The first applies when the item has its -deadline on the current day. The second applies when it is in the past or -in the future, it may contain %d to capture how many days away the deadline -is (was)." +This is a list with three strings. The first applies when the item has its +deadline on the current day. The second applies when the deadline is in the +future, the third one when it is in the past. The strings may contain %d +to capture the number of days." :group 'org-agenda-line-format + :version "24.4" + :package-version '(Org . "8.0") :type '(list (string :tag "Deadline today ") (choice :tag "Deadline relative" @@ -1716,9 +1850,8 @@ When this is the symbol `prefix', only remove tags when (const :tag "Never" nil) (const :tag "When prefix format contains %T" prefix))) -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-remove-tags-when-in-prefix - 'org-agenda-remove-tags)) +(org-defvaralias 'org-agenda-remove-tags-when-in-prefix + 'org-agenda-remove-tags) (defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80) "Shift tags in agenda items to this column. @@ -1728,8 +1861,7 @@ it means that the tags should be flushright to that column. For example, :group 'org-agenda-line-format :type 'integer) -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)) +(org-defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) (defcustom org-agenda-fontify-priorities 'cookies "Non-nil means highlight low and high priorities in agenda. @@ -1887,8 +2019,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (defvar org-agenda-mode-map (make-sparse-keymap) "Keymap for `org-agenda-mode'.") -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-keymap 'org-agenda-mode-map)) +(org-defvaralias 'org-agenda-keymap 'org-agenda-mode-map) (defvar org-agenda-menu) ; defined later in this file. (defvar org-agenda-restrict nil) ; defined later in this file. @@ -1956,12 +2087,14 @@ When nil, `q' will kill the single agenda buffer." org-agenda-bulk-marked-entries org-agenda-undo-has-started-in org-agenda-info - org-agenda-tag-filter-overlays - org-agenda-cat-filter-overlays org-agenda-pre-window-conf org-agenda-columns-active + org-agenda-tag-filter-overlays org-agenda-tag-filter + org-agenda-cat-filter-overlays org-agenda-category-filter + org-agenda-re-filter-overlays + org-agenda-regexp-filter org-agenda-markers org-agenda-last-search-view-search-was-boolean org-agenda-filtered-by-category @@ -2015,10 +2148,10 @@ The following commands are available: (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) ;; Make sure properties are removed when copying text - (make-local-variable 'filter-buffer-substring-functions) - (add-hook 'filter-buffer-substring-functions - (lambda (fun start end delete) - (substring-no-properties (funcall fun start end delete)))) + (org-add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (substring-no-properties (funcall fun start end delete))) + nil t) (unless org-agenda-keep-modes (setq org-agenda-follow-mode org-agenda-start-with-follow-mode org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode @@ -2049,8 +2182,12 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to) (org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) (org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile) +(org-defkey org-agenda-mode-map [(meta down)] 'org-agenda-drag-line-forward) +(org-defkey org-agenda-mode-map [(meta up)] 'org-agenda-drag-line-backward) (org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark) +(org-defkey org-agenda-mode-map "\M-m" 'org-agenda-bulk-toggle) (org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all) +(org-defkey org-agenda-mode-map "\M-*" 'org-agenda-bulk-toggle-all) (org-defkey org-agenda-mode-map "#" 'org-agenda-dim-blocked-tasks) (org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp) (org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark) @@ -2164,9 +2301,12 @@ The following commands are available: (org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re) (org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re) (org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag) +(org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp) +(org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all) (org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine) +(org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively) (org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category) -(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-category) +(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline) (org-defkey org-agenda-mode-map ";" 'org-timer-set-timer) (define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note) (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) @@ -2263,9 +2403,11 @@ The following commands are available: ("Bulk action" ["Mark entry" org-agenda-bulk-mark t] ["Mark all" org-agenda-bulk-mark-all t] - ["Mark matching regexp" org-agenda-bulk-mark-regexp t] ["Unmark entry" org-agenda-bulk-unmark t] - ["Unmark all entries" org-agenda-bulk-unmark-all :active t :keys "U"]) + ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"] + ["Toggle mark" org-agenda-bulk-toggle t] + ["Toggle all" org-agenda-bulk-toggle-all t] + ["Mark regexp" org-agenda-bulk-mark-regexp t]) ["Act on all marked" org-agenda-bulk-action t] "--" ("Tags and Properties" @@ -2307,7 +2449,7 @@ The following commands are available: ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)] ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)] "--" - ["Create iCalendar File" org-export-icalendar-combine-agenda-files t]) + ["Create iCalendar File" org-icalendar-combine-agenda-files t]) "--" ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list] "--" @@ -2336,12 +2478,12 @@ This undoes changes both in the agenda buffer and in the remote buffer that have been changed along." (interactive) (or org-agenda-allow-remote-undo - (error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo")) + (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo")) (if (not (eq this-command last-command)) (setq org-agenda-undo-has-started-in nil org-agenda-pending-undo-list org-agenda-undo-list)) (if (not org-agenda-pending-undo-list) - (error "No further undo information")) + (user-error "No further undo information")) (let* ((entry (pop org-agenda-pending-undo-list)) buf line cmd rembuf) (setq cmd (pop entry) line (pop entry)) @@ -2392,6 +2534,8 @@ Here are the available contexts definitions: in-mode: command displayed only in matching modes not-in-file: command not displayed in matching files not-in-mode: command not displayed in matching modes + in-buffer: command displayed only in matching buffers +not-in-buffer: command not displayed in matching buffers [function]: a custom function taking no argument If you define several checks, the agenda command will be @@ -2417,11 +2561,89 @@ duplicates.)" (choice (const :tag "In file" in-file) (const :tag "Not in file" not-in-file) + (const :tag "In buffer" in-buffer) + (const :tag "Not in buffer" not-in-buffer) (const :tag "In mode" in-mode) (const :tag "Not in mode" not-in-mode)) (regexp)) (function :tag "Custom function")))))) +(defcustom org-agenda-max-entries nil + "Maximum number of entries to display in an agenda. +This can be nil (no limit) or an integer or an alist of agenda +types with an associated number of entries to display in this +type." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda-custom-commands + :type '(choice (symbol :tag "No limit" nil) + (integer :tag "Max number of entries") + (repeat + (cons (choice :tag "Agenda type" + (const agenda) + (const todo) + (const tags) + (const search) + (const timeline)) + (integer :tag "Max number of entries"))))) + +(defcustom org-agenda-max-todos nil + "Maximum number of TODOs to display in an agenda. +This can be nil (no limit) or an integer or an alist of agenda +types with an associated number of entries to display in this +type." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda-custom-commands + :type '(choice (symbol :tag "No limit" nil) + (integer :tag "Max number of entries") + (repeat + (cons (choice :tag "Agenda type" + (const agenda) + (const todo) + (const tags) + (const search) + (const timeline)) + (integer :tag "Max number of entries"))))) + +(defcustom org-agenda-max-tags nil + "Maximum number of tagged entries to display in an agenda. +This can be nil (no limit) or an integer or an alist of agenda +types with an associated number of entries to display in this +type." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda-custom-commands + :type '(choice (symbol :tag "No limit" nil) + (integer :tag "Max number of entries") + (repeat + (cons (choice :tag "Agenda type" + (const agenda) + (const todo) + (const tags) + (const search) + (const timeline)) + (integer :tag "Max number of entries"))))) + +(defcustom org-agenda-max-effort nil + "Maximum cumulated effort duration for the agenda. +This can be nil (no limit) or a number of minutes (as an integer) +or an alist of agenda types with an associated number of minutes +to limit entries to in this type." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda-custom-commands + :type '(choice (symbol :tag "No limit" nil) + (integer :tag "Max number of entries") + (repeat + (cons (choice :tag "Agenda type" + (const agenda) + (const todo) + (const tags) + (const search) + (const timeline)) + (integer :tag "Max number of entries"))))) + (defvar org-keys nil) (defvar org-match nil) ;;;###autoload @@ -2541,6 +2763,8 @@ Pressing `<' twice means to restrict to the current subtree or region (cond ((eq type 'agenda) (org-let lprops '(org-agenda-list current-prefix-arg))) + ((eq type 'agenda*) + (org-let lprops '(org-agenda-list current-prefix-arg nil nil t))) ((eq type 'alltodo) (org-let lprops '(org-todo-list current-prefix-arg))) ((eq type 'search) @@ -2569,7 +2793,7 @@ Pressing `<' twice means to restrict to the current subtree or region (org-let lprops '(funcall type org-match))) ((fboundp type) (org-let lprops '(funcall type org-match))) - (t (error "Invalid custom agenda command type %s" type)))) + (t (user-error "Invalid custom agenda command type %s" type)))) (org-agenda-run-series (nth 1 entry) (cddr entry)))) ((equal org-keys "C") (setq org-agenda-custom-commands org-agenda-custom-commands-orig) @@ -2600,14 +2824,14 @@ Pressing `<' twice means to restrict to the current subtree or region t t)) ((equal org-keys "L") (unless (derived-mode-p 'org-mode) - (error "This is not an Org-mode file")) + (user-error "This is not an Org-mode file")) (unless restriction (put 'org-agenda-files 'org-restrict (list bfn)) (org-call-with-arg 'org-timeline arg))) ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects)) ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files)) ((equal org-keys "!") (customize-variable 'org-stuck-projects)) - (t (error "Invalid agenda key")))))) + (t (user-error "Invalid agenda key")))))) (defun org-agenda-append-agenda () "Append another agenda view to the current one. @@ -2615,14 +2839,16 @@ This function allows interactive building of block agendas. Agenda views are separated by `org-agenda-block-separator'." (interactive) (unless (derived-mode-p 'org-agenda-mode) - (error "Can only append from within agenda buffer")) + (user-error "Can only append from within agenda buffer")) (let ((org-agenda-multi t)) (org-agenda) (widen) (org-agenda-finalize) + (setq buffer-read-only t) (org-agenda-fit-window-to-buffer))) (defun org-agenda-normalize-custom-commands (cmds) + "Normalize custom commands CMDS." (delq nil (mapcar (lambda (x) @@ -2697,6 +2923,7 @@ L Timeline for current buffer # List stuck projects (!=configure) (cond ((string-match "\\S-" desc) desc) ((eq type 'agenda) "Agenda for current week or day") + ((eq type 'agenda*) "Appointments for current week or day") ((eq type 'alltodo) "List of all TODO entries") ((eq type 'search) "Word search") ((eq type 'stuck) "List of stuck projects") @@ -2820,7 +3047,7 @@ L Timeline for current buffer # List stuck projects (!=configure) (org-agenda-get-restriction-and-command prefix-descriptions)) ((equal c ?q) (error "Abort")) - (t (error "Invalid key %c" c)))))))) + (t (user-error "Invalid key %c" c)))))))) (defun org-agenda-fit-window-to-buffer () "Fit the window to the buffer size." @@ -2836,6 +3063,7 @@ L Timeline for current buffer # List stuck projects (!=configure) (defvar org-agenda-overriding-arguments nil) (defvar org-agenda-overriding-cmd-arguments nil) (defun org-agenda-run-series (name series) + "Run agenda NAME as a SERIES of agenda commands." (org-let (nth 1 series) '(org-agenda-prepare name)) ;; We need to reset agenda markers here, because when constructing a ;; block agenda, the individual blocks do not do that. @@ -2858,6 +3086,9 @@ L Timeline for current buffer # List stuck projects (!=configure) ((eq type 'agenda) (org-let2 gprops lprops '(call-interactively 'org-agenda-list))) + ((eq type 'agenda*) + (org-let2 gprops lprops + '(funcall 'org-agenda-list nil nil t))) ((eq type 'alltodo) (org-let2 gprops lprops '(call-interactively 'org-todo-list))) @@ -3005,6 +3236,7 @@ This ensures the export commands can easily use it." ;;;###autoload (defun org-store-agenda-views (&rest parameters) + "Store agenda views." (interactive) (eval (list 'org-batch-store-agenda-views))) @@ -3060,10 +3292,12 @@ This ensures the export commands can easily use it." (defun org-agenda-write (file &optional open nosettings agenda-bufname) "Write the current buffer (an agenda view) as a file. Depending on the extension of the file name, plain text (.txt), -HTML (.html or .htm) or Postscript (.ps) is produced. +HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced. If the extension is .ics, run icalendar export over all files used to construct the agenda and limit the export to entries listed in the agenda now. +If the extension is .org, collect all subtrees corresponding to the +agenda entries and add them in an .org file. With prefix argument OPEN, open the new file immediately. If NOSETTINGS is given, do not scope the settings of `org-agenda-exporter-settings' into the export commands. This is used when @@ -3071,13 +3305,16 @@ the settings have already been scoped and we do not wish to overrule other, higher priority settings. If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." (interactive "FWrite agenda to file: \nP") - (if (not (file-writable-p file)) - (error "Cannot write agenda to file %s" file)) + (if (or (not (file-writable-p file)) + (and (file-exists-p file) + (if (called-interactively-p 'any) + (not (y-or-n-p (format "Overwrite existing file %s? " file)))))) + (user-error "Cannot write agenda to file %s" file)) (org-let (if nosettings nil org-agenda-exporter-settings) '(save-excursion (save-window-excursion (org-agenda-mark-filtered-text) - (let ((bs (copy-sequence (buffer-string))) beg) + (let ((bs (copy-sequence (buffer-string))) beg content) (org-agenda-unmark-filtered-text) (with-temp-buffer (rename-buffer org-agenda-write-buffer-name t) @@ -3093,6 +3330,25 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." (cond ((org-bound-and-true-p org-mobile-creating-agendas) (org-mobile-write-agenda-for-mobile file)) + ((string-match "\\.org\\'" file) + (let (content p m message-log-max) + (goto-char (point-min)) + (while (setq p (next-single-property-change (point) 'org-hd-marker nil)) + (goto-char p) + (setq m (get-text-property (point) 'org-hd-marker)) + (when m + (push (save-excursion + (set-buffer (marker-buffer m)) + (goto-char m) + (org-copy-subtree 1 nil t t) + org-subtree-clip) + content))) + (find-file file) + (erase-buffer) + (mapcar (lambda (s) (org-paste-subtree 1 s)) (reverse content)) + (write-file file) + (kill-buffer (current-buffer)) + (message "Org file written to %s" file))) ((string-match "\\.html?\\'" file) (require 'htmlize) (set-buffer (htmlize-buffer (current-buffer))) @@ -3120,14 +3376,8 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." (delete-file (concat (file-name-sans-extension file) ".ps")) (message "PDF written to %s" file)) ((string-match "\\.ics\\'" file) - (require 'org-icalendar) - (let ((org-agenda-marker-table - (org-create-marker-find-array - (org-agenda-collect-markers))) - (org-icalendar-verify-function 'org-check-agenda-marker-table) - (org-combined-agenda-icalendar-file file)) - (apply 'org-export-icalendar 'combine - (org-agenda-files nil 'ifmode)))) + (require 'ox-icalendar) + (org-icalendar-export-current-agenda (expand-file-name file))) (t (let ((bs (buffer-string))) (find-file file) @@ -3143,6 +3393,7 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." (defvar org-agenda-tag-filter-overlays nil) (defvar org-agenda-cat-filter-overlays nil) +(defvar org-agenda-re-filter-overlays nil) (defun org-agenda-mark-filtered-text () "Mark all text hidden by filtering with a text property." @@ -3154,7 +3405,8 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." (overlay-start o) (overlay-end o) 'org-filtered t))) (append org-agenda-tag-filter-overlays - org-agenda-cat-filter-overlays)))) + org-agenda-cat-filter-overlays + org-agenda-re-filter-overlays)))) (defun org-agenda-unmark-filtered-text () "Remove the filtering text property." @@ -3278,43 +3530,6 @@ removed from the entry content. Currently only `planning' is allowed here." (setq txt (buffer-substring (point-min) (point))))))))) txt)) -(defun org-agenda-collect-markers () - "Collect the markers pointing to entries in the agenda buffer." - (let (m markers) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (when (setq m (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker))) - (push m markers)) - (beginning-of-line 2))) - (nreverse markers))) - -(defun org-create-marker-find-array (marker-list) - "Create a alist of files names with all marker positions in that file." - (let (f tbl m a p) - (while (setq m (pop marker-list)) - (setq p (marker-position m) - f (buffer-file-name (or (buffer-base-buffer - (marker-buffer m)) - (marker-buffer m)))) - (if (setq a (assoc f tbl)) - (push (marker-position m) (cdr a)) - (push (list f p) tbl))) - (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x) - tbl))) - -(defvar org-agenda-marker-table nil) ; dynamically scoped parameter -(defun org-check-agenda-marker-table () - "Check of the current entry is on the marker list." - (let ((file (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) - a) - (and (setq a (assoc file org-agenda-marker-table)) - (save-match-data - (save-excursion - (org-back-to-heading t) - (member (point) (cdr a))))))) - (defun org-check-for-org-mode () "Make sure current buffer is in org-mode. Error if not." (or (derived-mode-p 'org-mode) @@ -3329,7 +3544,8 @@ removed from the entry content. Currently only `planning' is allowed here." (defvar org-agenda-name nil) (defvar org-agenda-tag-filter nil) (defvar org-agenda-category-filter nil) -(defvar org-agenda-top-category-filter nil) +(defvar org-agenda-regexp-filter nil) +(defvar org-agenda-top-headline-filter nil) (defvar org-agenda-tag-filter-while-redo nil) (defvar org-agenda-tag-filter-preset nil "A preset of the tags filter used for secondary agenda filtering. @@ -3351,6 +3567,15 @@ the entire agenda view. In a block agenda, it will not work reliably to define a filter for one of the individual blocks. You need to set it in the global options and expect it to be applied to the entire view.") +(defvar org-agenda-regexp-filter-preset nil + "A preset of the regexp filter used for secondary agenda filtering. +This must be a list of strings, each string must be a single category +preceded by \"+\" or \"-\". +This variable should not be set directly, but agenda custom commands can +bind it in the options section. The preset filter is a global property of +the entire agenda view. In a block agenda, it will not work reliably to +define a filter for one of the individual blocks. You need to set it in +the global options and expect it to be applied to the entire view.") (defun org-agenda-use-sticky-p () "Return non-nil if an agenda buffer named @@ -3409,11 +3634,14 @@ generating a new one." (setq org-drawers-for-agenda nil) (unless org-agenda-persistent-filter (setq org-agenda-tag-filter nil - org-agenda-category-filter nil)) + org-agenda-category-filter nil + org-agenda-regexp-filter nil)) (put 'org-agenda-tag-filter :preset-filter org-agenda-tag-filter-preset) (put 'org-agenda-category-filter :preset-filter org-agenda-category-filter-preset) + (put 'org-agenda-regexp-filter :preset-filter + org-agenda-regexp-filter-preset) (if org-agenda-multi (progn (setq buffer-read-only nil) @@ -3516,14 +3744,13 @@ generating a new one." (org-agenda-filter-apply org-agenda-tag-filter 'tag)) (when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter)) (org-agenda-filter-apply org-agenda-category-filter 'category)) + (when (or org-agenda-regexp-filter (get 'org-agenda-regexp-filter :preset-filter)) + (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)) (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local))))) (defun org-agenda-mark-clocking-task () "Mark the current clock entry in the agenda if it is present." - (mapc (lambda (o) - (if (eq (overlay-get o 'type) 'org-agenda-clocking) - (delete-overlay o))) - (overlays-in (point-min) (point-max))) + (org-agenda-unmark-clocking-task) (when (marker-buffer org-clock-hd-marker) (save-excursion (goto-char (point-min)) @@ -3538,6 +3765,13 @@ generating a new one." (overlay-put ov 'help-echo "The clock is running in this item"))))))) +(defun org-agenda-unmark-clocking-task () + "Unmark the current clocking task." + (mapc (lambda (o) + (if (eq (overlay-get o 'type) 'org-agenda-clocking) + (delete-overlay o))) + (overlays-in (point-min) (point-max)))) + (defun org-agenda-fontify-priorities () "Make highest priority lines bold, and lowest italic." (interactive) @@ -3545,8 +3779,7 @@ generating a new one." (delete-overlay o))) (overlays-in (point-min) (point-max))) (save-excursion - (let ((inhibit-read-only t) - b e p ov h l) + (let (b e p ov h l) (goto-char (point-min)) (while (re-search-forward "\\[#\\(.\\)\\]" nil t) (setq h (or (get-char-property (point) 'org-highest-priority) @@ -3561,21 +3794,25 @@ generating a new one." ov (make-overlay b e)) (overlay-put ov 'face - (cond ((org-face-from-face-or-color - 'priority nil - (cdr (assoc p org-priority-faces)))) - ((and (listp org-agenda-fontify-priorities) - (org-face-from-face-or-color - 'priority nil - (cdr (assoc p org-agenda-fontify-priorities))))) - ((equal p l) 'italic) - ((equal p h) 'bold))) + (cons (cond ((org-face-from-face-or-color + 'priority nil + (cdr (assoc p org-priority-faces)))) + ((and (listp org-agenda-fontify-priorities) + (org-face-from-face-or-color + 'priority nil + (cdr (assoc p org-agenda-fontify-priorities))))) + ((equal p l) 'italic) + ((equal p h) 'bold)) + 'org-priority)) (overlay-put ov 'org-type 'org-priority))))) (defun org-agenda-dim-blocked-tasks (&optional invisible) + "Dim currently blocked TODO's in the agenda display. +When INVISIBLE is non-nil, hide currently blocked TODO instead of +dimming them." (interactive "P") - "Dim currently blocked TODO's in the agenda display." - (message "Dim or hide blocked tasks...") + (when (org-called-interactively-p 'interactive) + (message "Dim or hide blocked tasks...")) (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo) (delete-overlay o))) (overlays-in (point-min) (point-max))) @@ -3605,7 +3842,8 @@ generating a new one." (overlay-put ov 'invisible t) (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) (overlay-put ov 'org-type 'org-blocked-todo)))))) - (message "Dim or hide blocked tasks...done")) + (when (org-called-interactively-p 'interactive) + (message "Dim or hide blocked tasks...done"))) (defvar org-agenda-skip-function nil "Function to be called at each match during agenda construction. @@ -3695,7 +3933,8 @@ This check for agenda markers in all agenda buffers currently active." (error "No marker points to an entry here")) (setq txt (concat "\n" (org-no-properties (org-agenda-get-some-entry-text - m org-agenda-entry-text-maxlines " > ")))) + m org-agenda-entry-text-maxlines + org-agenda-entry-text-leaders)))) (when (string-match "\\S-" txt) (setq o (make-overlay (point-at-bol) (point-at-eol))) (overlay-put o 'evaporate t) @@ -3746,6 +3985,7 @@ dates." (interactive "P") (let* ((dopast t) (org-agenda-show-log-scoped org-agenda-show-log) + (org-agenda-show-log org-agenda-show-log-scoped) (entry (buffer-file-name (or (buffer-base-buffer (current-buffer)) (current-buffer)))) (date (calendar-current-date)) @@ -3762,9 +4002,11 @@ dates." args s e rtn d emptyp) (setq org-agenda-redo-command - (list 'progn - (list 'org-switch-to-buffer-other-window (current-buffer)) - (list 'org-timeline (list 'quote dotodo)))) + (list 'let + (list (list 'org-agenda-show-log 'org-agenda-show-log)) + (list 'org-switch-to-buffer-other-window (current-buffer)) + (list 'org-timeline (list 'quote dotodo)))) + (put 'org-agenda-redo-command 'org-lprops nil) (if (not dopast) ;; Remove past dates from the list of dates. (setq day-numbers (delq nil (mapcar (lambda(x) @@ -3815,12 +4057,13 @@ dates." (put-text-property s (1- (point)) 'org-agenda-date-header t) (if (equal d today) (put-text-property s (1- (point)) 'org-today t)) - (and rtn (insert (org-agenda-finalize-entries rtn) "\n")) + (and rtn (insert (org-agenda-finalize-entries rtn 'timeline) "\n")) (put-text-property s (1- (point)) 'day d))))) - (goto-char (point-min)) (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) (point-min))) - (add-text-properties (point-min) (point-max) '(org-agenda-type timeline)) + (add-text-properties + (point-min) (point-max) + `(org-agenda-type timeline org-redo-cmd ,org-agenda-redo-command)) (org-agenda-finalize) (setq buffer-read-only t))) @@ -3874,46 +4117,16 @@ When EMPTY is non-nil, also include days without any entries." (defvar org-agenda-start-day nil ; dynamically scoped parameter "Start day for the agenda view. -Custom commands can set this variable in the options section.") +Custom commands can set this variable in the options section. +This is usually a string like \"2007-11-01\", \"+2d\" or any other +input allowed when reading a date through the Org calendar. +See the docstring of `org-read-date' for details.") (defvar org-starting-day nil) ; local variable in the agenda buffer (defvar org-arg-loc nil) ; local variable -(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) - "List of types searched for when creating the daily/weekly agenda. -This variable is a list of symbols that controls the types of -items that appear in the daily/weekly agenda. Allowed symbols in this -list are are - - :timestamp List items containing a date stamp or date range matching - the selected date. This includes sexp entries in - angular brackets. - - :sexp List entries resulting from plain diary-like sexps. - - :deadline List deadline due on that date. When the date is today, - also list any deadlines past due, or due within - `org-deadline-warning-days'. `:deadline' must appear before - `:scheduled' if the setting of - `org-agenda-skip-scheduled-if-deadline-is-shown' is to have - any effect. - - :scheduled List all items which are scheduled for the given date. - The diary for *today* also contains items which were - scheduled earlier and are not yet marked DONE. - -By default, all four types are turned on. - -Never set this variable globally using `setq', because then it -will apply to all future agenda commands. Instead, bind it with -`let' to scope it dynamically into the agenda-constructing -command. A good way to set it is through options in -`org-agenda-custom-commands'. For a more flexible (though -somewhat less efficient) way of determining what is included in -the daily/weekly agenda, see `org-agenda-skip-function'.") - (defvar org-agenda-buffer-tmp-name nil) ;;;###autoload -(defun org-agenda-list (&optional arg start-day span) +(defun org-agenda-list (&optional arg start-day span with-hour) "Produce a daily/weekly view from all files in variable `org-agenda-files'. The view will be for the current day or week, but from the overview buffer you will be able to go to other days/weeks. @@ -3923,7 +4136,10 @@ span ARG days. Lisp programs should instead specify SPAN to change the number of days. SPAN defaults to `org-agenda-span'. START-DAY defaults to TODAY, or to the most recent match for the weekday -given in `org-agenda-start-on-weekday'." +given in `org-agenda-start-on-weekday'. + +When WITH-HOUR is non-nil, only include scheduled and deadline +items if they have an hour specification like [h]h:mm." (interactive "P") (if org-agenda-overriding-arguments (setq arg (car org-agenda-overriding-arguments) @@ -3973,7 +4189,7 @@ given in `org-agenda-start-on-weekday'." s e rtn rtnall file date d start-pos end-pos todayp clocktable-start clocktable-end filter) (setq org-agenda-redo-command - (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span))) + (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour)) (dotimes (n (1- ndays)) (push (1+ (car day-numbers)) day-numbers)) (setq day-numbers (nreverse day-numbers)) @@ -4016,9 +4232,26 @@ given in `org-agenda-start-on-weekday'." (catch 'nextfile (org-check-agenda-file file) (let ((org-agenda-entry-types org-agenda-entry-types)) - (unless org-agenda-include-deadlines + ;; Starred types override non-starred equivalents + (when (member :deadline* org-agenda-entry-types) (setq org-agenda-entry-types (delq :deadline org-agenda-entry-types))) + (when (member :scheduled* org-agenda-entry-types) + (setq org-agenda-entry-types + (delq :scheduled org-agenda-entry-types))) + ;; Honor with-hour + (when with-hour + (when (member :deadline org-agenda-entry-types) + (setq org-agenda-entry-types + (delq :deadline org-agenda-entry-types)) + (push :deadline* org-agenda-entry-types)) + (when (member :scheduled org-agenda-entry-types) + (setq org-agenda-entry-types + (delq :scheduled org-agenda-entry-types)) + (push :scheduled* org-agenda-entry-types))) + (unless org-agenda-include-deadlines + (setq org-agenda-entry-types + (delq :deadline* (delq :deadline org-agenda-entry-types)))) (cond ((memq org-agenda-show-log-scoped '(only clockcheck)) (setq rtn (org-agenda-get-day-entries @@ -4056,7 +4289,7 @@ given in `org-agenda-start-on-weekday'." (setq rtnall (org-agenda-add-time-grid-maybe rtnall ndays todayp)) (if rtnall (insert ;; all entries - (org-agenda-finalize-entries rtnall) + (org-agenda-finalize-entries rtnall 'agenda) "\n")) (put-text-property s (1- (point)) 'day d) (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) @@ -4109,7 +4342,8 @@ given in `org-agenda-start-on-weekday'." (t n))) (defun org-agenda-span-to-ndays (span &optional start-day) - "Return ndays from SPAN, possibly starting at START-DAY." + "Return ndays from SPAN, possibly starting at START-DAY. +START-DAY is an absolute time value." (cond ((numberp span) span) ((eq span 'day) 1) ((eq span 'week) 7) @@ -4206,7 +4440,7 @@ in `org-agenda-text-search-extra-files'." (full-words org-agenda-search-view-force-full-words) (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) regexp rtn rtnall files file pos inherited-tags - marker category category-pos tags c neg re boolean + marker category category-pos level tags c neg re boolean ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) (unless (and (not edit-at) (stringp string) @@ -4334,10 +4568,23 @@ in `org-agenda-text-search-extra-files'." (goto-char (max (point-min) (1- (point)))) (while (re-search-forward regexp nil t) (org-back-to-heading t) + (while (and org-agenda-search-view-max-outline-level + (> (org-reduced-level (org-outline-level)) + org-agenda-search-view-max-outline-level) + (forward-line -1) + (outline-back-to-heading t))) (skip-chars-forward "* ") (setq beg (point-at-bol) beg1 (point) - end (progn (outline-next-heading) (point))) + end (progn + (outline-next-heading) + (while (and org-agenda-search-view-max-outline-level + (> (org-reduced-level (org-outline-level)) + org-agenda-search-view-max-outline-level) + (forward-line 1) + (outline-next-heading))) + (point))) + (catch :skip (goto-char beg) (org-agenda-skip) @@ -4358,6 +4605,7 @@ in `org-agenda-text-search-extra-files'." (goto-char beg) (setq marker (org-agenda-new-marker (point)) category (org-get-category) + level (make-string (org-reduced-level (org-outline-level)) ? ) category-pos (get-text-property (point) 'org-category-position) inherited-tags (or (eq org-agenda-show-inherited-tags 'always) @@ -4371,10 +4619,11 @@ in `org-agenda-text-search-extra-files'." "" (buffer-substring-no-properties beg1 (point-at-eol)) - category tags t)) + level category tags t)) (org-add-props txt props 'org-marker marker 'org-hd-marker marker 'org-todo-regexp org-todo-regexp + 'level level 'org-complex-heading-regexp org-complex-heading-regexp 'priority 1000 'org-category category 'org-category-position category-pos @@ -4399,7 +4648,7 @@ in `org-agenda-text-search-extra-files'." (list 'face 'org-agenda-structure)))) (org-agenda-mark-header-line (point-min)) (when rtnall - (insert (org-agenda-finalize-entries rtnall) "\n")) + (insert (org-agenda-finalize-entries rtnall 'search) "\n")) (goto-char (point-min)) (or org-agenda-multi (org-agenda-fit-window-to-buffer)) (add-text-properties (point-min) (point-max) @@ -4412,6 +4661,18 @@ in `org-agenda-text-search-extra-files'." ;;; Agenda TODO list +(defun org-agenda-propertize-selected-todo-keywords (keywords) + "Use `org-todo-keyword-faces' for the selected todo KEYWORDS." + (concat + (if (or (equal keywords "ALL") (not keywords)) + (propertize "ALL" 'face 'warning) + (mapconcat + (lambda (kw) + (propertize kw 'face (org-get-todo-face kw))) + (org-split-string keywords "|") + "|")) + "\n")) + (defvar org-select-this-todo-keyword nil) (defvar org-last-arg nil) @@ -4472,9 +4733,8 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (concat "ToDo: " (or org-select-this-todo-keyword "ALL")))) (org-agenda-mark-header-line (point-min)) - (setq pos (point)) - (insert (or org-select-this-todo-keyword "ALL") "\n") - (add-text-properties pos (1- (point)) (list 'face 'org-warning)) + (insert (org-agenda-propertize-selected-todo-keywords + org-select-this-todo-keyword)) (setq pos (point)) (unless org-agenda-multi (insert "Available with `N r': (0)[ALL]") @@ -4489,7 +4749,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) (org-agenda-mark-header-line (point-min)) (when rtnall - (insert (org-agenda-finalize-entries rtnall) "\n")) + (insert (org-agenda-finalize-entries rtnall 'todo) "\n")) (goto-char (point-min)) (or org-agenda-multi (org-agenda-fit-window-to-buffer)) (add-text-properties (point-min) (point-max) @@ -4517,8 +4777,6 @@ The prefix arg TODO-ONLY limits the search to TODO entries." buffer) (when (and (stringp match) (not (string-match "\\S-" match))) (setq match nil)) - (setq matcher (org-make-tags-matcher match) - match (car matcher) matcher (cdr matcher)) (catch 'exit (if org-agenda-sticky (setq org-agenda-buffer-name @@ -4526,7 +4784,11 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (format "*Org Agenda(%s:%s)*" (or org-keys (or (and todo-only "M") "m")) match) (format "*Org Agenda(%s)*" (or (and todo-only "M") "m"))))) + ;; Prepare agendas (and `org-tag-alist-for-agenda') before + ;; expanding tags within `org-make-tags-matcher' (org-agenda-prepare (concat "TAGS " match)) + (setq matcher (org-make-tags-matcher match) + match (car matcher) matcher (cdr matcher)) (org-compile-prefix-format 'tags) (org-set-sorting-strategy 'tags) (setq org-agenda-query-string match) @@ -4574,7 +4836,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) (org-agenda-mark-header-line (point-min)) (when rtnall - (insert (org-agenda-finalize-entries rtnall) "\n")) + (insert (org-agenda-finalize-entries rtnall 'tags) "\n")) (goto-char (point-min)) (or org-agenda-multi (org-agenda-fit-window-to-buffer)) (add-text-properties (point-min) (point-max) @@ -4863,7 +5125,7 @@ of what a project is and how to check if it stuck, customize the variable (setq entries (mapcar (lambda (x) - (setq x (org-agenda-format-item "" x "Diary" nil 'time)) + (setq x (org-agenda-format-item "" x nil "Diary" nil 'time)) ;; Extend the text properties to the beginning of the line (org-add-props x (text-properties-at (1- (length x)) x) 'type "diary" 'date date 'face 'org-agenda-diary)) @@ -4953,8 +5215,8 @@ all files listed in `org-agenda-files' will be checked automatically: &%%(org-diary) -If you don't give any arguments (as in the example above), the default -arguments (:deadline :scheduled :timestamp :sexp) are used. +If you don't give any arguments (as in the example above), the default value +of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp). So the example above may also be written as &%%(org-diary :deadline :timestamp :sexp :scheduled) @@ -4970,7 +5232,7 @@ function from a program - use `org-agenda-get-day-entries' instead." (org-agenda-reset-markers)) (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) - (setq args (or args '(:deadline :scheduled :timestamp :sexp))) + (setq args (or args org-agenda-entry-types)) (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) (list entry) (org-agenda-files t))) @@ -4988,8 +5250,11 @@ function from a program - use `org-agenda-get-day-entries' instead." (while (setq file (pop files)) (setq rtn (apply 'org-agenda-get-day-entries file date args)) (setq results (append results rtn))) - (if results - (concat (org-agenda-finalize-entries results) "\n")))) + (when results + (setq results + (mapcar (lambda (i) (replace-regexp-in-string + org-bracket-link-regexp "\\3" i)) results)) + (concat (org-agenda-finalize-entries results) "\n")))) ;;; Agenda entry finders @@ -4999,7 +5264,7 @@ FILE is the path to a file to be checked for entries. DATE is date like the one returned by `calendar-current-date'. ARGS are symbols indicating which kind of entries should be extracted. For details about these, see the documentation of `org-diary'." - (setq args (or args '(:deadline :scheduled :timestamp :sexp))) + (setq args (or args org-agenda-entry-types)) (let* ((org-startup-folded nil) (org-startup-align-all-tables nil) (buffer (if (file-exists-p file) @@ -5039,16 +5304,29 @@ the documentation of `org-diary'." ((eq arg :scheduled) (setq rtn (org-agenda-get-scheduled deadline-results)) (setq results (append results rtn))) + ((eq arg :scheduled*) + (setq rtn (org-agenda-get-scheduled deadline-results t)) + (setq results (append results rtn))) ((eq arg :closed) (setq rtn (org-agenda-get-progress)) (setq results (append results rtn))) ((eq arg :deadline) (setq rtn (org-agenda-get-deadlines)) (setq deadline-results (copy-sequence rtn)) + (setq results (append results rtn))) + ((eq arg :deadline*) + (setq rtn (org-agenda-get-deadlines t)) + (setq deadline-results (copy-sequence rtn)) (setq results (append results rtn)))))))) results)))) +(defsubst org-em (x y list) + "Is X or Y a member of LIST?" + (or (memq x list) (memq y list))) + (defvar org-heading-keyword-regexp-format) ; defined in org.el +(defvar org-agenda-sorting-strategy-selected nil) + (defun org-agenda-get-todos () "Return the TODO information for agenda display." (let* ((props (list 'face nil @@ -5073,8 +5351,8 @@ the documentation of `org-diary'." "|") "\\|") "\\)")) (t org-not-done-regexp)))) - marker priority category category-pos tags todo-state - ee txt beg end inherited-tags) + marker priority category category-pos level tags todo-state ts-date ts-date-type + ee txt beg end inherited-tags todo-state-end-pos) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -5082,6 +5360,10 @@ the documentation of `org-diary'." (beginning-of-line) (org-agenda-skip) (setq beg (point) end (save-excursion (outline-next-heading) (point))) + (unless (and (setq todo-state (org-get-todo-state)) + (setq todo-state-end-pos (match-end 2))) + (goto-char end) + (throw :skip nil)) (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end) (goto-char (1+ beg)) (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) @@ -5089,6 +5371,33 @@ the documentation of `org-diary'." (goto-char (match-beginning 2)) (setq marker (org-agenda-new-marker (match-beginning 0)) category (org-get-category) + ts-date (let (ts) + (save-match-data + (cond ((org-em 'scheduled-up 'scheduled-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get (point) "SCHEDULED") + ts-date-type " scheduled")) + ((org-em 'deadline-up 'deadline-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get (point) "DEADLINE") + ts-date-type " deadline")) + ((org-em 'ts-up 'ts-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get (point) "TIMESTAMP") + ts-date-type " timestamp")) + ((org-em 'tsia-up 'tsia-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get (point) "TIMESTAMP_IA") + ts-date-type " timestamp_ia")) + ((org-em 'timestamp-up 'timestamp-down + org-agenda-sorting-strategy-selected) + (setq ts (or (org-entry-get (point) "SCHEDULED") + (org-entry-get (point) "DEADLINE") + (org-entry-get (point) "TIMESTAMP") + (org-entry-get (point) "TIMESTAMP_IA")) + ts-date-type "")) + (t (setq ts-date-type ""))) + (when ts (ignore-errors (org-time-string-to-absolute ts))))) category-pos (get-text-property (point) 'org-category-position) txt (org-trim (buffer-substring (match-beginning 2) (match-end 0))) @@ -5100,17 +5409,19 @@ the documentation of `org-diary'." (or (eq org-agenda-use-tag-inheritance t) (memq 'todo org-agenda-use-tag-inheritance)))) tags (org-get-tags-at nil (not inherited-tags)) - txt (org-agenda-format-item "" txt category tags t) - priority (1+ (org-get-priority txt)) - todo-state (org-get-todo-state)) + level (make-string (org-reduced-level (org-outline-level)) ? ) + txt (org-agenda-format-item "" txt level category tags t) + priority (1+ (org-get-priority txt))) (org-add-props txt props 'org-marker marker 'org-hd-marker marker 'priority priority 'org-category category + 'level level + 'ts-date ts-date 'org-category-position category-pos - 'type "todo" 'todo-state todo-state) + 'type (concat "todo" ts-date-type) 'todo-state todo-state) (push txt ee) (if org-agenda-todo-list-sublevels - (goto-char (match-end 2)) + (goto-char todo-state-end-pos) (org-end-of-subtree 'invisible)))) (nreverse ee))) @@ -5119,7 +5430,8 @@ the documentation of `org-diary'." This function is invoked if `org-agenda-todo-ignore-deadlines', `org-agenda-todo-ignore-scheduled' or `org-agenda-todo-ignore-timestamp' is set to an integer." - (let ((days (org-days-to-time time))) + (let ((days (org-time-stamp-to-now + time org-agenda-todo-ignore-time-comparison-use-seconds))) (if (>= n 0) (>= days n) (<= days n)))) @@ -5139,9 +5451,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (re-search-forward org-scheduled-time-regexp end t) (cond ((eq org-agenda-todo-ignore-scheduled 'future) - (> (org-days-to-time (match-string 1)) 0)) + (> (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) ((eq org-agenda-todo-ignore-scheduled 'past) - (<= (org-days-to-time (match-string 1)) 0)) + (<= (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) ((numberp org-agenda-todo-ignore-scheduled) (org-agenda-todo-custom-ignore-p (match-string 1) org-agenda-todo-ignore-scheduled)) @@ -5153,9 +5467,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', ((eq org-agenda-todo-ignore-deadlines 'far) (not (org-deadline-close (match-string 1)))) ((eq org-agenda-todo-ignore-deadlines 'future) - (> (org-days-to-time (match-string 1)) 0)) + (> (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) ((eq org-agenda-todo-ignore-deadlines 'past) - (<= (org-days-to-time (match-string 1)) 0)) + (<= (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) ((numberp org-agenda-todo-ignore-deadlines) (org-agenda-todo-custom-ignore-p (match-string 1) org-agenda-todo-ignore-deadlines)) @@ -5178,9 +5494,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (when (re-search-forward org-ts-regexp nil t) (cond ((eq org-agenda-todo-ignore-timestamp 'future) - (> (org-days-to-time (match-string 1)) 0)) + (> (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) ((eq org-agenda-todo-ignore-timestamp 'past) - (<= (org-days-to-time (match-string 1)) 0)) + (<= (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) ((numberp org-agenda-todo-ignore-timestamp) (org-agenda-todo-custom-ignore-p (match-string 1) org-agenda-todo-ignore-timestamp)) @@ -5217,9 +5535,9 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) marker hdmarker deadlinep scheduledp clockp closedp inactivep - donep tmp priority category category-pos ee txt timestr tags + donep tmp priority category category-pos level ee txt timestr tags b0 b3 e3 head todo-state end-of-match show-all warntime habitp - inherited-tags) + inherited-tags ts-date) (goto-char (point-min)) (while (setq end-of-match (re-search-forward regexp nil t)) (setq b0 (match-beginning 0) @@ -5278,18 +5596,21 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (and (eq org-agenda-show-inherited-tags t) (or (eq org-agenda-use-tag-inheritance t) (memq 'agenda org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at nil (not inherited-tags))) + tags (org-get-tags-at nil (not inherited-tags)) + level (make-string (org-reduced-level (org-outline-level)) ? )) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq head (or (match-string 1) "")) (setq txt (org-agenda-format-item (if inactivep org-agenda-inactive-leader nil) - head category tags timestr + head level category tags timestr remove-re habitp))) (setq priority (org-get-priority txt)) - (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker) - (org-add-props txt nil 'priority priority + (org-add-props txt props 'priority priority + 'org-marker marker 'org-hd-marker hdmarker 'org-category category 'date date + 'level level + 'ts-date + (ignore-errors (org-time-string-to-absolute timestr)) 'org-category-position category-pos 'todo-state todo-state 'warntime warntime @@ -5309,7 +5630,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) (regexp "^&?%%(") - marker category extra category-pos ee txt tags entry + marker category extra category-pos level ee txt tags entry result beg b sexp sexp-entry todo-state warntime inherited-tags) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5326,6 +5647,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (setq result (org-diary-sexp-entry sexp sexp-entry date)) (when result (setq marker (org-agenda-new-marker beg) + level (make-string (org-reduced-level (org-outline-level)) ? ) category (org-get-category beg) category-pos (get-text-property beg 'org-category-position) inherited-tags @@ -5350,13 +5672,11 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (if (string-match "\\S-" r) (setq txt r) (setq txt "SEXP entry returned empty string")) - - (setq txt (org-agenda-format-item - extra txt category tags 'time)) - (org-add-props txt props 'org-marker marker) - (org-add-props txt nil + (setq txt (org-agenda-format-item extra txt level category tags 'time)) + (org-add-props txt props 'org-marker marker 'org-category category 'date date 'todo-state todo-state 'org-category-position category-pos 'tags tags + 'level level 'type "sexp" 'warntime warntime) (push txt ee))))) (nreverse ee))) @@ -5394,10 +5714,12 @@ DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS is any number of ISO weeks in the block period for which the item should be skipped. If any of the SKIP-WEEKS arguments is the symbol `holidays', then any date that is known by the Emacs calendar to be a -holiday will also be skipped." +holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings, +then those holidays will be skipped." (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1))) (date2 (calendar-absolute-from-gregorian (list m2 d2 y2))) - (d (calendar-absolute-from-gregorian date))) + (d (calendar-absolute-from-gregorian date)) + (h (when skip-weeks (calendar-check-holidays date)))) (and (<= date1 d) (<= d date2) @@ -5406,8 +5728,8 @@ holiday will also be skipped." (progn (require 'cal-iso) (not (member (car (calendar-iso-from-absolute d)) skip-weeks)))) - (not (and (memq 'holidays skip-weeks) - (calendar-check-holidays date))) + (not (or (and h (memq 'holidays skip-weeks)) + (delq nil (mapcar (lambda(g) (member g skip-weeks)) h)))) entry))) (defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks) @@ -5465,7 +5787,7 @@ please use `org-class' instead." (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 1 11)))) (org-agenda-search-headline-for-time nil) - marker hdmarker priority category category-pos tags closedp + marker hdmarker priority category category-pos level tags closedp statep clockp state ee txt extra timestr rest clocked inherited-tags) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5511,7 +5833,8 @@ please use `org-class' instead." (and (eq org-agenda-show-inherited-tags t) (or (eq org-agenda-use-tag-inheritance t) (memq 'todo org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at nil (not inherited-tags))) + tags (org-get-tags-at nil (not inherited-tags)) + level (make-string (org-reduced-level (org-outline-level)) ? )) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq txt (match-string 1)) (when extra @@ -5524,12 +5847,13 @@ please use `org-class' instead." (closedp "Closed: ") (statep (concat "State: (" state ")")) (t (concat "Clocked: (" clocked ")"))) - txt category tags timestr))) + txt level category tags timestr))) (setq priority 100000) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done 'priority priority 'org-category category 'org-category-position category-pos + 'level level 'type "closed" 'date date 'undone-face 'org-warning 'done-face 'org-agenda-done) (push txt ee)) @@ -5540,7 +5864,8 @@ please use `org-class' instead." "Add overlays, showing issues with clocking. See also the user option `org-agenda-clock-consistency-checks'." (interactive) - (let* ((pl org-agenda-clock-consistency-checks) + (let* ((org-time-clocksum-use-effort-durations nil) + (pl org-agenda-clock-consistency-checks) (re (concat "^[ \t]*" org-clock-string "[ \t]+" @@ -5589,13 +5914,13 @@ See also the user option `org-agenda-clock-consistency-checks'." ((> dt (* 60 maxtime)) ;; a very long clocking chunk (setq issue (format "Clocking interval is very long: %s" - (org-minutes-to-hh:mm-string + (org-minutes-to-clocksum-string (floor (/ (float dt) 60.)))) face (or (plist-get pl :long-face) face))) ((< dt (* 60 mintime)) ;; a very short clocking chunk (setq issue (format "Clocking interval is very short: %s" - (org-minutes-to-hh:mm-string + (org-minutes-to-clocksum-string (floor (/ (float dt) 60.)))) face (or (plist-get pl :short-face) face))) ((and (> tlend 0) (< ts tlend)) @@ -5655,8 +5980,10 @@ See also the user option `org-agenda-clock-consistency-checks'." ;; Nope, this gap is not OK nil))) -(defun org-agenda-get-deadlines () - "Return the deadline information for agenda display." +(defun org-agenda-get-deadlines (&optional with-hour) + "Return the deadline information for agenda display. +When WITH-HOUR is non-nil, only return deadlines with an hour +specification like [h]h:mm." (let* ((props (list 'mouse-face 'highlight 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp @@ -5664,26 +5991,21 @@ See also the user option `org-agenda-clock-consistency-checks'." 'help-echo (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) - (regexp org-deadline-time-regexp) + (regexp (if with-hour + org-deadline-time-hour-regexp + org-deadline-time-regexp)) (todayp (org-agenda-todayp date)) ; DATE bound by calendar - (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar - d2 diff dfrac wdays pos pos1 category category-pos + (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar + (dl0 (car org-agenda-deadline-leaders)) + (dl1 (nth 1 org-agenda-deadline-leaders)) + (dl2 (or (nth 2 org-agenda-deadline-leaders) dl1)) + d2 diff dfrac wdays pos pos1 category category-pos level tags suppress-prewarning ee txt head face s todo-state - show-all upcomingp donep timestr warntime inherited-tags) + show-all upcomingp donep timestr warntime inherited-tags ts-date) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (setq suppress-prewarning nil) (catch :skip (org-agenda-skip) - (when (and org-agenda-skip-deadline-prewarning-if-scheduled - (save-match-data - (string-match org-scheduled-time-regexp - (buffer-substring (point-at-bol) - (point-at-eol))))) - (setq suppress-prewarning - (if (integerp org-agenda-skip-deadline-prewarning-if-scheduled) - org-agenda-skip-deadline-prewarning-if-scheduled - 0))) (setq s (match-string 1) txt nil pos (1- (match-beginning 1)) @@ -5692,10 +6014,32 @@ See also the user option `org-agenda-clock-consistency-checks'." (member todo-state org-agenda-repeating-timestamp-show-all)) d2 (org-time-string-to-absolute - (match-string 1) d1 'past show-all - (current-buffer) pos) - diff (- d2 d1) - wdays (if suppress-prewarning + s d1 'past show-all (current-buffer) pos) + diff (- d2 d1)) + (setq suppress-prewarning + (let ((ds (and org-agenda-skip-deadline-prewarning-if-scheduled + (let ((item (buffer-substring (point-at-bol) + (point-at-eol)))) + (save-match-data + (and (string-match + org-scheduled-time-regexp item) + (match-string 1 item))))))) + (cond + ((not ds) nil) + ;; The current item has a scheduled date (in ds), so + ;; evaluate its prewarning lead time. + ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) + ;; Use global prewarning-restart lead time. + org-agenda-skip-deadline-prewarning-if-scheduled) + ((eq org-agenda-skip-deadline-prewarning-if-scheduled + 'pre-scheduled) + ;; Set prewarning to no earlier than scheduled. + (min (- d2 (org-time-string-to-absolute + ds d1 'past show-all (current-buffer) pos)) + org-deadline-warning-days)) + ;; Set prewarning to deadline. + (t 0)))) + (setq wdays (if suppress-prewarning (let ((org-deadline-warning-days suppress-prewarning)) (org-get-wdays s)) (org-get-wdays s)) @@ -5721,6 +6065,7 @@ See also the user option `org-agenda-clock-consistency-checks'." (throw :skip nil) (goto-char (match-end 0)) (setq pos1 (match-beginning 0)) + (setq level (make-string (org-reduced-level (org-outline-level)) ? )) (setq inherited-tags (or (eq org-agenda-show-inherited-tags 'always) (and (listp org-agenda-show-inherited-tags) @@ -5738,22 +6083,25 @@ See also the user option `org-agenda-clock-consistency-checks'." (concat (substring s (match-beginning 1)) " ")) (setq timestr 'time)) (setq txt (org-agenda-format-item - (if (= diff 0) - (car org-agenda-deadline-leaders) - (if (functionp - (nth 1 org-agenda-deadline-leaders)) - (funcall - (nth 1 org-agenda-deadline-leaders) - diff date) - (format (nth 1 org-agenda-deadline-leaders) - diff))) - head category tags + (cond ((= diff 0) dl0) + ((> diff 0) + (if (functionp dl1) + (funcall dl1 diff date) + (format dl1 diff))) + (t + (if (functionp dl2) + (funcall dl2 diff date) + (format dl2 (if (string= dl2 dl1) + diff (abs diff)))))) + head level category tags (if (not (= diff 0)) nil timestr))))) (when txt (setq face (org-agenda-deadline-face dfrac)) (org-add-props txt props 'org-marker (org-agenda-new-marker pos) 'warntime warntime + 'level level + 'ts-date d2 'org-hd-marker (org-agenda-new-marker pos1) 'priority (+ (- diff) (org-get-priority txt)) @@ -5775,8 +6123,10 @@ FRACTION is what fraction of the head-warning time has passed." (while (setq f (pop faces)) (if (>= fraction (car f)) (throw 'exit (cdr f))))))) -(defun org-agenda-get-scheduled (&optional deadline-results) - "Return the scheduled information for agenda display." +(defun org-agenda-get-scheduled (&optional deadline-results with-hour) + "Return the scheduled information for agenda display. +When WITH-HOUR is non-nil, only return scheduled items with +an hour specification like [h]h:mm." (let* ((props (list 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp @@ -5785,7 +6135,9 @@ FRACTION is what fraction of the head-warning time has passed." 'help-echo (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) - (regexp org-scheduled-time-regexp) + (regexp (if with-hour + org-scheduled-time-hour-regexp + org-scheduled-time-regexp)) (todayp (org-agenda-todayp date)) ; DATE bound by calendar (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar mm @@ -5794,9 +6146,10 @@ FRACTION is what fraction of the head-warning time has passed." 0 'org-hd-marker a)) (cons (marker-position mm) a))) deadline-results)) - d2 diff pos pos1 category category-pos tags donep + d2 diff pos pos1 category category-pos level tags donep ee txt head pastschedp todo-state face timestr s habitp show-all - did-habit-check-p warntime inherited-tags) + did-habit-check-p warntime inherited-tags ts-date suppress-delay + ddays) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -5809,18 +6162,50 @@ FRACTION is what fraction of the head-warning time has passed." (member todo-state org-agenda-repeating-timestamp-show-all)) d2 (org-time-string-to-absolute - (match-string 1) d1 'past show-all - (current-buffer) pos) + s d1 'past show-all (current-buffer) pos) diff (- d2 d1) warntime (get-text-property (point) 'org-appt-warntime)) (setq pastschedp (and todayp (< diff 0))) (setq did-habit-check-p nil) + (setq suppress-delay + (let ((ds (and org-agenda-skip-scheduled-delay-if-deadline + (let ((item (buffer-substring (point-at-bol) (point-at-eol)))) + (save-match-data + (and (string-match + org-deadline-time-regexp item) + (match-string 1 item))))))) + (cond + ((not ds) nil) + ;; The current item has a deadline date (in ds), so + ;; evaluate its delay time. + ((integerp org-agenda-skip-scheduled-delay-if-deadline) + ;; Use global delay time. + (- org-agenda-skip-scheduled-delay-if-deadline)) + ((eq org-agenda-skip-scheduled-delay-if-deadline + 'post-deadline) + ;; Set delay to no later than deadline. + (min (- d2 (org-time-string-to-absolute + ds d1 'past show-all (current-buffer) pos)) + org-scheduled-delay-days)) + (t 0)))) + (setq ddays (if suppress-delay + (let ((org-scheduled-delay-days suppress-delay)) + (org-get-wdays s t t)) + (org-get-wdays s t))) + ;; Use a delay of 0 when there is a repeater and the delay is + ;; of the form --3d + (when (and (save-match-data (string-match "--[0-9]+[hdwmy]" s)) + (< (org-time-string-to-absolute s) + (org-time-string-to-absolute + s d2 'past nil (current-buffer) pos))) + (setq ddays 0)) ;; When to show a scheduled item in the calendar: ;; If it is on or past the date. - (when (or (and (< diff 0) + (when (or (and (> ddays 0) (= diff (- ddays))) + (and (zerop ddays) (= diff 0)) + (and (< (+ diff ddays) 0) (< (abs diff) org-scheduled-past-days) (and todayp (not org-agenda-only-exact-dates))) - (= diff 0) ;; org-is-habit-p uses org-entry-get, which is expansive ;; so we go extra mile to only call it once (and todayp @@ -5842,6 +6227,10 @@ FRACTION is what fraction of the head-warning time has passed." (org-is-habit-p)))) (setq category (org-get-category) category-pos (get-text-property (point) 'org-category-position)) + (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown + 'repeated-after-deadline) + (<= 0 (- d2 (time-to-days (org-get-deadline-time (point)))))) + (throw :skip nil)) (if (not (re-search-backward "^\\*+[ \t]+" nil t)) (throw :skip nil) (goto-char (match-end 0)) @@ -5854,7 +6243,7 @@ FRACTION is what fraction of the head-warning time has passed." (throw :skip nil)) (if (and (or (eq t org-agenda-skip-scheduled-if-deadline-is-shown) - (and org-agenda-skip-scheduled-if-deadline-is-shown + (and (eq org-agenda-skip-scheduled-if-deadline-is-shown 'not-today) pastschedp)) (setq mm (assoc pos1 deadline-position-alist))) (throw :skip nil))) @@ -5865,7 +6254,9 @@ FRACTION is what fraction of the head-warning time has passed." (and (eq org-agenda-show-inherited-tags t) (or (eq org-agenda-use-tag-inheritance t) (memq 'agenda org-agenda-use-tag-inheritance)))) + tags (org-get-tags-at nil (not inherited-tags))) + (setq level (make-string (org-reduced-level (org-outline-level)) ? )) (setq head (buffer-substring (point) (progn (skip-chars-forward "^\r\n") (point)))) @@ -5878,7 +6269,7 @@ FRACTION is what fraction of the head-warning time has passed." (car org-agenda-scheduled-leaders) (format (nth 1 org-agenda-scheduled-leaders) (- 1 diff))) - head category tags + head level category tags (if (not (= diff 0)) nil timestr) nil habitp)))) (when txt @@ -5896,7 +6287,9 @@ FRACTION is what fraction of the head-warning time has passed." 'org-hd-marker (org-agenda-new-marker pos1) 'type (if pastschedp "past-scheduled" "scheduled") 'date (if pastschedp d2 date) + 'ts-date d2 'warntime warntime + 'level level 'priority (if habitp (org-habit-get-priority habitp) (+ 94 (- 5 diff) (org-get-priority txt))) @@ -5920,7 +6313,7 @@ FRACTION is what fraction of the head-warning time has passed." (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) marker hdmarker ee txt d1 d2 s1 s2 category category-pos - todo-state tags pos head donep inherited-tags) + level todo-state tags pos head donep inherited-tags) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -5954,7 +6347,9 @@ FRACTION is what fraction of the head-warning time has passed." (and (eq org-agenda-show-inherited-tags t) (or (eq org-agenda-use-tag-inheritance t) (memq 'agenda org-agenda-use-tag-inheritance)))) + tags (org-get-tags-at nil (not inherited-tags))) + (setq level (make-string (org-reduced-level (org-outline-level)) ? )) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq head (match-string 1)) (let ((remove-re @@ -5969,7 +6364,7 @@ FRACTION is what fraction of the head-warning time has passed." (nth (if (= d1 d2) 0 1) org-agenda-timerange-leaders) (1+ (- d0 d1)) (1+ (- d2 d1))) - head category tags + head level category tags (cond ((and (= d1 d0) (= d2 d0)) (concat "<" start-time ">--<" end-time ">")) ((= d1 d0) @@ -5980,6 +6375,7 @@ FRACTION is what fraction of the head-warning time has passed." (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date + 'level level 'todo-state todo-state 'priority (org-get-priority txt) 'org-category category 'org-category-position category-pos) @@ -5999,6 +6395,9 @@ The flag is set if the currently compiled format contains a `%T'.") (defvar org-prefix-has-effort nil "A flag, set by `org-compile-prefix-format'. The flag is set if the currently compiled format contains a `%e'.") +(defvar org-prefix-has-breadcrumbs nil + "A flag, set by `org-compile-prefix-format'. +The flag is set if the currently compiled format contains a `%b'.") (defvar org-prefix-category-length nil "Used by `org-compile-prefix-format' to remember the category field width.") (defvar org-prefix-category-max-length nil @@ -6012,20 +6411,23 @@ The flag is set if the currently compiled format contains a `%e'.") (return (cadr entry)) (return (apply 'create-image (cdr entry))))))) -(defun org-agenda-format-item (extra txt &optional category tags dotime +(defun org-agenda-format-item (extra txt &optional level category tags dotime remove-re habitp) "Format TXT to be inserted into the agenda buffer. -In particular, it adds the prefix and corresponding text properties. EXTRA -must be a string and replaces the `%s' specifier in the prefix format. -CATEGORY (string, symbol or nil) may be used to overrule the default +In particular, add the prefix and corresponding text properties. + +EXTRA must be a string to replace the `%s' specifier in the prefix format. +LEVEL may be a string to replace the `%l' specifier. +CATEGORY (a string, a symbol or nil) may be used to overrule the default category taken from local variable or file name. It will replace the `%c' -specifier in the format. DOTIME, when non-nil, indicates that a -time-of-day should be extracted from TXT for sorting of this entry, and for -the `%t' specifier in the format. When DOTIME is a string, this string is -searched for a time before TXT is. TAGS can be the tags of the headline. +specifier in the format. +DOTIME, when non-nil, indicates that a time-of-day should be extracted from +TXT for sorting of this entry, and for the `%t' specifier in the format. +When DOTIME is a string, this string is searched for a time before TXT is. +TAGS can be the tags of the headline. Any match of REMOVE-RE will be removed from TXT." ;; We keep the org-prefix-* variable values along with a compiled - ;; formatter, so that multiple agendas existing at the same time, do + ;; formatter, so that multiple agendas existing at the same time do ;; not step on each other toes. ;; ;; It was inconvenient to make these variables buffer local in @@ -6038,13 +6440,14 @@ Any match of REMOVE-RE will be removed from TXT." do (set var value)) (save-match-data ;; Diary entries sometimes have extra whitespace at the beginning - (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt))) + (setq txt (org-trim txt)) ;; Fix the tags part in txt (setq txt (org-agenda-fix-displayed-tags txt tags org-agenda-show-inherited-tags org-agenda-hide-tags-regexp)) + (let* ((category (or category (if (stringp org-category) org-category @@ -6065,7 +6468,7 @@ Any match of REMOVE-RE will be removed from TXT." (and org-agenda-search-headline-for-time txt)))) (time-of-day (and dotime (org-get-time-of-day ts))) stamp plain s0 s1 s2 rtn srp l - duration thecategory) + duration thecategory breadcrumbs) (and (derived-mode-p 'org-mode) buffer-file-name (add-to-list 'org-agenda-contributing-files buffer-file-name)) (when (and dotime time-of-day) @@ -6093,10 +6496,12 @@ Any match of REMOVE-RE will be removed from TXT." (if s2 (setq s2 (org-get-time-of-day s2 'string t))) ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set - (when (and s1 (not s2) org-agenda-default-appointment-duration) - (setq s2 - (org-minutes-to-hh:mm-string - (+ (org-hh:mm-string-to-minutes s1) org-agenda-default-appointment-duration)))) + (let (org-time-clocksum-use-effort-durations) + (when (and s1 (not s2) org-agenda-default-appointment-duration) + (setq s2 + (org-minutes-to-clocksum-string + (+ (org-hh:mm-string-to-minutes s1) + org-agenda-default-appointment-duration))))) ;; Compute the duration (when s2 @@ -6115,12 +6520,15 @@ Any match of REMOVE-RE will be removed from TXT." (match-string 2 txt)) t t txt)))) (when (derived-mode-p 'org-mode) - (setq effort (ignore-errors (get-text-property 0 'org-effort txt))) - (when effort + (setq effort (ignore-errors (get-text-property 0 'org-effort txt)))) + + ;; org-agenda-add-time-grid-maybe calls us with *Agenda* as + ;; current buffer, so move this check outside of above + (if effort (setq neffort (org-duration-string-to-minutes effort) - effort (setq effort (concat "[" effort "]"))))) - ;; prevent erroring out with %e format when there is no effort - (or effort (setq effort "")) + effort (setq effort (concat "[" effort "]"))) + ;; prevent erroring out with %e format when there is no effort + (setq effort "")) (when remove-re (while (string-match remove-re txt) @@ -6131,6 +6539,10 @@ Any match of REMOVE-RE will be removed from TXT." (add-text-properties 0 (length txt) '(org-heading t) txt) ;; Prepare the variables needed in the eval of the compiled format + (if org-prefix-has-breadcrumbs + (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker) + (let ((s (org-display-outline-path nil nil "->" t))) + (if (eq "" s) "" (concat s "->")))))) (setq time (cond (s2 (concat (org-agenda-time-of-day-to-ampm-maybe s1) "-" (org-agenda-time-of-day-to-ampm-maybe s2) @@ -6143,7 +6555,8 @@ Any match of REMOVE-RE will be removed from TXT." (t "")) extra (or (and (not habitp) extra) "") category (if (symbolp category) (symbol-name category) category) - thecategory (copy-sequence category)) + thecategory (copy-sequence category) + level (or level "")) (if (string-match org-bracket-link-regexp category) (progn (setq l (if (match-end 3) @@ -6171,7 +6584,9 @@ Any match of REMOVE-RE will be removed from TXT." 'duration duration 'effort effort 'effort-minutes neffort + 'breadcrumbs breadcrumbs 'txt txt + 'level level 'time time 'extra extra 'format org-prefix-format-compiled @@ -6216,9 +6631,13 @@ The modified list may contain inherited tags, and tags matched by s)) (defvar org-agenda-sorting-strategy) ;; because the def is in a let form -(defvar org-agenda-sorting-strategy-selected nil) (defun org-agenda-add-time-grid-maybe (list ndays todayp) + "Add a time-grid for agenda items which need it. + +LIST is the list of agenda items formatted by `org-agenda-list'. +NDAYS is the span of the current agenda view. +TODAYP is `t' when the current agenda view is on today." (catch 'exit (cond ((not org-agenda-use-time-grid) (throw 'exit list)) ((and todayp (member 'today (car org-agenda-time-grid)))) @@ -6240,16 +6659,14 @@ The modified list may contain inherited tags, and tags matched by (unless (and remove (member time have)) (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) (push (org-agenda-format-item - nil string "" nil + nil string nil "" nil (concat (substring time 0 -2) ":" (substring time -2))) new) (put-text-property 2 (length (car new)) 'face 'org-time-grid (car new)))) (when (and todayp org-agenda-show-current-time-in-grid) (push (org-agenda-format-item - nil - org-agenda-current-time-string - "" nil + nil org-agenda-current-time-string nil "" nil (format-time-string "%H:%M ")) new) (put-text-property @@ -6263,9 +6680,11 @@ The modified list may contain inherited tags, and tags matched by "Compile the prefix format into a Lisp form that can be evaluated. The resulting form and associated variable bindings is returned and stored in the variable `org-prefix-format-compiled'." - (setq org-prefix-has-time nil org-prefix-has-tag nil + (setq org-prefix-has-time nil + org-prefix-has-tag nil org-prefix-category-length nil - org-prefix-has-effort nil) + org-prefix-has-effort nil + org-prefix-has-breadcrumbs nil) (let ((s (cond ((stringp org-agenda-prefix-format) org-agenda-prefix-format) @@ -6274,11 +6693,11 @@ and stored in the variable `org-prefix-format-compiled'." (t " %-12:c%?-12t% s"))) (start 0) varform vars var e c f opt) - (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([ctsei]\\|(.+)\\)" + (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)" s start) (setq var (or (cdr (assoc (match-string 4 s) - '(("c" . category) ("t" . time) ("s" . extra) - ("i" . category-icon) ("T" . tag) ("e" . effort)))) + '(("c" . category) ("t" . time) ("l" . level) ("s" . extra) + ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs)))) 'eval) c (or (match-string 3 s) "") opt (match-beginning 1) @@ -6286,6 +6705,7 @@ and stored in the variable `org-prefix-format-compiled'." (if (equal var 'time) (setq org-prefix-has-time t)) (if (equal var 'tag) (setq org-prefix-has-tag t)) (if (equal var 'effort) (setq org-prefix-has-effort t)) + (if (equal var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t)) (setq f (concat "%" (match-string 2 s) "s")) (when (equal var 'category) (setq org-prefix-category-length @@ -6312,7 +6732,8 @@ and stored in the variable `org-prefix-format-compiled'." `((org-prefix-has-time ,org-prefix-has-time) (org-prefix-has-tag ,org-prefix-has-tag) (org-prefix-category-length ,org-prefix-category-length) - (org-prefix-has-effort ,org-prefix-has-effort)) + (org-prefix-has-effort ,org-prefix-has-effort) + (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs)) `(format ,s ,@vars)))))) (defun org-set-sorting-strategy (key) @@ -6372,14 +6793,69 @@ You can also use this function as a filter, by returning nil for lines you don't want to have in the agenda at all. For this application, you could bind the variable in the options section of a custom command.") -(defun org-agenda-finalize-entries (list &optional nosort) - "Sort and concatenate the agenda items." - (setq list (mapcar 'org-agenda-highlight-todo list)) - (if nosort - list +(defun org-agenda-finalize-entries (list &optional type) + "Sort, limit and concatenate the LIST of agenda items. +The optional argument TYPE tells the agenda type." + (let ((max-effort (cond ((listp org-agenda-max-effort) + (cdr (assoc type org-agenda-max-effort))) + (t org-agenda-max-effort))) + (max-todo (cond ((listp org-agenda-max-todos) + (cdr (assoc type org-agenda-max-todos))) + (t org-agenda-max-todos))) + (max-tags (cond ((listp org-agenda-max-tags) + (cdr (assoc type org-agenda-max-tags))) + (t org-agenda-max-tags))) + (max-entries (cond ((listp org-agenda-max-entries) + (cdr (assoc type org-agenda-max-entries))) + (t org-agenda-max-entries))) l) (when org-agenda-before-sorting-filter-function - (setq list (delq nil (mapcar org-agenda-before-sorting-filter-function list)))) - (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))) + (setq list + (delq nil + (mapcar + org-agenda-before-sorting-filter-function list)))) + (setq list (mapcar 'org-agenda-highlight-todo list) + list (mapcar 'identity (sort list 'org-entries-lessp))) + (when max-effort + (setq list (org-agenda-limit-entries + list 'effort-minutes max-effort 'identity))) + (when max-todo + (setq list (org-agenda-limit-entries list 'todo-state max-todo))) + (when max-tags + (setq list (org-agenda-limit-entries list 'tags max-tags))) + (when max-entries + (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries))) + (mapconcat 'identity list "\n"))) + +(defun org-agenda-limit-entries (list prop limit &optional fn) + "Limit the number of agenda entries." + (let ((include (and limit (< limit 0)))) + (if limit + (let ((fun (or fn (lambda (p) (if p 1)))) + (lim 0)) + (delq nil + (mapcar + (lambda (e) + (let ((pval (funcall fun (get-text-property 1 prop e)))) + (if pval (setq lim (+ lim pval))) + (cond ((and pval (<= lim (abs limit))) e) + ((and include (not pval)) e)))) + list))) + list))) + +(defun org-agenda-limit-interactively () + "In agenda, interactively limit entries to various maximums." + (interactive) + (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? ")) + (num (string-to-number (read-from-minibuffer "How many? ")))) + (cond ((equal max ?e) + (let ((org-agenda-max-entries num)) (org-agenda-redo))) + ((equal max ?t) + (let ((org-agenda-max-todos num)) (org-agenda-redo))) + ((equal max ?T) + (let ((org-agenda-max-tags num)) (org-agenda-redo))) + ((equal max ?E) + (let ((org-agenda-max-effort num)) (org-agenda-redo))))) + (org-agenda-fit-window-to-buffer)) (defun org-agenda-highlight-todo (x) (let ((org-done-keywords org-done-keywords-for-agenda) @@ -6506,6 +6982,20 @@ could bind the variable in the options section of a custom command.") (cond ((< ta tb) -1) ((< tb ta) +1)))) +(defsubst org-cmp-ts (a b &optional type) + "Compare the timestamps values of entries A and B. +When TYPE is \"scheduled\", \"deadline\", \"timestamp\" +or \"timestamp_ia\", compare within each of these type. +When TYPE is the empty string, compare all timestamps +without respect of their type." + (let* ((def (if org-sort-agenda-notime-is-late 9901 -1)) + (ta (or (and (string-match type (get-text-property 1 'type a)) + (get-text-property 1 'ts-date a)) def)) + (tb (or (and (string-match type (get-text-property 1 'type b)) + (get-text-property 1 'ts-date b)) def))) + (cond ((< ta tb) -1) + ((< tb ta) +1)))) + (defsubst org-cmp-habit-p (a b) "Compare the todo states of strings A and B." (let ((ha (get-text-property 1 'org-habit-p a)) @@ -6513,13 +7003,26 @@ could bind the variable in the options section of a custom command.") (cond ((and ha (not hb)) -1) ((and (not ha) hb) +1)))) -(defsubst org-em (x y list) (or (memq x list) (memq y list))) - (defun org-entries-lessp (a b) "Predicate for sorting agenda entries." ;; The following variables will be used when the form is evaluated. ;; So even though the compiler complains, keep them. (let* ((ss org-agenda-sorting-strategy-selected) + (timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss) + (org-cmp-ts a b ""))) + (timestamp-down (if timestamp-up (- timestamp-up) nil)) + (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss) + (org-cmp-ts a b "scheduled"))) + (scheduled-down (if scheduled-up (- scheduled-up) nil)) + (deadline-up (and (org-em 'deadline-up 'deadline-down ss) + (org-cmp-ts a b "deadline"))) + (deadline-down (if deadline-up (- deadline-up) nil)) + (tsia-up (and (org-em 'tsia-up 'tsia-down ss) + (org-cmp-ts a b "iatimestamp_ia"))) + (tsia-down (if tsia-up (- tsia-up) nil)) + (ts-up (and (org-em 'ts-up 'ts-down ss) + (org-cmp-ts a b "timestamp"))) + (ts-down (if ts-up (- ts-up) nil)) (time-up (and (org-em 'time-up 'time-down ss) (org-cmp-time a b))) (time-down (if time-up (- time-up) nil)) @@ -6587,10 +7090,14 @@ in the file. Otherwise, restriction will be to the current subtree." (put 'org-agenda-files 'org-restrict (list (buffer-file-name (buffer-base-buffer)))) (org-back-to-heading t) - (move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol)) + (move-overlay org-agenda-restriction-lock-overlay + (point) + (if org-agenda-restriction-lock-highlight-subtree + (save-excursion (org-end-of-subtree t t) (point)) + (point-at-eol))) (move-marker org-agenda-restrict-begin (point)) (move-marker org-agenda-restrict-end - (save-excursion (org-end-of-subtree t))) + (save-excursion (org-end-of-subtree t t))) (message "Locking agenda restriction to subtree")) (put 'org-agenda-files 'org-restrict (list (buffer-file-name (buffer-base-buffer)))) @@ -6643,8 +7150,9 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search." (error "Not allowed in %s-type agenda buffers" org-agenda-type) nil)))) -(defun org-agenda-Quit (&optional arg) - "Exit agenda by removing the window or the buffer." +(defun org-agenda-Quit () + "Exit the agenda and kill buffers loaded by `org-agenda'. +Also restore the window configuration." (interactive) (if org-agenda-columns-active (org-columns-quit) @@ -6663,6 +7171,7 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search." (kill-buffer buf) (org-columns-remove-overlays) (setq org-agenda-archives-mode nil))) + (setq org-agenda-buffer nil) ;; Maybe restore the pre-agenda window configuration. (and org-agenda-restore-windows-after-quit (not (eq org-agenda-window-setup 'other-frame)) @@ -6671,8 +7180,8 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search." (setq org-agenda-pre-window-conf nil)))) (defun org-agenda-quit () - "Exit agenda by killing agenda buffer or burying it when -`org-agenda-sticky' is non-NIL" + "Exit the agenda and restore the window configuration. +When `org-agenda-sticky' is non-nil, only bury the agenda." (interactive) (if (and (eq org-indirect-buffer-display 'other-window) org-last-indirect-buffer) @@ -6701,9 +7210,9 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search." (org-agenda-Quit)))) (defun org-agenda-exit () - "Exit agenda by removing the window or the buffer. -Also kill all Org-mode buffers which have been loaded by `org-agenda'. -Org-mode buffers visited directly by the user will not be touched." + "Exit the agenda and restore the window configuration. +Also kill Org-mode buffers loaded by `org-agenda'. Org-mode +buffers visited directly by the user will not be touched." (interactive) (org-release-buffers org-agenda-new-buffers) (setq org-agenda-new-buffers nil) @@ -6711,8 +7220,8 @@ Org-mode buffers visited directly by the user will not be touched." (defun org-agenda-kill-all-agenda-buffers () "Kill all buffers in `org-agenda-mode'. -This is used when toggling sticky agendas. You can also explicitly invoke it -with `C-c a C-k'." +This is used when toggling sticky agendas. +You can also explicitly invoke it with `C-c a C-k'." (interactive) (let (blist) (dolist (buf (buffer-list)) @@ -6740,9 +7249,11 @@ in the agenda." (org-agenda-keep-modes t) (tag-filter org-agenda-tag-filter) (tag-preset (get 'org-agenda-tag-filter :preset-filter)) - (top-cat-filter org-agenda-top-category-filter) + (top-hl-filter org-agenda-top-headline-filter) (cat-filter org-agenda-category-filter) (cat-preset (get 'org-agenda-category-filter :preset-filter)) + (re-filter org-agenda-regexp-filter) + (re-preset (get 'org-agenda-regexp-filter :preset-filter)) (org-agenda-tag-filter-while-redo (or tag-filter tag-preset)) (cols org-agenda-columns-active) (line (org-current-line)) @@ -6760,19 +7271,26 @@ in the agenda." (series-redo-cmd (get-text-property p 'org-series-redo-cmd))) (put 'org-agenda-tag-filter :preset-filter nil) (put 'org-agenda-category-filter :preset-filter nil) + (put 'org-agenda-regexp-filter :preset-filter nil) (and cols (org-columns-quit)) (message "Rebuilding agenda buffer...") (if series-redo-cmd (eval series-redo-cmd) - (org-let lprops '(eval redo-cmd))) + (org-let lprops redo-cmd)) (setq org-agenda-undo-list nil - org-agenda-pending-undo-list nil) + org-agenda-pending-undo-list nil + org-agenda-tag-filter tag-filter + org-agenda-category-filter cat-filter + org-agenda-regexp-filter re-filter + org-agenda-top-headline-filter top-hl-filter) (message "Rebuilding agenda buffer...done") (put 'org-agenda-tag-filter :preset-filter tag-preset) (put 'org-agenda-category-filter :preset-filter cat-preset) + (put 'org-agenda-regexp-filter :preset-filter re-preset) (and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag)) (and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category)) - (and top-cat-filter (org-agenda-filter-top-category-apply top-cat-filter)) + (and (or re-filter re-preset) (org-agenda-filter-apply re-filter 'regexp)) + (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter)) (and cols (org-called-interactively-p 'any) (org-agenda-columns)) (org-goto-line line) (recenter window-line))) @@ -6789,11 +7307,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 cat (org-agenda-filter-apply - (list (concat (if strip "-" "+") cat)) '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"))))) -(defun org-find-top-category (&optional pos) +(defun org-find-top-headline (&optional pos) + "Find the topmost parent headline and return it." (save-excursion (with-current-buffer (if pos (marker-buffer pos) (current-buffer)) (if pos (goto-char pos)) @@ -6802,21 +7324,49 @@ The category is that of the current line." (ignore-errors (nth 4 (org-heading-components)))))) -(defvar org-agenda-filtered-by-top-category nil) - -(defun org-agenda-filter-by-top-category (strip) - "Keep only those lines in the agenda buffer that have a specific category. -The category is that of the current line." +(defvar org-agenda-filtered-by-top-headline nil) +(defun org-agenda-filter-by-top-headline (strip) + "Keep only those lines that are descendants from the same top headline. +The top headline is that of the current line." (interactive "P") - (if org-agenda-filtered-by-top-category + (if org-agenda-filtered-by-top-headline (progn - (setq org-agenda-filtered-by-top-category nil - org-agenda-top-category-filter nil) + (setq org-agenda-filtered-by-top-headline nil + org-agenda-top-headline-filter nil) (org-agenda-filter-show-all-cat)) - (let ((cat (org-find-top-category (org-get-at-bol 'org-hd-marker)))) - (if cat (org-agenda-filter-top-category-apply cat strip) + (let ((cat (org-find-top-headline (org-get-at-bol 'org-hd-marker)))) + (if cat (org-agenda-filter-top-headline-apply cat strip) (error "No top-level category at point"))))) +(defvar org-agenda-regexp-filter nil) +(defun org-agenda-filter-by-regexp (strip) + "Filter agenda entries by a regular expression. +Regexp filters are cumulative. +With no prefix argument, keep entries matching the regexp. +With one prefix argument, filter out entries matching the regexp. +With two prefix arguments, remove the regexp filters." + (interactive "P") + (if (not (equal strip '(16))) + (let ((flt (concat (if (equal strip '(4)) "-" "+") + (read-from-minibuffer + (if (equal strip '(4)) + "Filter out entries matching regexp: " + "Narrow to entries matching regexp: "))))) + (push flt org-agenda-regexp-filter) + (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)) + (org-agenda-filter-show-all-re) + (message "Regexp filter removed"))) + +(defun org-agenda-filter-remove-all () + "Remove all filters from the current agenda buffer." + (interactive) + (when org-agenda-tag-filter + (org-agenda-filter-show-all-tag)) + (when org-agenda-category-filter + (org-agenda-filter-show-all-cat)) + (when org-agenda-regexp-filter + (org-agenda-filter-show-all-re))) + (defun org-agenda-filter-by-tag (strip &optional char narrow) "Keep only those lines in the agenda buffer that have a specific tag. The tag is selected with its fast selection letter, as configured. @@ -6881,7 +7431,7 @@ to switch to narrowing." ((equal char ?\r) (org-agenda-filter-show-all-tag) (when org-agenda-auto-exclude-function - (setq org-agenda-tag-filter '()) + (setq org-agenda-tag-filter nil) (dolist (tag (org-agenda-get-represented-tags)) (let ((modifier (funcall org-agenda-auto-exclude-function tag))) (if modifier @@ -6938,29 +7488,59 @@ to switch to narrowing." (interactive "P") (org-agenda-filter-by-tag strip char 'refine)) -(defun org-agenda-filter-make-matcher () +(defun org-agenda-filter-make-matcher (filter type) "Create the form that tests a line for agenda filter." (let (f f1) - ;; first compute the tag-filter matcher - (dolist (x (delete-dups - (append (get 'org-agenda-tag-filter - :preset-filter) org-agenda-tag-filter))) - (if (member x '("-" "+")) - (setq f1 (if (equal x "-") 'tags '(not tags))) - (if (string-match "[<=>?]" x) - (setq f1 (org-agenda-filter-effort-form x)) - (setq f1 (list 'member (downcase (substring x 1)) 'tags))) - (if (equal (string-to-char x) ?-) - (setq f1 (list 'not f1)))) - (push f1 f)) - ;; then compute the category-filter matcher - (dolist (x (delete-dups - (append (get 'org-agenda-category-filter - :preset-filter) org-agenda-category-filter))) - (if (equal "-" (substring x 0 1)) - (setq f1 (list 'not (list 'equal (substring x 1) 'cat))) - (setq f1 (list 'equal (substring x 1) 'cat))) - (push f1 f)) + (cond + ;; Tag filter + ((eq type 'tag) + (setq filter + (delete-dups + (append (get 'org-agenda-tag-filter :preset-filter) + filter))) + (dolist (x filter) + (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1 + (ffunc + (lambda (nf0 nf01 fltr notgroup op) + (dolist (x fltr) + (if (member x '("-" "+")) + (setq nf01 (if (equal x "-") 'tags '(not tags))) + (if (string-match "[<=>?]" x) + (setq nf01 (org-agenda-filter-effort-form x)) + (setq nf01 (list 'member (downcase (substring x 1)) + 'tags))) + (when (equal (string-to-char x) ?-) + (setq nf01 (list 'not nf01)) + (when (not notgroup) (setq op 'and)))) + (push nf01 nf0)) + (if notgroup + (push (cons 'and nf0) f) + (push (cons (or op 'or) nf0) f))))) + (if (equal nfilter filter) + (funcall ffunc f1 f filter t nil) + (funcall ffunc nf1 nf nfilter nil nil))))) + ;; Category filter + ((eq type 'category) + (setq filter + (delete-dups + (append (get 'org-agenda-category-filter :preset-filter) + filter))) + (dolist (x filter) + (if (equal "-" (substring x 0 1)) + (setq f1 (list 'not (list 'equal (substring x 1) 'cat))) + (setq f1 (list 'equal (substring x 1) 'cat))) + (push f1 f))) + ;; Regexp filter + ((eq type 'regexp) + (setq filter + (delete-dups + (append (get 'org-agenda-regexp-filter :preset-filter) + filter))) + (dolist (x filter) + (if (equal "-" (substring x 0 1)) + (setq f1 (list 'not (list 'string-match (substring x 1) 'txt))) + (setq f1 (list 'string-match (substring x 1) 'txt))) + (push f1 f)))) (cons 'and (nreverse f)))) (defun org-agenda-filter-effort-form (e) @@ -6985,15 +7565,31 @@ If the line does not have an effort defined, return nil." (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0)) value)))) +(defun org-agenda-filter-expand-tags (filter &optional no-operator) + "Expand group tags in FILTER for the agenda. +When NO-OPERATOR is non-nil, do not add the + operator to returned tags." + (if org-group-tags + (let ((case-fold-search t) rtn) + (mapc + (lambda (f) + (let (f0 dir) + (if (string-match "^\\([+-]\\)\\(.+\\)" f) + (setq dir (match-string 1 f) f0 (match-string 2 f)) + (setq dir (if no-operator "" "+") f0 f)) + (setq rtn (append (mapcar (lambda(f1) (concat dir f1)) + (org-tags-expand f0 t t)) + rtn)))) + filter) + (reverse rtn)) + filter)) + (defun org-agenda-filter-apply (filter type) "Set FILTER as the new agenda filter and apply it." ;; Deactivate `org-agenda-entry-text-mode' when filtering (if org-agenda-entry-text-mode (org-agenda-entry-text-mode)) - (let (tags cat) - (if (eq type 'tag) - (setq org-agenda-tag-filter filter) - (setq org-agenda-category-filter filter)) - (setq org-agenda-filter-form (org-agenda-filter-make-matcher)) + (let (tags cat txt) + (setq org-agenda-filter-form + (org-agenda-filter-make-matcher filter type)) (if (and (eq type 'category) (not (equal (substring (car filter) 0 1) "-"))) ;; Only set `org-agenda-filtered-by-category' to t @@ -7005,8 +7601,13 @@ If the line does not have an effort defined, return nil." (while (not (eobp)) (if (org-get-at-bol 'org-marker) (progn - (setq tags (org-get-at-bol 'tags) ; used in eval - cat (get-text-property (point) 'org-category)) + (setq tags ; used in eval + (apply 'append + (mapcar (lambda (f) + (org-agenda-filter-expand-tags (list f) t)) + (org-get-at-bol 'tags))) + cat (get-text-property (point) 'org-category) + txt (get-text-property (point) 'txt)) (if (not (eval org-agenda-filter-form)) (org-agenda-filter-hide-line type)) (beginning-of-line 2)) @@ -7014,32 +7615,33 @@ If the line does not have an effort defined, return nil." (if (get-char-property (point) 'invisible) (ignore-errors (org-agenda-previous-line))))) -(defun org-agenda-filter-top-category-apply (category &optional negative) - "Set FILTER as the new agenda filter and apply it." +(defun org-agenda-filter-top-headline-apply (hl &optional negative) + "Filter by top headline HL." (org-agenda-set-mode-name) (save-excursion (goto-char (point-min)) (while (not (eobp)) (let* ((pos (org-get-at-bol 'org-hd-marker)) - (topcat (and pos (org-find-top-category pos)))) - (if (and topcat (funcall (if negative 'identity 'not) - (string= category topcat))) + (tophl (and pos (org-find-top-headline pos)))) + (if (and tophl (funcall (if negative 'identity 'not) + (string= hl tophl))) (org-agenda-filter-hide-line 'category))) (beginning-of-line 2))) (if (get-char-property (point) 'invisible) (org-agenda-previous-line)) - (setq org-agenda-top-category-filter category - org-agenda-filtered-by-top-category t)) + (setq org-agenda-top-headline-filter hl + org-agenda-filtered-by-top-headline t)) (defun org-agenda-filter-hide-line (type) + "Hide lines with TYPE in the agenda buffer." (let (ov) (setq ov (make-overlay (max (point-min) (1- (point-at-bol))) (point-at-eol))) (overlay-put ov 'invisible t) (overlay-put ov 'type type) - (if (eq type 'tag) - (push ov org-agenda-tag-filter-overlays) - (push ov org-agenda-cat-filter-overlays)))) + (cond ((eq type 'tag) (push ov org-agenda-tag-filter-overlays)) + ((eq type 'category) (push ov org-agenda-cat-filter-overlays)) + ((eq type 'regexp) (push ov org-agenda-re-filter-overlays))))) (defun org-agenda-fix-tags-filter-overlays-at (&optional pos) (setq pos (or pos (point))) @@ -7053,13 +7655,23 @@ If the line does not have an effort defined, return nil." (overlay-end ov))))))) (defun org-agenda-filter-show-all-tag nil + "Remove tag filter overlays from the agenda buffer." (mapc 'delete-overlay org-agenda-tag-filter-overlays) (setq org-agenda-tag-filter-overlays nil org-agenda-tag-filter nil org-agenda-filter-form nil) (org-agenda-set-mode-name)) +(defun org-agenda-filter-show-all-re nil + "Remove regexp filter overlays from the agenda buffer." + (mapc 'delete-overlay org-agenda-re-filter-overlays) + (setq org-agenda-re-filter-overlays nil + org-agenda-regexp-filter nil + org-agenda-filter-form nil) + (org-agenda-set-mode-name)) + (defun org-agenda-filter-show-all-cat nil + "Remove category filter overlays from the agenda buffer." (mapc 'delete-overlay org-agenda-cat-filter-overlays) (setq org-agenda-cat-filter-overlays nil org-agenda-filtered-by-category nil @@ -7123,23 +7735,31 @@ Negative selection means regexp must not match for selection of an entry." (let* ((org-read-date-prefer-future (eval org-agenda-jump-prefer-future)) (date (org-read-date)) + (day (time-to-days (org-time-string-to-time date))) (org-agenda-sticky-orig org-agenda-sticky) (org-agenda-buffer-tmp-name (buffer-name)) (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) (0-arg (or current-prefix-arg (car args))) (2-arg (nth 2 args)) + (with-hour-p (nth 4 org-agenda-redo-command)) (newcmd (list 'org-agenda-list 0-arg date - (org-agenda-span-to-ndays 2-arg))) + (org-agenda-span-to-ndays + 2-arg (org-time-string-to-absolute date)) + with-hour-p)) (newargs (cdr newcmd)) (inhibit-read-only t) org-agenda-sticky) (if (not (org-agenda-check-type t 'agenda)) - (error "Not available in non-agenda blocks") + (error "Not available in non-agenda views") (add-text-properties (point-min) (point-max) `(org-redo-cmd ,newcmd org-last-args ,newargs)) (org-agenda-redo) - (setq org-agenda-sticky org-agenda-sticky-orig - org-agenda-this-buffer-is-sticky org-agenda-sticky)))) + (goto-char (point-min)) + (while (not (or (= (or (get-text-property (point) 'day) 0) day) + (save-excursion (move-beginning-of-line 2) (eobp)))) + (move-beginning-of-line 2)) + (setq org-agenda-sticky org-agenda-sticky-orig + org-agenda-this-buffer-is-sticky org-agenda-sticky)))) (defun org-agenda-goto-today () "Go to today." @@ -7266,11 +7886,11 @@ With prefix ARG, go backward that many times the current span." "Switch to default view for agenda." (interactive) (org-agenda-change-time-span (or org-agenda-ndays org-agenda-span))) -(defun org-agenda-day-view (&optional day-of-year) +(defun org-agenda-day-view (&optional day-of-month) "Switch to daily view for agenda. -With argument DAY-OF-YEAR, switch to that day of the year." +With argument DAY-OF-MONTH, switch to that day of the month." (interactive "P") - (org-agenda-change-time-span 'day day-of-year)) + (org-agenda-change-time-span 'day day-of-month)) (defun org-agenda-week-view (&optional iso-week) "Switch to daily view for agenda. With argument ISO-WEEK, switch to the corresponding ISO week. @@ -7422,7 +8042,8 @@ so that the date SD will be in that range." (interactive "P") (if (or org-agenda-tag-filter org-agenda-category-filter - org-agenda-top-category-filter) + org-agenda-regexp-filter + org-agenda-top-headline-filter) (user-error "Can't show entry text in filtered views") (setq org-agenda-entry-text-mode (or (integerp arg) (not org-agenda-entry-text-mode))) @@ -7540,8 +8161,8 @@ When called with a prefix argument, include all archive files as well." ((eq org-agenda-show-log 'clockcheck) " ClkCk") (org-agenda-show-log " Log") (t "")) - (if (or org-agenda-category-filter (get 'org-agenda-category-filter - :preset-filter)) + (if (or org-agenda-category-filter + (get 'org-agenda-category-filter :preset-filter)) '(:eval (org-propertize (concat " <" (mapconcat @@ -7552,10 +8173,9 @@ When called with a prefix argument, include all archive files as well." "") ">") 'face 'org-agenda-filter-category - 'help-echo "Category used in filtering")) - "") - (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter - :preset-filter)) + 'help-echo "Category used in filtering")) "") + (if (or org-agenda-tag-filter + (get 'org-agenda-tag-filter :preset-filter)) '(:eval (org-propertize (concat " {" (mapconcat @@ -7566,8 +8186,20 @@ When called with a prefix argument, include all archive files as well." "") "}") 'face 'org-agenda-filter-tags - 'help-echo "Tags used in filtering")) - "") + 'help-echo "Tags used in filtering")) "") + (if (or org-agenda-regexp-filter + (get 'org-agenda-regexp-filter :preset-filter)) + '(:eval (org-propertize + (concat " [" + (mapconcat + 'identity + (append + (get 'org-agenda-regexp-filter :preset-filter) + org-agenda-regexp-filter) + "") + "]") + 'face 'org-agenda-filter-regexp + 'help-echo "Regexp used in filtering")) "") (if org-agenda-archives-mode (if (eq org-agenda-archives-mode t) " Archives" @@ -7776,10 +8408,19 @@ If this information is not given, the function uses the tree at point." (beginning-of-line 0)))))) (defun org-agenda-refile (&optional goto rfloc no-update) - "Refile the item at point." + "Refile the item at point. + +When GOTO is 0 or '(64), clear the refile cache. +When GOTO is '(16), go to the location of the last refiled item. +RFLOC can be a refile location obtained in a different way. +When NO-UPDATE is non-nil, don't redo the agenda buffer." (interactive "P") - (if (equal goto '(16)) - (org-refile-goto-last-stored) + (cond + ((member goto '(0 (64))) + (org-refile-cache-clear)) + ((equal goto '(16)) + (org-refile-goto-last-stored)) + (t (let* ((buffer-orig (buffer-name)) (marker (or (org-get-at-bol 'org-hd-marker) (org-agenda-error))) @@ -7797,7 +8438,7 @@ If this information is not given, the function uses the tree at point." (let ((org-agenda-buffer-name buffer-orig)) (org-remove-subtree-entries-from-agenda)) (org-refile goto buffer rfloc))))) - (unless no-update (org-agenda-redo)))) + (unless no-update (org-agenda-redo))))) (defun org-agenda-open-link (&optional arg) "Open the link(s) in the current entry, if any. @@ -8155,7 +8796,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (save-excursion (save-restriction (widen) (goto-char hdmarker) (org-get-tags-at))))) - props m pl undone-face done-face finish new dotime cat tags) + props m pl undone-face done-face finish new dotime level cat tags) (save-excursion (goto-char (point-max)) (beginning-of-line 1) @@ -8167,6 +8808,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (setq props (text-properties-at (point)) dotime (org-get-at-bol 'dotime) cat (org-get-at-bol 'org-category) + level (org-get-at-bol 'level) tags thetags new (let ((org-prefix-format-compiled @@ -8177,7 +8819,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (save-excursion (save-restriction (widen) - (org-agenda-format-item extra newhead cat tags dotime))))) + (org-agenda-format-item extra newhead level cat tags dotime))))) pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) undone-face (org-get-at-bol 'undone-face) done-face (org-get-at-bol 'done-face)) @@ -8568,9 +9210,9 @@ ARG is passed through to `org-deadline'." (org-clock-in arg) (let* ((marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) - (hdmarker (or (org-get-at-bol 'org-hd-marker) - marker)) + (hdmarker (or (org-get-at-bol 'org-hd-marker) marker)) (pos (marker-position marker)) + (col (current-column)) newhead) (org-with-remote-undo (marker-buffer marker) (with-current-buffer (marker-buffer marker) @@ -8581,14 +9223,15 @@ ARG is passed through to `org-deadline'." (org-cycle-hide-drawers 'children) (org-clock-in arg) (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker))))) + (org-agenda-change-all-lines newhead hdmarker)) + (org-move-to-column col)))) (defun org-agenda-clock-out () "Stop the currently running clock." (interactive) (unless (marker-buffer org-clock-marker) (error "No running clock")) - (let ((marker (make-marker)) newhead) + (let ((marker (make-marker)) (col (current-column)) newhead) (org-with-remote-undo (marker-buffer org-clock-marker) (with-current-buffer (marker-buffer org-clock-marker) (save-excursion @@ -8600,13 +9243,15 @@ ARG is passed through to `org-deadline'." (org-clock-out) (setq newhead (org-get-heading)))))) (org-agenda-change-all-lines newhead marker) - (move-marker marker nil))) + (move-marker marker nil) + (org-move-to-column col) + (org-agenda-unmark-clocking-task))) (defun org-agenda-clock-cancel (&optional arg) "Cancel the currently running clock." (interactive "P") (unless (marker-buffer org-clock-marker) - (error "No running clock")) + (user-error "No running clock")) (org-with-remote-undo (marker-buffer org-clock-marker) (org-clock-cancel))) @@ -8634,7 +9279,7 @@ buffer, display it in another window." (setq d1 (calendar-cursor-to-date t) d2 (car calendar-mark-ring)) (setq dp1 (get-text-property (point-at-bol) 'day)) - (unless dp1 (error "No date defined in current line")) + (unless dp1 (user-error "No date defined in current line")) (setq d1 (calendar-gregorian-from-absolute dp1) d2 (and (ignore-errors (mark)) (save-excursion @@ -8658,7 +9303,7 @@ buffer, display it in another window." ((equal char ?b) (setq text (read-string "Block entry: ")) (unless (and d1 d2 (not (equal d1 d2))) - (error "No block of days selected")) + (user-error "No block of days selected")) (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2) (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) ((equal char ?j) @@ -8667,7 +9312,7 @@ buffer, display it in another window." (require 'org-datetree) (org-datetree-find-date-create d1) (org-reveal t)) - (t (error "Invalid selection character `%c'" char))))) + (t (user-error "Invalid selection character `%c'" char))))) (defcustom org-agenda-insert-diary-strategy 'date-tree "Where in `org-agenda-diary-file' should new entries be added? @@ -8725,7 +9370,7 @@ the resulting entry will not be shown. When TEXT is empty, switch to ;; Use org-agenda-format-item to parse text for a time-range and ;; remove it. FIXME: This is a hack, we should refactor ;; that function to make time extraction available separately - (setq fmt (org-agenda-format-item nil text nil nil t) + (setq fmt (org-agenda-format-item nil text nil nil nil t) time (get-text-property 0 'time fmt) time2 (if (> (length time) 0) ;; split-string removes trailing ...... if @@ -8827,11 +9472,11 @@ entries in that Org-mode file." (point (point)) (mark (or (mark t) (point)))) (unless cmd - (error "No command associated with <%c>" char)) + (user-error "No command associated with <%c>" char)) (unless (and (get-text-property point 'day) (or (not (equal ?b char)) (get-text-property mark 'day))) - (error "Don't know which date to use for diary entry")) + (user-error "Don't know which date to use for diary entry")) ;; We implement this by hacking the `calendar-cursor-to-date' function ;; and the `calendar-mark-ring' variable. Saves a lot of code. (let ((calendar-mark-ring @@ -8852,7 +9497,7 @@ entries in that Org-mode file." (org-agenda-check-type t 'agenda 'timeline) (require 'diary-lib) (unless (get-text-property (min (1- (point-max)) (point)) 'day) - (error "Don't know which date to use for the calendar command")) + (user-error "Don't know which date to use for the calendar command")) (let* ((oldf (symbol-function 'calendar-cursor-to-date)) (point (point)) (date (calendar-gregorian-from-absolute @@ -8901,7 +9546,7 @@ argument, latitude and longitude will be prompted for." (interactive) (org-agenda-check-type t 'agenda 'timeline) (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day) - (error "Don't know which date to open in calendar"))) + (user-error "Don't know which date to open in calendar"))) (date (calendar-gregorian-from-absolute day)) (calendar-move-hook nil) (calendar-view-holidays-initially-flag nil) @@ -8924,7 +9569,7 @@ This is a command that has to be installed in `calendar-mode-map'." (let ((day (get-text-property (min (1- (point-max)) (point)) 'day)) date s) (unless day - (error "Don't know which date to convert")) + (user-error "Don't know which date to convert")) (setq date (calendar-gregorian-from-absolute day)) (setq s (concat "Gregorian: " (calendar-date-string date) "\n" @@ -8960,14 +9605,17 @@ This is a command that has to be installed in `calendar-mode-map'." (let* ((m (org-get-at-bol 'org-hd-marker)) ov) (unless (org-agenda-bulk-marked-p) - (unless m (error "Nothing to mark at point")) + (unless m (user-error "Nothing to mark at point")) (push m org-agenda-bulk-marked-entries) (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol)))) (org-overlay-display ov (concat org-agenda-bulk-mark-char " ") (org-get-todo-face "TODO") 'evaporate) (overlay-put ov 'type 'org-marked-entry-overlay)) - (beginning-of-line 2) + (end-of-line 1) + (or (ignore-errors + (goto-char (next-single-property-change (point) 'txt))) + (beginning-of-line 2)) (while (and (get-char-property (point) 'invisible) (not (eobp))) (beginning-of-line 2)) (message "%d entries marked for bulk action" @@ -8981,12 +9629,13 @@ This is a command that has to be installed in `calendar-mode-map'." (defun org-agenda-bulk-mark-regexp (regexp) "Mark entries matching REGEXP for future agenda bulk action." (interactive "sMark entries matching regexp: ") - (let ((entries-marked 0)) + (let ((entries-marked 0) txt-at-point) (save-excursion (goto-char (point-min)) (goto-char (next-single-property-change (point) 'txt)) - (while (re-search-forward regexp nil t) - (when (string-match regexp (get-text-property (point) 'txt)) + (while (and (re-search-forward regexp nil t) + (setq txt-at-point (get-text-property (point) 'txt))) + (when (string-match regexp txt-at-point) (setq entries-marked (1+ entries-marked)) (call-interactively 'org-agenda-bulk-mark)))) (if (not entries-marked) @@ -9003,15 +9652,27 @@ This is a command that has to be installed in `calendar-mode-map'." (setq org-agenda-bulk-marked-entries (delete (org-get-at-bol 'org-hd-marker) org-agenda-bulk-marked-entries)) - (beginning-of-line 2) + (end-of-line 1) + (or (ignore-errors + (goto-char (next-single-property-change (point) 'txt))) + (beginning-of-line 2)) (while (and (get-char-property (point) 'invisible) (not (eobp))) (beginning-of-line 2)) (message "%d entries left marked for bulk action" (length org-agenda-bulk-marked-entries))) (t (message "No entry to unmark here"))))) +(defun org-agenda-bulk-toggle-all () + "Toggle all marks for bulk action." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (ignore-errors + (goto-char (next-single-property-change (point) 'txt))) + (org-agenda-bulk-toggle)))) + (defun org-agenda-bulk-toggle () - "Toggle marking the entry at point for bulk action." + "Toggle the mark at point for bulk action." (interactive) (if (org-agenda-bulk-marked-p) (org-agenda-bulk-unmark) @@ -9052,14 +9713,14 @@ bulk action." The prefix arg is passed through to the command if possible." (interactive "P") ;; Make sure we have markers, and only valid ones - (unless org-agenda-bulk-marked-entries (error "No entries are marked")) + (unless org-agenda-bulk-marked-entries (user-error "No entries are marked")) (mapc (lambda (m) (unless (and (markerp m) (marker-buffer m) (buffer-live-p (marker-buffer m)) (marker-position m)) - (error "Marker %s for bulk command is invalid" m))) + (user-error "Marker %s for bulk command is invalid" m))) org-agenda-bulk-marked-entries) ;; Prompt for the bulk command @@ -9138,7 +9799,7 @@ The prefix arg is passed through to the command if possible." ((equal action ?S) (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo)) - (error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type) + (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type) (let ((days (read-number (format "Scatter tasks across how many %sdays: " (if arg "week" "")) 7))) @@ -9176,7 +9837,7 @@ The prefix arg is passed through to the command if possible." (org-icompleting-read "Function: " obarray 'fboundp t nil nil))))) - (t (error "Invalid bulk action"))) + (t (user-error "Invalid bulk action"))) ;; Sort the markers, to make sure that parents are handled before children (setq entries (sort entries @@ -9210,15 +9871,43 @@ The prefix arg is passed through to the command if possible." (if (not org-agenda-persistent-marks) "" " (kept marked)")))))) -(defun org-agenda-capture () - "Call `org-capture' with the date at point." - (interactive) +(defun org-agenda-capture (&optional with-time) + "Call `org-capture' with the date at point. +With a `C-1' prefix, use the HH:MM value at point (if any) or the +current HH:MM time." + (interactive "P") (if (not (eq major-mode 'org-agenda-mode)) - (error "You cannot do this outside of agenda buffers") + (user-error "You cannot do this outside of agenda buffers") (let ((org-overriding-default-time - (org-get-cursor-date))) + (org-get-cursor-date (equal with-time 1)))) (call-interactively 'org-capture)))) +;;; Dragging agenda lines forward/backward + +(defun org-agenda-drag-line-forward (arg) + "Drag an agenda line forward by ARG lines." + (interactive "p") + (let ((inhibit-read-only t) lst) + (if (save-excursion + (dotimes (n arg) + (beginning-of-line 2) + (push (not (get-text-property (point) 'txt)) lst)) + (delq nil lst)) + (message "Cannot move line forward") + (org-drag-line-forward arg)))) + +(defun org-agenda-drag-line-backward (arg) + "Drag an agenda line backward by ARG lines." + (interactive "p") + (let ((inhibit-read-only t) lst) + (if (save-excursion + (dotimes (n arg) + (beginning-of-line 0) + (push (not (get-text-property (point) 'txt)) lst)) + (delq nil lst)) + (message "Cannot move line backward") + (org-drag-line-backward arg)))) + ;;; Flagging notes (defun org-agenda-show-the-flagging-note () @@ -9230,7 +9919,7 @@ tag and (if present) the flagging note." (win (selected-window)) note heading newhead) (unless hdmarker - (error "No linked entry at point")) + (user-error "No linked entry at point")) (if (and (eq this-command last-command) (y-or-n-p "Unflag and remove any flagging note? ")) (progn @@ -9240,7 +9929,7 @@ tag and (if present) the flagging note." (message "Entry unflagged")) (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE")) (unless note - (error "No flagging note")) + (user-error "No flagging note")) (org-kill-new note) (org-switch-to-buffer-other-window "*Flagging Note*") (erase-buffer) @@ -9296,7 +9985,8 @@ will only add headlines containing IMPORTANT or headlines belonging to the \"Work\" category. ARGS are symbols indicating what kind of entries to consider. -By default `org-agenda-to-appt' will use :deadline, :scheduled +By default `org-agenda-to-appt' will use :deadline*, :scheduled* +\(i.e., deadlines and scheduled items with a hh:mm specification) and :timestamp entries. See the docstring of `org-diary' for details and examples. @@ -9307,7 +9997,7 @@ to override `appt-message-warning-time'." (if (eq filter t) (setq filter (read-from-minibuffer "Regexp filter: "))) (let* ((cnt 0) ; count added events - (scope (or args '(:deadline :scheduled :timestamp))) + (scope (or args '(:deadline* :scheduled* :timestamp))) (org-agenda-new-buffers nil) (org-deadline-warning-days 0) ;; Do not use `org-today' here because appt only takes @@ -9329,7 +10019,10 @@ to override `appt-message-warning-time'." ;; Map thru entries and find if we should filter them out (mapc (lambda(x) - (let* ((evt (org-trim (or (get-text-property 1 'txt x) ""))) + (let* ((evt (org-trim + (replace-regexp-in-string + org-bracket-link-regexp "\\3" + (or (get-text-property 1 'txt x) "")))) (cat (get-text-property 1 'org-category x)) (tod (get-text-property 1 'time-of-day x)) (ok (or (null filter) diff --git a/lisp/org-archive.el b/lisp/org-archive.el index 2fcfc8634..d5bdff16f 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -71,6 +71,15 @@ This variable is obsolete and has no effect anymore, instead add or remove :group 'org-archive :type 'boolean) +(defcustom org-archive-file-header-format "\nArchived entries from file %s\n\n" + "The header format string for newly created archive files. +When nil, no header will be inserted. +When a string, a %s formatter will be replaced by the file name." + :group 'org-archive + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + (defcustom org-archive-subtree-add-inherited-tags 'infile "Non-nil means append inherited tags when archiving a subtree." :group 'org-archive @@ -278,9 +287,9 @@ this heading." (let ((org-insert-mode-line-in-empty-file t) (org-inhibit-startup t)) (call-interactively 'org-mode))) - (when newfile-p + (when (and newfile-p org-archive-file-header-format) (goto-char (point-max)) - (insert (format "\nArchived entries from file %s\n\n" + (insert (format org-archive-file-header-format (buffer-file-name this-buffer)))) (when datetree-date (require 'org-datetree) diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el deleted file mode 100644 index c5a4b3775..000000000 --- a/lisp/org-ascii.el +++ /dev/null @@ -1,730 +0,0 @@ -;;; org-ascii.el --- ASCII export for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;;; Code: - -(require 'org-exp) - -(eval-when-compile - (require 'cl)) - -(defgroup org-export-ascii nil - "Options specific for ASCII export of Org-mode files." - :tag "Org Export ASCII" - :group 'org-export) - -(defcustom org-export-ascii-underline '(?\= ?\- ?\~ ?\^ ?\. ?\# ?\$) - "Characters for underlining headings in ASCII export. -In the given sequence, these characters will be used for level 1, 2, ..." - :group 'org-export-ascii - :type '(repeat character)) - -(defcustom org-export-ascii-bullets '(?* ?+ ?-) - "Bullet characters for headlines converted to lists in ASCII export. -The first character is used for the first lest level generated in this -way, and so on. If there are more levels than characters given here, -the list will be repeated. -Note that plain lists will keep the same bullets as the have in the -Org-mode file." - :group 'org-export-ascii - :type '(repeat character)) - -(defcustom org-export-ascii-links-to-notes t - "Non-nil means convert links to notes before the next headline. -When nil, the link will be exported in place. If the line becomes long -in this way, it will be wrapped." - :group 'org-export-ascii - :type 'boolean) - -(defcustom org-export-ascii-table-keep-all-vertical-lines nil - "Non-nil means keep all vertical lines in ASCII tables. -When nil, vertical lines will be removed except for those needed -for column grouping." - :group 'org-export-ascii - :type 'boolean) - -(defcustom org-export-ascii-table-widen-columns t - "Non-nil means widen narrowed columns for export. -When nil, narrowed columns will look in ASCII export just like in org-mode, -i.e. with \"=>\" as ellipsis." - :group 'org-export-ascii - :type 'boolean) - -(defvar org-export-ascii-entities 'ascii - "The ascii representation to be used during ascii export. -Possible values are: - -ascii Only use plain ASCII characters -latin1 Include Latin-1 character -utf8 Use all UTF-8 characters") - -;;; Hooks - -(defvar org-export-ascii-final-hook nil - "Hook run at the end of ASCII export, in the new buffer.") - -;;; ASCII export - -(defvar org-ascii-current-indentation nil) ; For communication - -;;;###autoload -(defun org-export-as-latin1 (&rest args) - "Like `org-export-as-ascii', use latin1 encoding for special symbols." - (interactive) - (org-export-as-encoding 'org-export-as-ascii (org-called-interactively-p 'any) - 'latin1 args)) - -;;;###autoload -(defun org-export-as-latin1-to-buffer (&rest args) - "Like `org-export-as-ascii-to-buffer', use latin1 encoding for symbols." - (interactive) - (org-export-as-encoding 'org-export-as-ascii-to-buffer - (org-called-interactively-p 'any) 'latin1 args)) - -;;;###autoload -(defun org-export-as-utf8 (&rest args) - "Like `org-export-as-ascii', use encoding for special symbols." - (interactive) - (org-export-as-encoding 'org-export-as-ascii - (org-called-interactively-p 'any) - 'utf8 args)) - -;;;###autoload -(defun org-export-as-utf8-to-buffer (&rest args) - "Like `org-export-as-ascii-to-buffer', use utf8 encoding for symbols." - (interactive) - (org-export-as-encoding 'org-export-as-ascii-to-buffer - (org-called-interactively-p 'any) 'utf8 args)) - -(defun org-export-as-encoding (command interactivep encoding &rest args) - (let ((org-export-ascii-entities encoding)) - (if interactivep - (call-interactively command) - (apply command args)))) - - -;;;###autoload -(defun org-export-as-ascii-to-buffer (arg) - "Call `org-export-as-ascii` with output to a temporary buffer. -No file is created. The prefix ARG is passed through to `org-export-as-ascii'." - (interactive "P") - (org-export-as-ascii arg nil "*Org ASCII Export*") - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window "*Org ASCII Export*"))) - -;;;###autoload -(defun org-replace-region-by-ascii (beg end) - "Assume the current region has org-mode syntax, and convert it to plain ASCII. -This can be used in any buffer. For example, you could write an -itemized list in org-mode syntax in a Mail buffer and then use this -command to convert it." - (interactive "r") - (let (reg ascii buf pop-up-frames) - (save-window-excursion - (if (derived-mode-p 'org-mode) - (setq ascii (org-export-region-as-ascii - beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq ascii (org-export-region-as-ascii - (point-min) (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert ascii))) - -;;;###autoload -(defun org-export-region-as-ascii (beg end &optional body-only buffer) - "Convert region from BEG to END in org-mode buffer to plain ASCII. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted ASCII. If BUFFER is the symbol `string', return the -produced ASCII as a string and leave not buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq ascii (org-export-region-as-ascii beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (interactive "r\nP") - (when (org-called-interactively-p 'any) - (setq buffer "*Org ASCII Export*")) - (let ((transient-mark-mode t) (zmacs-regions t) - ext-plist rtn) - (setq ext-plist (plist-put ext-plist :ignore-subtree-p t)) - (goto-char end) - (set-mark (point)) ;; to activate the region - (goto-char beg) - (setq rtn (org-export-as-ascii nil ext-plist buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (org-called-interactively-p 'any) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -;;;###autoload -(defun org-export-as-ascii (arg &optional ext-plist to-buffer body-only pub-dir) - "Export the outline as a pretty ASCII file. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -underlined headlines, default is 3. Lower levels will become bulleted -lists. EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local -settings. When TO-BUFFER is non-nil, create a buffer with that -name and export to that buffer. If TO-BUFFER is the symbol -`string', don't leave any buffer behind but just return the -resulting ASCII as a string. When BODY-ONLY is set, don't produce -the file header and footer. When PUB-DIR is set, use this as the -publishing directory." - (interactive "P") - (run-hooks 'org-export-first-hook) - (setq-default org-todo-line-regexp org-todo-line-regexp) - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist))) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (level-offset (if subtree-p - (save-excursion - (goto-char rbeg) - (+ (funcall outline-level) - (if org-odd-levels-only 1 0))) - 0)) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-export-directory :html opt-plist))) - (org-current-export-file buffer-file-name) - (custom-times org-display-custom-times) - (org-ascii-current-indentation '(0 . 0)) - (level 0) line txt - (umax nil) - (umax-toc nil) - (case-fold-search nil) - (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) - (filename (if to-buffer - nil - (concat (file-name-as-directory - (or pub-dir - (org-export-directory :ascii opt-plist))) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory bfname))) - ".txt"))) - (filename (and filename - (if (equal (file-truename filename) - (file-truename bfname)) - (concat filename ".txt") - filename))) - (buffer (if to-buffer - (cond - ((eq to-buffer 'string) - (get-buffer-create "*Org ASCII Export*")) - (t (get-buffer-create to-buffer))) - (find-file-noselect filename))) - (org-levels-open (make-vector org-level-max nil)) - (odd org-odd-levels-only) - (date (plist-get opt-plist :date)) - (author (plist-get opt-plist :author)) - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and (buffer-file-name) - (file-name-sans-extension - (file-name-nondirectory bfname))) - "UNTITLED")) - (email (plist-get opt-plist :email)) - (language (plist-get opt-plist :language)) - (quote-re0 (concat "^\\(" org-quote-string "\\)\\( +\\|[ \t]*$\\)")) - (todo nil) - (lang-words nil) - (region - (buffer-substring - (if (org-region-active-p) (region-beginning) (point-min)) - (if (org-region-active-p) (region-end) (point-max)))) - (org-export-footnotes-seen nil) - (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) - (lines (org-split-string - (org-export-preprocess-string - region - :for-backend 'ascii - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get opt-plist :drawers) - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :timestamps (plist-get opt-plist :timestamps) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :verbatim-multiline t - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :archived-trees - (plist-get opt-plist :archived-trees) - :add-text (plist-get opt-plist :text)) - "\n")) - thetoc have-headings first-heading-pos - table-open table-buffer link-buffer link type path desc desc0 rpl wrap fnc) - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (setq org-min-level (org-get-min-level lines level-offset)) - (setq org-last-level org-min-level) - (org-init-section-numbers) - (setq lang-words (or (assoc language org-export-language-setup) - (assoc "en" org-export-language-setup))) - (set-buffer buffer) - (erase-buffer) - (fundamental-mode) - (org-install-letbind) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (org-set-local 'org-odd-levels-only odd) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc (if (integerp org-export-with-toc) - (min org-export-with-toc umax) - umax)) - - ;; File header - (unless body-only - (when (and title (not (string= "" title))) - (org-insert-centered title ?=) - (insert "\n")) - - (if (and (or author email) - org-export-author-info) - (insert (concat (nth 1 lang-words) ": " (or author "") - (if (and org-export-email-info - email (string-match "\\S-" email)) - (concat " <" email ">") "") - "\n"))) - - (cond - ((and date (string-match "%" date)) - (setq date (format-time-string date))) - (date) - (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) - - (if (and date org-export-time-stamp-file) - (insert (concat (nth 2 lang-words) ": " date"\n"))) - - (unless (= (point) (point-min)) - (insert "\n\n"))) - - (if (and org-export-with-toc (not body-only)) - (progn - (push (concat (nth 3 lang-words) "\n") thetoc) - (push (concat (make-string (string-width (nth 3 lang-words)) ?=) - "\n") thetoc) - (mapc #'(lambda (line) - (if (string-match org-todo-line-regexp - line) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (match-string 3 line) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) - ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (setq txt (org-html-expand-for-ascii txt)) - - (while (string-match org-bracket-link-regexp txt) - (setq txt - (replace-match - (match-string (if (match-end 2) 3 1) txt) - t t txt))) - - (if (and (memq org-export-with-tags '(not-in-toc nil)) - (string-match - (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$") - txt)) - (setq txt (replace-match "" t t txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt 1))) - - (if org-export-with-section-numbers - (setq txt (concat (org-section-number level) - " " txt))) - (if (<= level umax-toc) - (progn - (push - (concat - (make-string - (* (max 0 (- level org-min-level)) 4) ?\ ) - (format (if todo "%s (*)\n" "%s\n") txt)) - thetoc) - (setq org-last-level level)) - )))) - lines) - (setq thetoc (if have-headings (nreverse thetoc) nil)))) - - (org-init-section-numbers) - (while (setq line (pop lines)) - (when (and link-buffer (string-match org-outline-regexp-bol line)) - (org-export-ascii-push-links (nreverse link-buffer)) - (setq link-buffer nil)) - (setq wrap nil) - ;; Remove the quoted HTML tags. - (setq line (org-html-expand-for-ascii line)) - ;; Replace links with the description when possible - (while (string-match org-bracket-link-analytic-regexp++ line) - (setq path (match-string 3 line) - link (concat (match-string 1 line) path) - type (match-string 2 line) - desc0 (match-string 5 line) - desc0 (replace-regexp-in-string "\\\\_" "_" desc0) - desc (or desc0 link) - desc (replace-regexp-in-string "\\\\_" "_" desc)) - (if (and (> (length link) 8) - (equal (substring link 0 8) "coderef:")) - (setq line (replace-match - (format (org-export-get-coderef-format (substring link 8) desc) - (cdr (assoc - (substring link 8) - org-export-code-refs))) - t t line)) - (setq rpl (concat "[" desc "]")) - (if (functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - (setq rpl (or (save-match-data - (funcall fnc (org-link-unescape path) - desc0 'ascii)) - rpl)) - (when (and desc0 (not (equal desc0 link))) - (if org-export-ascii-links-to-notes - (push (cons desc0 link) link-buffer) - (setq rpl (concat rpl " (" link ")") - wrap (+ (length line) (- (length (match-string 0 line))) - (length desc)))))) - (setq line (replace-match rpl t t line)))) - (when custom-times - (setq line (org-translate-time line))) - (cond - ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) - ;; a Headline - (setq first-heading-pos (or first-heading-pos (point))) - (setq level (org-tr-level (- (match-end 1) (match-beginning 1) - level-offset)) - txt (match-string 2 line)) - (org-ascii-level-start level txt umax lines)) - - ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) - (if (not table-open) - ;; New table starts - (setq table-open t table-buffer nil)) - ;; Accumulate lines - (setq table-buffer (cons line table-buffer)) - (when (or (not lines) - (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" - (car lines)))) - (setq table-open nil - table-buffer (nreverse table-buffer)) - (insert (mapconcat - (lambda (x) - (org-fix-indentation x org-ascii-current-indentation)) - (org-format-table-ascii table-buffer) - "\n") "\n"))) - (t - (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" - line) - (setq line (replace-match "\\1\\3:" t nil line))) - (setq line (org-fix-indentation line org-ascii-current-indentation)) - ;; Remove forced line breaks - (if (string-match "\\\\\\\\[ \t]*$" line) - (setq line (replace-match "" t t line))) - (if (and org-export-with-fixed-width - (string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line)) - (setq line (replace-match "\\1" nil nil line)) - (if wrap (setq line (org-export-ascii-wrap line wrap)))) - (insert line "\n")))) - - (org-export-ascii-push-links (nreverse link-buffer)) - - (normal-mode) - - ;; insert the table of contents - (when thetoc - (goto-char (point-min)) - (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t) - (progn - (goto-char (match-beginning 0)) - (replace-match "")) - (goto-char first-heading-pos)) - (mapc 'insert thetoc) - (or (looking-at "[ \t]*\n[ \t]*\n") - (insert "\n\n"))) - - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (make-string (- end beg) ?\ )))) - - ;; remove display and invisible chars - (let (beg end) - (goto-char (point-min)) - (while (setq beg (next-single-property-change (point) 'display)) - (setq end (next-single-property-change beg 'display)) - (delete-region beg end) - (goto-char beg) - (insert "=>")) - (goto-char (point-min)) - (while (setq beg (next-single-property-change (point) 'org-cwidth)) - (setq end (next-single-property-change beg 'org-cwidth)) - (delete-region beg end) - (goto-char beg))) - (run-hooks 'org-export-ascii-final-hook) - (or to-buffer (save-buffer)) - (goto-char (point-min)) - (or (org-export-push-to-kill-ring "ASCII") - (message "Exporting... done")) - ;; Return the buffer or a string, according to how this function was called - (if (eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer))) - (current-buffer)))) - -;;;###autoload -(defun org-export-ascii-preprocess (parameters) - "Do extra work for ASCII export." - ;; - ;; Realign tables to get rid of narrowing - (when org-export-ascii-table-widen-columns - (let ((org-table-do-narrow nil)) - (goto-char (point-min)) - (org-ascii-replace-entities) - (goto-char (point-min)) - (org-table-map-tables - (lambda () (org-if-unprotected (org-table-align))) - 'quietly))) - ;; Put quotes around verbatim text - (goto-char (point-min)) - (while (re-search-forward org-verbatim-re nil t) - (org-if-unprotected-at (match-beginning 4) - (goto-char (match-end 2)) - (backward-delete-char 1) (insert "'") - (goto-char (match-beginning 2)) - (delete-char 1) (insert "`") - (goto-char (match-end 2)))) - ;; Remove target markers - (goto-char (point-min)) - (while (re-search-forward "<<]*\\)>>>?\\([ \t]*\\)" nil t) - (org-if-unprotected-at (match-beginning 1) - (replace-match "\\1\\2"))) - ;; Remove list start counters - (goto-char (point-min)) - (while (org-list-search-forward - "\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*" nil t) - (replace-match "")) - (remove-text-properties - (point-min) (point-max) - '(face nil font-lock-fontified nil font-lock-multiline nil line-prefix nil wrap-prefix nil))) - -(defun org-html-expand-for-ascii (line) - "Handle quoted HTML for ASCII export." - (if org-export-html-expand - (while (string-match "@<[^<>\n]*>" line) - ;; We just remove the tags for now. - (setq line (replace-match "" nil nil line)))) - line) - -(defun org-ascii-replace-entities () - "Replace entities with the ASCII representation." - (let (e) - (while (re-search-forward "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" nil t) - (org-if-unprotected-at (match-beginning 1) - (setq e (org-entity-get-representation (match-string 1) - org-export-ascii-entities)) - (and e (replace-match e t t)))))) - -(defun org-export-ascii-wrap (line where) - "Wrap LINE at or before WHERE." - (let ((ind (org-get-indentation line)) - pos) - (catch 'found - (loop for i from where downto (/ where 2) do - (and (equal (aref line i) ?\ ) - (setq pos i) - (throw 'found t)))) - (if pos - (concat (substring line 0 pos) "\n" - (make-string ind ?\ ) - (substring line (1+ pos))) - line))) - -(defun org-export-ascii-push-links (link-buffer) - "Push out links in the buffer." - (when link-buffer - ;; We still have links to push out. - (insert "\n") - (let ((ind "")) - (save-match-data - (if (save-excursion - (re-search-backward - (concat "^\\(\\([ \t]*\\)\\|\\(" - org-outline-regexp - "\\)\\)[^ \t\n]") nil t)) - (setq ind (or (match-string 2) - (make-string (length (match-string 3)) ?\ ))))) - (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n")) - link-buffer)) - (insert "\n"))) - -(defun org-ascii-level-start (level title umax &optional lines) - "Insert a new level in ASCII export." - (let (char (n (- level umax 1)) (ind 0)) - (if (> level umax) - (progn - (insert (make-string (* 2 n) ?\ ) - (char-to-string (nth (% n (length org-export-ascii-bullets)) - org-export-ascii-bullets)) - " " title "\n") - ;; find the indentation of the next non-empty line - (catch 'stop - (while lines - (if (string-match "^\\* " (car lines)) (throw 'stop nil)) - (if (string-match "^\\([ \t]*\\)\\S-" (car lines)) - (throw 'stop (setq ind (org-get-indentation (car lines))))) - (pop lines))) - (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind))) - (if (or (not (equal (char-before) ?\n)) - (not (equal (char-before (1- (point))) ?\n))) - (insert "\n")) - (setq char (or (nth (1- level) org-export-ascii-underline) - (car (last org-export-ascii-underline)))) - (unless org-export-with-tags - (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) - (setq title (replace-match "" t t title)))) - (if org-export-with-section-numbers - (setq title (concat (org-section-number level) " " title))) - (insert title "\n" (make-string (string-width title) char) "\n") - (setq org-ascii-current-indentation '(0 . 0))))) - -(defun org-insert-centered (s &optional underline) - "Insert the string S centered and underline it with character UNDERLINE." - (let ((ind (max (/ (- fill-column (string-width s)) 2) 0))) - (insert (make-string ind ?\ ) s "\n") - (if underline - (insert (make-string ind ?\ ) - (make-string (string-width s) underline) - "\n")))) - -(defvar org-table-colgroup-info nil) -(defun org-format-table-ascii (lines) - "Format a table for ascii export." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (not (string-match "^[ \t]*|" (car lines))) - ;; Table made by table.el - test for spanning - lines - - ;; A normal org table - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; column and the special lines - (setq lines (org-table-clean-before-export lines))) - ;; Get rid of the vertical lines except for grouping - (if org-export-ascii-table-keep-all-vertical-lines - lines - (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info)) - rtn line vl1 start) - (while (setq line (pop lines)) - (if (string-match org-table-hline-regexp line) - (and (string-match "|\\(.*\\)|" line) - (setq line (replace-match " \\1" t nil line))) - (setq start 0 vl1 vl) - (while (string-match "|" line start) - (setq start (match-end 0)) - (or (pop vl1) (setq line (replace-match " " t t line))))) - (push line rtn)) - (nreverse rtn))))) - -(defun org-colgroup-info-to-vline-list (info) - (let (vl new last) - (while info - (setq last new new (pop info)) - (if (or (memq last '(:end :startend)) - (memq new '(:start :startend))) - (push t vl) - (push nil vl))) - (setq vl (nreverse vl)) - (and vl (setcar vl nil)) - vl)) - -(provide 'org-ascii) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-ascii.el ends here diff --git a/lisp/org-attach.el b/lisp/org-attach.el index 3e665b79d..faefa6b14 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -54,6 +54,15 @@ where the Org file lives." :group 'org-attach :type 'directory) +(defcustom org-attach-git-annex-cutoff (* 32 1024) + "If non-nil, files larger than this will be annexed instead of stored." + :group 'org-attach + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "None" nil) + (integer :tag "Bytes"))) + (defcustom org-attach-auto-tag "ATTACH" "Tag that will be triggered automatically when an entry has an attachment." :group 'org-attach @@ -252,18 +261,31 @@ the ATTACH_DIR property) their own attachment directory." (defun org-attach-commit () "Commit changes to git if `org-attach-directory' is properly initialized. This checks for the existence of a \".git\" directory in that directory." - (let ((dir (expand-file-name org-attach-directory))) + (let ((dir (expand-file-name org-attach-directory)) + (changes 0)) (when (file-exists-p (expand-file-name ".git" dir)) (with-temp-buffer (cd dir) - (shell-command "git add .") - (shell-command "git ls-files --deleted" t) - (mapc #'(lambda (file) - (unless (string= file "") - (shell-command - (concat "git rm \"" file "\"")))) - (split-string (buffer-string) "\n")) - (shell-command "git commit -m 'Synchronized attachments'"))))) + (let ((have-annex + (and org-attach-git-annex-cutoff + (file-exists-p (expand-file-name ".git/annex" dir))))) + (dolist (new-or-modified + (split-string + (shell-command-to-string + "git ls-files -zmo --exclude-standard") "\0" t)) + (if (and have-annex + (>= (nth 7 (file-attributes new-or-modified)) + org-attach-git-annex-cutoff)) + (call-process "git" nil nil nil "annex" "add" new-or-modified) + (call-process "git" nil nil nil "add" new-or-modified)) + (incf changes))) + (dolist (deleted + (split-string + (shell-command-to-string "git ls-files -z --deleted") "\0" t)) + (call-process "git" nil nil nil "rm" deleted) + (incf changes)) + (when (> changes 0) + (shell-command "git commit -m 'Synchronized attachments'")))))) (defun org-attach-tag (&optional off) "Turn the autotag on or (if OFF is set) off." @@ -405,14 +427,14 @@ This ignores files starting with a \".\", and files ending in \"~\"." (directory-files dir nil "[^~]\\'")))) (defun org-attach-reveal (&optional if-exists) - "Show the attachment directory of the current task in dired." + "Show the attachment directory of the current task. +This will attempt to use an external program to show the directory." (interactive "P") (let ((attach-dir (org-attach-dir (not if-exists)))) (and attach-dir (org-open-file attach-dir)))) (defun org-attach-reveal-in-emacs () - "Show the attachment directory of the current task. -This will attempt to use an external program to show the directory." + "Show the attachment directory of the current task in dired." (interactive) (let ((attach-dir (org-attach-dir t))) (dired attach-dir))) diff --git a/lisp/org-bbdb.el b/lisp/org-bbdb.el index a45a26f0f..f122b67ea 100644 --- a/lisp/org-bbdb.el +++ b/lisp/org-bbdb.el @@ -116,8 +116,10 @@ (declare-function bbdb-search-name "ext:bbdb-com" (regexp &optional layout)) (declare-function bbdb-search-organization "ext:bbdb-com" (regexp &optional layout)) -;; `bbdb-record-note' is part of BBDB v3.x +;; `bbdb-record-note' was part of BBDB v3.x (declare-function bbdb-record-note "ext:bbdb" (record label)) +;; `bbdb-record-xfield' replaces it in recent BBDB v3.x+ +(declare-function bbdb-record-xfield "ext:bbdb" (record label)) (declare-function calendar-leap-year-p "calendar" (year)) (declare-function diary-ordinal-suffix "diary-lib" (n)) @@ -306,14 +308,17 @@ The hash table is created on first use.") "Create a hash with anniversaries extracted from BBDB, for fast access. The anniversaries are assumed to be stored `org-bbdb-anniversary-field'." (let ((old-bbdb (fboundp 'bbdb-record-getprop)) + (record-func (if (fboundp 'bbdb-record-xfield) + 'bbdb-record-xfield + 'bbdb-record-note)) split tmp annivs) (clrhash org-bbdb-anniv-hash) (dolist (rec (bbdb-records)) (when (setq annivs (if old-bbdb (bbdb-record-getprop rec org-bbdb-anniversary-field) - (bbdb-record-note - rec org-bbdb-anniversary-field))) + (funcall record-func + rec org-bbdb-anniversary-field))) (setq annivs (if old-bbdb (bbdb-split annivs "\n") ;; parameter order is reversed in new bbdb diff --git a/lisp/org-beamer.el b/lisp/org-beamer.el deleted file mode 100644 index 78b57a4c0..000000000 --- a/lisp/org-beamer.el +++ /dev/null @@ -1,657 +0,0 @@ -;;; org-beamer.el --- Beamer-specific LaTeX export for org-mode -;; -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik -;; Maintainer: Carsten Dominik -;; Keywords: org, wp, tex - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; -;; This library implement the special treatment needed by using the -;; beamer class during LaTeX export. - -;;; Code: - -(require 'org) -(require 'org-exp) - -(defvar org-export-latex-header) -(defvar org-export-latex-options-plist) -(defvar org-export-opt-plist) - -(defgroup org-beamer nil - "Options specific for using the beamer class in LaTeX export." - :tag "Org Beamer" - :group 'org-export-latex) - -(defcustom org-beamer-use-parts nil - "" - :group 'org-beamer - :version "24.1" - :type 'boolean) - -(defcustom org-beamer-frame-level 1 - "The level that should be interpreted as a frame. -The levels above this one will be translated into a sectioning structure. -Setting this to 2 will allow sections, 3 will allow subsections as well. -You can set this to 4 as well, if you at the same time set -`org-beamer-use-parts' to make the top levels `\part'." - :group 'org-beamer - :version "24.1" - :type '(choice - (const :tag "Frames need a BEAMER_env property" nil) - (integer :tag "Specific level makes a frame"))) - -(defcustom org-beamer-frame-default-options "" - "Default options string to use for frames, should contains the [brackets]. -And example for this is \"[allowframebreaks]\"." - :group 'org-beamer - :version "24.1" - :type '(string :tag "[options]")) - -(defcustom org-beamer-column-view-format - "%45ITEM %10BEAMER_env(Env) %10BEAMER_envargs(Env Args) %4BEAMER_col(Col) %8BEAMER_extra(Extra)" - "Default column view format that should be used to fill the template." - :group 'org-beamer - :version "24.1" - :type '(choice - (const :tag "Do not insert Beamer column view format" nil) - (string :tag "Beamer column view format"))) - -(defcustom org-beamer-themes - "\\usetheme{default}\\usecolortheme{default}" - "Default string to be used for extra heading stuff in beamer presentations. -When a beamer template is filled, this will be the default for -BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}." - :group 'org-beamer - :version "24.1" - :type '(choice - (const :tag "Do not insert Beamer themes" nil) - (string :tag "Beamer themes"))) - -(defconst org-beamer-column-widths - "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC" - "The column widths that should be installed as allowed property values.") - -(defconst org-beamer-transitions - "\transblindsvertical \transblindshorizontal \transboxin \transboxout \transdissolve \transduration \transglitter \transsplithorizontalin \transsplithorizontalout \transsplitverticalin \transsplitverticalout \transwipe :ETC" - "Transitions available for beamer. -These are just a completion help.") - -(defconst org-beamer-environments-default - '(("frame" "f" "dummy- special handling hard coded" "dummy") - ("columns" "C" "\\begin{columns}%o %% %h%x" "\\end{columns}") - ("column" "c" "\\begin{column}%o{%h\\textwidth}%x" "\\end{column}") - ("block" "b" "\\begin{block}%a{%h}%x" "\\end{block}") - ("alertblock" "a" "\\begin{alertblock}%a{%h}%x" "\\end{alertblock}") - ("verse" "v" "\\begin{verse}%a %% %h%x" "\\end{verse}") - ("quotation" "q" "\\begin{quotation}%a %% %h%x" "\\end{quotation}") - ("quote" "Q" "\\begin{quote}%a %% %h%x" "\\end{quote}") - ("structureenv" "s" "\\begin{structureenv}%a %% %h%x" "\\end{structureenv}") - ("theorem" "t" "\\begin{theorem}%a%U%x" "\\end{theorem}") - ("definition" "d" "\\begin{definition}%a%U%x" "\\end{definition}") - ("example" "e" "\\begin{example}%a%U%x" "\\end{example}") - ("exampleblock" "E" "\\begin{exampleblock}%a{%h}%x" "\\end{exampleblock}") - ("proof" "p" "\\begin{proof}%a%U%x" "\\end{proof}") - ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}%x" "\\end{beamercolorbox}") - ("normal" "h" "%h" "") ; Emit the heading as normal text - ("note" "n" "\\note%o%a{%h" "}") - ("noteNH" "N" "\\note%o%a{" "}") ; note, ignore heading - ("ignoreheading" "i" "%%%% %h" "")) - "Environments triggered by properties in Beamer export. -These are the defaults - for user definitions, see -`org-beamer-environments-extra'. -\"normal\" is a special fake environment, which emit the heading as -normal text. It is needed when an environment should be surrounded -by normal text. Since beamer export converts nodes into environments, -you need to have a node to end the environment. -For example - - ** a frame - some text - *** Blocktitle :B_block: - inside the block - *** After the block :B_normal: - continuing here - ** next frame") - -(defcustom org-beamer-environments-extra nil - "Environments triggered by tags in Beamer export. -Each entry has 4 elements: - -name Name of the environment -key Selection key for `org-beamer-select-environment' -open The opening template for the environment, with the following escapes - %a the action/overlay specification - %A the default action/overlay specification - %o the options argument of the template - %h the headline text - %H if there is headline text, that text in {} braces - %U if there is headline text, that text in [] brackets - %x the content of the BEAMER_extra property -close The closing string of the environment." - - :group 'org-beamer - :version "24.1" - :type '(repeat - (list - (string :tag "Environment") - (string :tag "Selection key") - (string :tag "Begin") - (string :tag "End")))) - -(defcustom org-beamer-inherited-properties nil - "Properties that should be inherited during beamer export." - :group 'org-beamer - :type '(repeat - (string :tag "Property"))) - -(defvar org-beamer-frame-level-now nil) -(defvar org-beamer-header-extra nil) -(defvar org-beamer-export-is-beamer-p nil) -(defvar org-beamer-inside-frame-at-level nil) -(defvar org-beamer-columns-open nil) -(defvar org-beamer-column-open nil) - -(defun org-beamer-cleanup-column-width (width) - "Make sure the width is not empty, and that it has a unit." - (setq width (org-trim (or width ""))) - (unless (string-match "\\S-" width) (setq width "0.5")) - (if (string-match "\\`[.0-9]+\\'" width) - (setq width (concat width "\\textwidth"))) - width) - -(defun org-beamer-open-column (&optional width opt) - (org-beamer-close-column-maybe) - (setq org-beamer-column-open t) - (setq width (org-beamer-cleanup-column-width width)) - (insert (format "\\begin{column}%s{%s}\n" (or opt "") width))) -(defun org-beamer-close-column-maybe () - (when org-beamer-column-open - (setq org-beamer-column-open nil) - (insert "\\end{column}\n"))) -(defun org-beamer-open-columns-maybe (&optional opts) - (unless org-beamer-columns-open - (setq org-beamer-columns-open t) - (insert (format "\\begin{columns}%s\n" (or opts ""))))) -(defun org-beamer-close-columns-maybe () - (org-beamer-close-column-maybe) - (when org-beamer-columns-open - (setq org-beamer-columns-open nil) - (insert "\\end{columns}\n"))) - -(defun org-beamer-select-environment () - "Select the environment to be used by beamer for this entry. -While this uses (for convenience) a tag selection interface, the result -of this command will be that the BEAMER_env *property* of the entry is set. - -In addition to this, the command will also set a tag as a visual aid, but -the tag does not have any semantic meaning." - (interactive) - (let* ((envs (append org-beamer-environments-extra - org-beamer-environments-default)) - (org-tag-alist - (append '((:startgroup)) - (mapcar (lambda (e) (cons (concat "B_" (car e)) - (string-to-char (nth 1 e)))) - envs) - '((:endgroup)) - '(("BMCOL" . ?|)))) - (org-fast-tag-selection-single-key t)) - (org-set-tags) - (let ((tags (or (ignore-errors (org-get-tags-string)) ""))) - (cond - ((equal org-last-tag-selection-key ?|) - (if (string-match ":BMCOL:" tags) - (org-set-property "BEAMER_col" (read-string "Column width: ")) - (org-delete-property "BEAMER_col"))) - ((string-match (concat ":B_\\(" - (mapconcat 'car envs "\\|") - "\\):") - tags) - (org-entry-put nil "BEAMER_env" (match-string 1 tags))) - (t (org-entry-delete nil "BEAMER_env")))))) - -;;;###autoload -(defun org-beamer-sectioning (level text) - "Return the sectioning entry for the current headline. -LEVEL is the reduced level of the headline. -TEXT is the text of the headline, everything except the leading stars. -The return value is a cons cell. The car is the headline text, usually -just TEXT, but possibly modified if options have been extracted from the -text. The cdr is the sectioning entry, similar to what is given -in org-export-latex-classes." - (let* ((frame-level (or org-beamer-frame-level-now org-beamer-frame-level)) - (default - (if org-beamer-use-parts - '((1 . ("\\part{%s}" . "\\part*{%s}")) - (2 . ("\\section{%s}" . "\\section*{%s}")) - (3 . ("\\subsection{%s}" . "\\subsection*{%s}"))) - '((1 . ("\\section{%s}" . "\\section*{%s}")) - (2 . ("\\subsection{%s}" . "\\subsection*{%s}"))))) - (envs (append org-beamer-environments-extra - org-beamer-environments-default)) - (props (org-get-text-property-any 0 'org-props text)) - (in "") (out "") org-beamer-option org-beamer-action org-beamer-defaction org-beamer-environment org-beamer-extra - columns-option column-option - env have-text ass tmp) - (if (= frame-level 0) (setq frame-level nil)) - (when (and org-beamer-inside-frame-at-level - (<= level org-beamer-inside-frame-at-level)) - (setq org-beamer-inside-frame-at-level nil)) - (when (setq tmp (org-beamer-assoc-not-empty "BEAMER_col" props)) - (if (and (string-match "\\`[0-9.]+\\'" tmp) - (or (= (string-to-number tmp) 1.0) - (= (string-to-number tmp) 0.0))) - ;; column width 1 means close columns, go back to full width - (org-beamer-close-columns-maybe) - (when (setq ass (assoc "BEAMER_envargs" props)) - (let (case-fold-search) - (while (string-match "C\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass)) - (setq columns-option (match-string 1 (cdr ass))) - (setcdr ass (replace-match "" t t (cdr ass)))) - (while (string-match "c\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass)) - (setq column-option (match-string 1 (cdr ass))) - (setcdr ass (replace-match "" t t (cdr ass)))))) - (org-beamer-open-columns-maybe columns-option) - (org-beamer-open-column tmp column-option))) - (cond - ((or (equal (cdr (assoc "BEAMER_env" props)) "frame") - (and frame-level (= level frame-level))) - ;; A frame - (org-beamer-get-special props) - - (setq in (org-fill-template - "\\begin{frame}%a%A%o%T%S%x" - (list (cons "a" (or org-beamer-action "")) - (cons "A" (or org-beamer-defaction "")) - (cons "o" (or org-beamer-option org-beamer-frame-default-options "")) - (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) "")) - (cons "h" "%s") - (cons "T" (if (string-match "\\S-" text) - "\n\\frametitle{%s}" "")) - (cons "S" (if (string-match "\\\\\\\\" text) - "\n\\framesubtitle{%s}" "")))) - out (copy-sequence "\\end{frame}")) - (org-add-props out - '(org-insert-hook org-beamer-close-columns-maybe)) - (setq org-beamer-inside-frame-at-level level) - (cons text (list in out in out))) - ((and (setq env (cdr (assoc "BEAMER_env" props))) - (setq ass (assoc env envs))) - ;; A beamer environment selected by the BEAMER_env property - (if (string-match "[ \t]+:[ \t]*$" text) - (setq text (replace-match "" t t text))) - (if (member env '("note" "noteNH")) - ;; There should be no labels in a note, so we remove the targets - ;; FIXME??? - (remove-text-properties 0 (length text) '(target nil) text)) - (org-beamer-get-special props) - (setq text (org-trim text)) - (setq have-text (string-match "\\S-" text)) - (setq in (org-fill-template - (nth 2 ass) - (list (cons "a" (or org-beamer-action "")) - (cons "A" (or org-beamer-defaction "")) - (cons "o" (or org-beamer-option "")) - (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) "")) - (cons "h" "%s") - (cons "H" (if have-text (concat "{" text "}") "")) - (cons "U" (if have-text (concat "[" text "]") "")))) - out (nth 3 ass)) - (cond - ((equal out "\\end{columns}") - (setq org-beamer-columns-open t) - (setq out (org-add-props (copy-sequence out) - '(org-insert-hook - (lambda () - (org-beamer-close-column-maybe) - (setq org-beamer-columns-open nil)))))) - ((equal out "\\end{column}") - (org-beamer-open-columns-maybe))) - (cons text (list in out in out))) - ((and (not org-beamer-inside-frame-at-level) - (or (not frame-level) - (< level frame-level)) - (assoc level default)) - ;; Normal sectioning - (cons text (cdr (assoc level default)))) - (t nil)))) - -(defvar org-beamer-extra) -(defvar org-beamer-option) -(defvar org-beamer-action) -(defvar org-beamer-defaction) -(defvar org-beamer-environment) -(defun org-beamer-get-special (props) - "Extract an option, action, and default action string from text. -The variables org-beamer-option, org-beamer-action, org-beamer-defaction, -org-beamer-extra are all scoped into this function dynamically." - (let (tmp) - (setq org-beamer-environment (org-beamer-assoc-not-empty "BEAMER_env" props)) - (setq org-beamer-extra (org-beamer-assoc-not-empty "BEAMER_extra" props)) - (when org-beamer-extra - (setq org-beamer-extra (replace-regexp-in-string "\\\\n" "\n" org-beamer-extra))) - (setq tmp (org-beamer-assoc-not-empty "BEAMER_envargs" props)) - (when tmp - (setq tmp (copy-sequence tmp)) - (if (string-match "\\[<[^][<>]*>\\]" tmp) - (setq org-beamer-defaction (match-string 0 tmp) - tmp (replace-match "" t t tmp))) - (if (string-match "\\[[^][]*\\]" tmp) - (setq org-beamer-option (match-string 0 tmp) - tmp (replace-match "" t t tmp))) - (if (string-match "<[^<>]*>" tmp) - (setq org-beamer-action (match-string 0 tmp) - tmp (replace-match "" t t tmp)))))) - -(defun org-beamer-assoc-not-empty (elt list) - (let ((tmp (cdr (assoc elt list)))) - (and tmp (string-match "\\S-" tmp) tmp))) - - -(defvar org-beamer-mode-map (make-sparse-keymap) - "The keymap for `org-beamer-mode'.") -(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment) - -;;;###autoload -(define-minor-mode org-beamer-mode - "Special support for editing Org-mode files made to export to beamer." - nil " Bm" nil) -(when (fboundp 'font-lock-add-keywords) - (font-lock-add-keywords - 'org-mode - '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-beamer-tag prepend)) - 'prepent)) - -(defun org-beamer-place-default-actions-for-lists () - "Find default overlay specifications in items, and move them. -The need to be after the begin statement of the environment." - (when org-beamer-export-is-beamer-p - (let (dovl) - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*\\\\begin{\\(itemize\\|enumerate\\|description\\)}[ \t\n]*\\\\item\\>\\( ?\\(<[^<>\n]*>\\|\\[[^][\n*]\\]\\)\\)?[ \t]*\\S-" nil t) - (if (setq dovl (cdr (assoc "BEAMER_dovl" - (get-text-property (match-end 0) - 'org-props)))) - (save-excursion - (goto-char (1+ (match-end 1))) - (insert dovl))))))) - -(defun org-beamer-amend-header () - "Add `org-beamer-header-extra' to the LaTeX header. -If the file contains the string BEAMER-HEADER-EXTRA-HERE on a line -by itself, it will be replaced with `org-beamer-header-extra'. If not, -the value will be inserted right after the documentclass statement." - (when (and org-beamer-export-is-beamer-p - org-beamer-header-extra) - (goto-char (point-min)) - (cond - ((re-search-forward - "^[ \t]*\\[?BEAMER-HEADER-EXTRA\\(-HERE\\)?\\]?[ \t]*$" nil t) - (replace-match org-beamer-header-extra t t) - (or (bolp) (insert "\n"))) - ((re-search-forward "^[ \t]*\\\\begin{document}" nil t) - (beginning-of-line 1) - (insert org-beamer-header-extra) - (or (bolp) (insert "\n")))))) - -(defcustom org-beamer-fragile-re "\\\\\\(verb\\|lstinline\\)\\|^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\|minted\\)}" - "If this regexp matches in a frame, the frame is marked as fragile." - :group 'org-beamer - :version "24.1" - :type 'regexp) - -(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40)))) - "The special face for beamer tags." - :group 'org-beamer) - - -;; Functions to initialize and post-process -;; These functions will be hooked into various places in the export process - -(defun org-beamer-initialize-open-trackers () - "Reset variables that track if certain environments are open during export." - (setq org-beamer-columns-open nil) - (setq org-beamer-column-open nil) - (setq org-beamer-inside-frame-at-level nil) - (setq org-beamer-export-is-beamer-p nil)) - -(defun org-beamer-after-initial-vars () - "Find special settings for beamer and store them. -The effect is that these values will be accessible during export." - ;; First verify that we are exporting using the beamer class - (setq org-beamer-export-is-beamer-p - (string-match "\\\\documentclass\\(\\[[^][]*?\\]\\)?{beamer}" - org-export-latex-header)) - (when org-beamer-export-is-beamer-p - ;; Find the frame level - (setq org-beamer-frame-level-now - (or (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (and (looking-at org-complex-heading-regexp) - (org-entry-get nil "BEAMER_FRAME_LEVEL" 'selective)))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (and (re-search-forward - "^#\\+BEAMER_FRAME_LEVEL:[ \t]*\\(.*?\\)[ \t]*$" nil t) - (match-string 1)))) - (plist-get org-export-latex-options-plist :beamer-frame-level) - org-beamer-frame-level)) - ;; Normalize the value so that the functions can trust the value - (cond - ((not org-beamer-frame-level-now) - (setq org-beamer-frame-level-now nil)) - ((stringp org-beamer-frame-level-now) - (setq org-beamer-frame-level-now - (string-to-number org-beamer-frame-level-now)))) - ;; Find the header additions, most likely theme commands - (setq org-beamer-header-extra - (or (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (and (looking-at org-complex-heading-regexp) - (org-entry-get nil "BEAMER_HEADER_EXTRA" - 'selective)))) - (save-excursion - (save-restriction - (widen) - (let ((txt "")) - (goto-char (point-min)) - (while (re-search-forward - "^#\\+BEAMER_HEADER_EXTRA:[ \t]*\\(.*?\\)[ \t]*$" - nil t) - (setq txt (concat txt "\n" (match-string 1)))) - (if (> (length txt) 0) (substring txt 1))))) - (plist-get org-export-latex-options-plist - :beamer-header-extra))) - (let ((inhibit-read-only t) - (case-fold-search nil) - props) - (org-unmodified - (remove-text-properties (point-min) (point-max) '(org-props nil)) - (org-map-entries - '(progn - (setq props (org-entry-properties nil 'standard)) - (if (and (not (assoc "BEAMER_env" props)) - (looking-at ".*?:B_\\(note\\(NH\\)?\\):")) - (push (cons "BEAMER_env" (match-string 1)) props)) - (when (org-bound-and-true-p org-beamer-inherited-properties) - (mapc (lambda (p) - (unless (assoc p props) - (let ((v (org-entry-get nil p 'inherit))) - (and v (push (cons p v) props))))) - org-beamer-inherited-properties)) - (put-text-property (point-at-bol) (point-at-eol) 'org-props props))) - (setq org-export-latex-options-plist - (plist-put org-export-latex-options-plist :tags nil)))))) - -(defun org-beamer-auto-fragile-frames () - "Mark any frames containing verbatim environments as fragile. -This function will run in the final LaTeX document." - (when org-beamer-export-is-beamer-p - (let (opts) - (goto-char (point-min)) - ;; Find something that might be fragile - (while (re-search-forward org-beamer-fragile-re nil t) - (save-excursion - ;; Are we inside a frame here? - (when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}\\(<[^>]*>\\)?" - nil t) - (equal (match-string 1) "begin")) - ;; yes, inside a frame, make sure "fragile" is one of the options - (goto-char (match-end 0)) - (if (not (looking-at "\\[.*?\\]")) - (insert "[fragile]") - (setq opts (substring (match-string 0) 1 -1)) - (delete-region (match-beginning 0) (match-end 0)) - (setq opts (org-split-string opts ",")) - (add-to-list 'opts "fragile") - (insert "[" (mapconcat 'identity opts ",") "]")))))))) - -(defcustom org-beamer-outline-frame-title "Outline" - "Default title of a frame containing an outline." - :group 'org-beamer - :version "24.1" - :type '(string :tag "Outline frame title") - ) - -(defcustom org-beamer-outline-frame-options nil - "Outline frame options appended after \\begin{frame}. -You might want to put e.g. [allowframebreaks=0.9] here. Remember to -include square brackets." - :group 'org-beamer - :version "24.1" - :type '(string :tag "Outline frame options") - ) - -(defun org-beamer-fix-toc () - "Fix the table of contents by removing the vspace line." - (when org-beamer-export-is-beamer-p - (save-excursion - (goto-char (point-min)) - (when (re-search-forward "\\(\\\\setcounter{tocdepth.*\n\\\\tableofcontents.*\n\\)\\(\\\\vspace\\*.*\\)" - nil t) - (replace-match - (concat "\\\\begin{frame}" org-beamer-outline-frame-options - "\n\\\\frametitle{" - org-beamer-outline-frame-title - "}\n\\1\\\\end{frame}") - t nil))))) - -(defun org-beamer-property-changed (property value) - "Track the BEAMER_env property with tags." - (cond - ((equal property "BEAMER_env") - (save-excursion - (org-back-to-heading t) - (let ((tags (org-get-tags))) - (setq tags (delq nil (mapcar (lambda (x) - (if (string-match "^B_" x) nil x)) - tags))) - (org-set-tags-to tags)) - (when (and value (stringp value) (string-match "\\S-" value)) - (org-toggle-tag (concat "B_" value) 'on)))) - ((equal property "BEAMER_col") - (org-toggle-tag "BMCOL" (if (and value (string-match "\\S-" value)) - 'on 'off))))) - -(defun org-beamer-select-beamer-code () - "Take code marked for BEAMER and turn it into marked for LaTeX." - (when org-beamer-export-is-beamer-p - (goto-char (point-min)) - (while (re-search-forward - "^\\([ \]*#\\+\\(begin_\\|end_\\)?\\)\\(beamer\\)\\>" nil t) - (replace-match "\\1latex")))) - -;; OK, hook all these functions into appropriate places -(add-hook 'org-export-first-hook - 'org-beamer-initialize-open-trackers) -(add-hook 'org-property-changed-functions - 'org-beamer-property-changed) -(add-hook 'org-export-latex-after-initial-vars-hook - 'org-beamer-after-initial-vars) -(add-hook 'org-export-latex-final-hook - 'org-beamer-place-default-actions-for-lists) -(add-hook 'org-export-latex-final-hook - 'org-beamer-auto-fragile-frames) -(add-hook 'org-export-latex-final-hook - 'org-beamer-fix-toc) -(add-hook 'org-export-latex-final-hook - 'org-beamer-amend-header) -(add-hook 'org-export-preprocess-before-selecting-backend-code-hook - 'org-beamer-select-beamer-code) - -(defun org-insert-beamer-options-template (&optional kind) - "Insert a settings template, to make sure users do this right." - (interactive (progn - (message "Current [s]ubtree or [g]lobal?") - (if (equal (read-char-exclusive) ?g) - (list 'global) - (list 'subtree)))) - (if (eq kind 'subtree) - (progn - (org-back-to-heading t) - (org-reveal) - (org-entry-put nil "LaTeX_CLASS" "beamer") - (org-entry-put nil "LaTeX_CLASS_OPTIONS" "[presentation]") - (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf") - (org-entry-put nil "BEAMER_FRAME_LEVEL" (number-to-string - org-beamer-frame-level)) - (when org-beamer-themes - (org-entry-put nil "BEAMER_HEADER_EXTRA" org-beamer-themes)) - (when org-beamer-column-view-format - (org-entry-put nil "COLUMNS" org-beamer-column-view-format)) - (org-entry-put nil "BEAMER_col_ALL" "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC")) - (insert "#+LaTeX_CLASS: beamer\n") - (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n") - (insert (format "#+BEAMER_FRAME_LEVEL: %d\n" org-beamer-frame-level) "\n") - (when org-beamer-themes - (insert "#+BEAMER_HEADER_EXTRA: " org-beamer-themes "\n")) - (when org-beamer-column-view-format - (insert "#+COLUMNS: " org-beamer-column-view-format "\n")) - (insert "#+PROPERTY: BEAMER_col_ALL 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC\n"))) - - -(defun org-beamer-allowed-property-values (property) - "Supply allowed values for BEAMER properties." - (cond - ((and (equal property "BEAMER_env") - (not (org-entry-get nil (concat property "_ALL") 'inherit))) - ;; If no allowed values for BEAMER_env have been defined, - ;; supply all defined environments - (mapcar 'car (append org-beamer-environments-extra - org-beamer-environments-default))) - ((and (equal property "BEAMER_col") - (not (org-entry-get nil (concat property "_ALL") 'inherit))) - ;; If no allowed values for BEAMER_col have been defined, - ;; supply some - '("0.1" "0.2" "0.3" "0.4" "0.5" "0.6" "0.7" "0.8" "0.9" "" ":ETC")) - (t nil))) - -(add-hook 'org-property-allowed-value-functions - 'org-beamer-allowed-property-values) - -(provide 'org-beamer) - -;;; org-beamer.el ends here diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el index 704b20497..39902c061 100644 --- a/lisp/org-bibtex.el +++ b/lisp/org-bibtex.el @@ -2,10 +2,10 @@ ;; ;; Copyright (C) 2007-2013 Free Software Foundation, Inc. ;; -;; Authors: Bastien Guerry +;; Authors: Bastien Guerry ;; Carsten Dominik ;; Eric Schulte -;; Keywords: org, wp, remember +;; Keywords: org, wp, capture ;; ;; This file is part of GNU Emacs. ;; @@ -31,7 +31,7 @@ ;; the link that contains the author name, the year and a short title. ;; ;; It also stores detailed information about the entry so that -;; remember templates can access and enter this information easily. +;; capture templates can access and enter this information easily. ;; ;; The available properties for each entry are listed here: ;; @@ -41,14 +41,14 @@ ;; :booktitle :month :annote :abstract ;; :key :btype ;; -;; Here is an example of a remember template that use some of this +;; Here is an example of a capture template that use some of this ;; information (:author :year :title :journal :pages): ;; -;; (setq org-remember-templates +;; (setq org-capure-templates ;; '((?b "* READ %?\n\n%a\n\n%:author (%:year): %:title\n \ ;; In %:journal, %:pages."))) ;; -;; Let's say you want to remember this BibTeX entry: +;; Let's say you want to capture this BibTeX entry: ;; ;; @Article{dolev83, ;; author = {Danny Dolev and Andrew C. Yao}, @@ -61,7 +61,7 @@ ;; month = {Mars} ;; } ;; -;; M-x `org-remember' on this entry will produce this buffer: +;; M-x `org-capture' on this entry will produce this buffer: ;; ;; ===================================================================== ;; * READ <== [point here] @@ -94,7 +94,7 @@ ;; ;; The link creation part has been part of Org-mode for a long time. ;; -;; Creating better remember template information was inspired by a request +;; Creating better capture template information was inspired by a request ;; of Austin Frank: http://article.gmane.org/gmane.emacs.orgmode/4112 ;; and then implemented by Bastien Guerry. ;; @@ -120,7 +120,6 @@ (declare-function bibtex-generate-autokey "bibtex" ()) (declare-function bibtex-parse-entry "bibtex" (&optional content)) (declare-function bibtex-url "bibtex" (&optional pos no-browse)) -(declare-function longlines-mode "longlines" (&optional arg)) (declare-function org-babel-trim "ob" (string &optional regexp)) @@ -381,7 +380,7 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t." (buf-name (format "*Bibtex Help %s*" name))) (with-output-to-temp-buffer buf-name (princ (cdr (assoc field org-bibtex-fields)))) - (with-current-buffer buf-name (longlines-mode t)) + (with-current-buffer buf-name (visual-line-mode 1)) (org-fit-window-to-buffer (get-buffer-window buf-name)) ((lambda (result) (when (> (length result) 0) result)) (read-from-minibuffer (format "%s: " name)))))) @@ -624,6 +623,27 @@ This uses `bibtex-parse-entry'." (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry))) org-bibtex-entries))) +(defun org-bibtex-read-buffer (buffer) + "Read all bibtex entries in BUFFER and save to `org-bibtex-entries'. +Return the number of saved entries." + (interactive "bbuffer: ") + (let ((start-length (length org-bibtex-entries))) + (with-current-buffer buffer + (save-excursion + (goto-char (point-max)) + (while (not (= (point) (point-min))) + (backward-char 1) + (org-bibtex-read) + (bibtex-beginning-of-entry)))) + (let ((added (- (length org-bibtex-entries) start-length))) + (message "parsed %d entries" added) + added))) + +(defun org-bibtex-read-file (file) + "Read FILE with `org-bibtex-read-buffer'." + (interactive "ffile: ") + (org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile))) + (defun org-bibtex-write () "Insert a heading built from the first element of `org-bibtex-entries'." (interactive) @@ -665,6 +685,14 @@ This uses `bibtex-parse-entry'." (org-bibtex-write) (error "Yanked text does not appear to contain a BibTeX entry")))) +(defun org-bibtex-import-from-file (file) + "Read bibtex entries from FILE and insert as Org-mode headlines after point." + (interactive "ffile: ") + (dotimes (_ (org-bibtex-read-file file)) + (save-excursion (org-bibtex-write)) + (re-search-forward org-property-end-re) + (open-line 1) (forward-char 1))) + (defun org-bibtex-export-to-kill-ring () "Export current headline to kill ring as bibtex entry." (interactive) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 8a271b8d0..936883acb 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -50,7 +50,6 @@ (eval-when-compile (require 'cl)) (require 'org) -(require 'org-mks) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) @@ -182,6 +181,8 @@ properties are: template only needs information that can be added automatically. + :jump-to-captured When set, jump to the captured entry when finished. + :empty-lines Set this to the number of lines the should be inserted before and after the new item. Default 0, only common other value is 1. @@ -223,7 +224,9 @@ freely formatted text. Furthermore, the following %-escapes will be replaced with content and expanded in this order: %[pathname] Insert the contents of the file given by `pathname'. - %(sexp) Evaluate elisp `(sexp)' and replace with the result. + %(sexp) Evaluate elisp `(sexp)' and replace it with the results. + For convenience, %:keyword (see below) placeholders within + the expression will be expanded prior to this. %<...> The result of format-time-string on the ... format specification. %t Time stamp, date only. %T Time stamp with date and time. @@ -237,7 +240,7 @@ be replaced with content and expanded in this order: %x Content of the X clipboard. %k Title of currently clocked task. %K Link to currently clocked task. - %n User name (taken from `user-full-name'). + %n User name (taken from the variable `user-full-name'). %f File visited by current buffer when org-capture was called. %F Full path of the file or directory visited by current buffer. %:keyword Specific information for certain link types, see below. @@ -338,11 +341,15 @@ calendar | %:type %:date" ;; Give the most common options as checkboxes :options (((const :format "%v " :prepend) (const t)) ((const :format "%v " :immediate-finish) (const t)) + ((const :format "%v " :jump-to-captured) (const t)) ((const :format "%v " :empty-lines) (const 1)) + ((const :format "%v " :empty-lines-before) (const 1)) + ((const :format "%v " :empty-lines-after) (const 1)) ((const :format "%v " :clock-in) (const t)) ((const :format "%v " :clock-keep) (const t)) ((const :format "%v " :clock-resume) (const t)) ((const :format "%v " :unnarrowed) (const t)) + ((const :format "%v " :table-line-pos) (const t)) ((const :format "%v " :kill-buffer) (const t)))))))) (defcustom org-capture-before-finalize-hook nil @@ -439,6 +446,7 @@ Turning on this mode runs the normal hook `org-capture-mode-hook'." ;;;###autoload (defun org-capture-string (string &optional keys) + "Capture STRING with the template selected by KEYS." (interactive "sInitial text: \n") (let ((org-capture-initial string) (org-capture-entry (org-capture-select-template keys))) @@ -459,6 +467,8 @@ Here are the available contexts definitions: in-mode: command displayed only in matching modes not-in-file: command not displayed in matching files not-in-mode: command not displayed in matching modes + in-buffer: command displayed only in matching buffers +not-in-buffer: command not displayed in matching buffers [function]: a custom function taking no argument If you define several checks, the agenda command will be @@ -484,6 +494,8 @@ to avoid duplicates.)" (choice (const :tag "In file" in-file) (const :tag "Not in file" not-in-file) + (const :tag "In buffer" in-buffer) + (const :tag "Not in buffer" not-in-buffer) (const :tag "In mode" in-mode) (const :tag "Not in mode" not-in-mode)) (regexp)) @@ -491,7 +503,7 @@ to avoid duplicates.)" (defcustom org-capture-use-agenda-date nil "Non-nil means use the date at point when capturing from agendas. -When nil, you can still capturing using the date at point with \\[org-agenda-capture]]." +When nil, you can still capture using the date at point with \\[org-agenda-capture]." :group 'org-capture :version "24.3" :type 'boolean) @@ -514,17 +526,19 @@ stored. When called with a `C-0' (zero) prefix, insert a template at point. -Lisp programs can set KEYS to a string associated with a template +ELisp programs can set KEYS to a string associated with a template in `org-capture-templates'. In this case, interactive selection will be bypassed. If `org-capture-use-agenda-date' is non-nil, capturing from the -agenda will use the date at point as the default date." +agenda will use the date at point as the default date. Then, a +`C-1' prefix will tell the capture process to use the HH:MM time +of the day at point (if any) or the current HH:MM time." (interactive "P") (when (and org-capture-use-agenda-date (eq major-mode 'org-agenda-mode)) (setq org-overriding-default-time - (org-get-cursor-date))) + (org-get-cursor-date (equal goto 1)))) (cond ((equal goto '(4)) (org-capture-goto-target)) ((equal goto '(16)) (org-capture-goto-last-stored)) @@ -600,7 +614,7 @@ agenda will use the date at point as the default date." (error "Could not start the clock in this capture buffer"))) (if (org-capture-get :immediate-finish) - (org-capture-finalize nil))))))))) + (org-capture-finalize))))))))) (defun org-capture-get-template () "Get the template from a file or a function if necessary." @@ -625,6 +639,8 @@ agenda will use the date at point as the default date." With prefix argument STAY-WITH-CAPTURE, jump to the location of the captured item after finalizing." (interactive "P") + (when (org-capture-get :jump-to-captured) + (setq stay-with-capture t)) (unless (and org-capture-mode (buffer-base-buffer (current-buffer))) (error "This does not seem to be a capture buffer for Org-mode")) @@ -964,7 +980,7 @@ it. When it is a variable, retrieve the value. Return whatever we get." (find-file-noselect (expand-file-name file org-directory))))) (defun org-capture-steal-local-variables (buffer) - "Install Org-mode local variables." + "Install Org-mode local variables of BUFFER." (mapc (lambda (v) (ignore-errors (org-set-local (car v) (cdr v)))) (buffer-local-variables buffer))) @@ -1261,7 +1277,7 @@ Of course, if exact position has been required, just put it there." (goto-char beg))) (defun org-capture-empty-lines-before (&optional n) - "Arrange for the correct number of empty lines before the insertion point. + "Set the correct number of empty lines before the insertion point. Point will be after the empty lines, so insertion can directly be done." (setq n (or n (org-capture-get :empty-lines-before) (org-capture-get :empty-lines) 0)) @@ -1271,7 +1287,7 @@ Point will be after the empty lines, so insertion can directly be done." (if (> n 0) (newline n)))) (defun org-capture-empty-lines-after (&optional n) - "Arrange for the correct number of empty lines after the inserted string. + "Set the correct number of empty lines after the inserted string. Point will remain at the first line after the inserted text." (setq n (or n (org-capture-get :empty-lines-after) (org-capture-get :empty-lines) 0)) @@ -1284,6 +1300,7 @@ Point will remain at the first line after the inserted text." (defvar org-clock-marker) ; Defined in org.el (defun org-capture-insert-template-here () + "Insert the capture template at point." (let* ((template (org-capture-get :template)) (type (org-capture-get :type)) beg end pp) @@ -1366,8 +1383,106 @@ Use PREFIX as a prefix for the name of the indirect buffer." (unless (org-kill-is-subtree-p tree) (error "Template is not a valid Org entry or tree"))) -;;; The template code +(defun org-mks (table title &optional prompt specials) + "Select a member of an alist with multiple keys. +TABLE is the alist which should contain entries where the car is a string. +There should be two types of entries. +1. prefix descriptions like (\"a\" \"Description\") + This indicates that `a' is a prefix key for multi-letter selection, and + that there are entries following with keys like \"ab\", \"ax\"... + +2. Selectable members must have more than two elements, with the first + being the string of keys that lead to selecting it, and the second a + short description string of the item. + +The command will then make a temporary buffer listing all entries +that can be selected with a single key, and all the single key +prefixes. When you press the key for a single-letter entry, it is selected. +When you press a prefix key, the commands (and maybe further prefixes) +under this key will be shown and offered for selection. + +TITLE will be placed over the selection in the temporary buffer, +PROMPT will be used when prompting for a key. SPECIAL is an alist with +also (\"key\" \"description\") entries. When one of these is selection, +only the bare key is returned." + (setq prompt (or prompt "Select: ")) + (let (tbl orig-table dkey ddesc des-keys allowed-keys + current prefix rtn re pressed buffer (inhibit-quit t)) + (save-window-excursion + (setq buffer (org-switch-to-buffer-other-window "*Org Select*")) + (setq orig-table table) + (catch 'exit + (while t + (erase-buffer) + (insert title "\n\n") + (setq tbl table + des-keys nil + allowed-keys nil + cursor-type nil) + (setq prefix (if current (concat current " ") "")) + (while tbl + (cond + ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1)) + ;; This is a description on this level + (setq dkey (caar tbl) ddesc (cadar tbl)) + (pop tbl) + (push dkey des-keys) + (push dkey allowed-keys) + (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n") + ;; Skip keys which are below this prefix + (setq re (concat "\\`" (regexp-quote dkey))) + (let (case-fold-search) + (while (and tbl (string-match re (caar tbl))) (pop tbl)))) + ((= 2 (length (car tbl))) + ;; Not yet a usable description, skip it + ) + (t + ;; usable entry on this level + (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n") + (push (caar tbl) allowed-keys) + (pop tbl)))) + (when specials + (insert "-------------------------------------------------------------------------------\n") + (let ((sp specials)) + (while sp + (insert (format "[%s] %s\n" + (caar sp) (nth 1 (car sp)))) + (push (caar sp) allowed-keys) + (pop sp)))) + (push "\C-g" allowed-keys) + (goto-char (point-min)) + (if (not (pos-visible-in-window-p (point-max))) + (org-fit-window-to-buffer)) + (message prompt) + (setq pressed (char-to-string (read-char-exclusive))) + (while (not (member pressed allowed-keys)) + (message "Invalid key `%s'" pressed) (sit-for 1) + (message prompt) + (setq pressed (char-to-string (read-char-exclusive)))) + (when (equal pressed "\C-g") + (kill-buffer buffer) + (error "Abort")) + (when (and (not (assoc pressed table)) + (not (member pressed des-keys)) + (assoc pressed specials)) + (throw 'exit (setq rtn pressed))) + (unless (member pressed des-keys) + (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table)) + orig-table)))) + (setq current (concat current pressed)) + (setq table (mapcar + (lambda (x) + (if (and (> (length (car x)) 1) + (equal (substring (car x) 0 1) pressed)) + (cons (substring (car x) 1) (cdr x)) + nil)) + table)) + (setq table (remove nil table))))) + (when buffer (kill-buffer buffer)) + rtn)) + +;;; The template code (defun org-capture-select-template (&optional keys) "Select a capture template. Lisp programs can force the template by setting KEYS to a string." @@ -1496,10 +1611,8 @@ The template may still contain \"%?\" for cursor positioning." (setq v-i (mapconcat 'identity (org-split-string initial "\n") (concat "\n" lead)))))) - (replace-match - (or (org-add-props (eval (intern (concat "v-" (match-string 1)))) - '(org-protected t)) "") - t t))) + (replace-match (or (eval (intern (concat "v-" (match-string 1)))) "") + t t))) ;; From the property list (when plist-p @@ -1515,8 +1628,7 @@ The template may still contain \"%?\" for cursor positioning." (let ((org-inhibit-startup t)) (org-mode)) ;; Interactive template entries (goto-char (point-min)) - (while (and (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) - (not (get-text-property (1- (point)) 'org-protected))) + (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) (unless (org-capture-escaped-%) (setq char (if (match-end 3) (match-string-no-properties 3)) prompt (if (match-end 2) (match-string-no-properties 2))) @@ -1621,10 +1733,26 @@ The template may still contain \"%?\" for cursor positioning." (goto-char (match-beginning 0)) (let ((template-start (point))) (forward-char 1) - (let ((result (org-eval (read (current-buffer))))) + (let ((result (org-eval + (org-capture--expand-keyword-in-embedded-elisp + (read (current-buffer)))))) (delete-region template-start (point)) (insert result)))))) +(defun org-capture--expand-keyword-in-embedded-elisp (attr) + "Recursively replace capture link keywords in ATTR sexp. +Such keywords are prefixed with \"%:\". See +`org-capture-template' for more information." + (cond ((consp attr) + (mapcar 'org-capture--expand-keyword-in-embedded-elisp attr)) + ((symbolp attr) + (let* ((attr-symbol (symbol-name attr)) + (key (and (string-match "%\\(:.*\\)" attr-symbol) + (intern (match-string 1 attr-symbol))))) + (or (plist-get org-store-link-plist key) + attr))) + (t attr))) + (defun org-capture-inside-embedded-elisp-p () "Return non-nil if point is inside of embedded elisp %(sexp)." (let (beg end) @@ -1643,7 +1771,7 @@ The template may still contain \"%?\" for cursor positioning." ;;;###autoload (defun org-capture-import-remember-templates () - "Set org-capture-templates to be similar to `org-remember-templates'." + "Set `org-capture-templates' to be similar to `org-remember-templates'." (interactive) (when (and (yes-or-no-p "Import old remember templates into org-capture-templates? ") @@ -1660,7 +1788,7 @@ The template may still contain \"%?\" for cursor positioning." (position (or (nth 4 entry) org-remember-default-headline)) (type 'entry) (prepend org-reverse-note-order) - immediate target) + immediate target jump-to-captured) (cond ((member position '(top bottom)) (setq target (list 'file file) @@ -1674,9 +1802,13 @@ The template may still contain \"%?\" for cursor positioning." (setq template (replace-match "" t t template) immediate t)) + (when (string-match "%&" template) + (setq jump-to-captured t)) + (append (list key desc type target template) (if prepend '(:prepend t)) - (if immediate '(:immediate-finish t))))) + (if immediate '(:immediate-finish t)) + (if jump-to-captured '(:jump-to-captured t))))) org-remember-templates)))) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index b89e64403..d96e034c3 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -26,11 +26,11 @@ ;; This file contains the time clocking code for Org-mode -(require 'org-exp) ;;; Code: (eval-when-compile (require 'cl)) +(require 'org) (declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) (declare-function notifications-notify "notifications" (&rest params)) @@ -95,6 +95,24 @@ clocking out." (repeat :tag "State list" (string :tag "TODO keyword")))) +(defcustom org-clock-rounding-minutes 0 + "Rounding minutes when clocking in or out. +The default value is 0 so that no rounding is done. +When set to a non-integer value, use the car of +`org-time-stamp-rounding-minutes', like for setting a time-stamp. + +E.g. if `org-clock-rounding-minutes' is set to 5, time is 14:47 +and you clock in: then the clock starts at 14:45. If you clock +out within the next 5 minutes, the clock line will be removed; +if you clock out 8 minutes after your clocked in, the clock +out time will be 14:50." + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (integer :tag "Minutes (0 for no rounding)") + (symbol :tag "Use `org-time-stamp-rounding-minutes'" 'same-as-time-stamp))) + (defcustom org-clock-out-remove-zero-time-clocks nil "Non-nil means remove the clock line when the resulting time is zero." :group 'org-clock @@ -177,7 +195,7 @@ Emacs initialization file." (const :tag "No persistence" nil))) (defcustom org-clock-persist-file (convert-standard-filename - "~/.emacs.d/org-clock-save.el") + (concat user-emacs-directory "org-clock-save.el")) "File to save clock data to." :group 'org-clock :type 'string) @@ -193,17 +211,17 @@ Emacs initialization file." :type 'boolean) (defcustom org-clock-sound nil - "Sound that will used for notifications. -Possible values: + "Sound to use for notifications. +Possible values are: -nil no sound played. -t standard Emacs beep -file name play this sound file. If not possible, fall back to beep" +nil No sound played +t Standard Emacs beep +file name Play this sound file, fall back to beep" :group 'org-clock :type '(choice (const :tag "No sound" nil) (const :tag "Standard beep" t) - (file :tag "Play sound file"))) + (file :tag "Play sound file"))) (define-obsolete-variable-alias 'org-clock-modeline-total 'org-clock-mode-line-total "24.3") @@ -226,7 +244,7 @@ auto Automatically, either `all', or `repeat' for repeating tasks" (const :tag "All task time" all) (const :tag "Automatically, `all' or since `repeat'" auto))) -(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text) +(org-defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text) (defcustom org-clock-task-overrun-text nil "Extra mode line text to indicate that the clock is overrun. The can be nil to indicate that instead of adding text, the clock time @@ -256,9 +274,11 @@ string as argument." (defcustom org-clocktable-defaults (list :maxlevel 2 - :lang org-export-default-language + :lang (or (org-bound-and-true-p org-export-default-language) "en") :scope 'file :block nil + :wstart 1 + :mstart 1 :tstart nil :tend nil :step nil @@ -378,6 +398,20 @@ specifications than `frame-title-format', which see." :group 'org-clock :type 'sexp) +(defcustom org-clock-x11idle-program-name "x11idle" + "Name of the program which prints X11 idle time in milliseconds. + +You can find x11idle.c in the contrib/scripts directory of the +Org git distribution. Or, you can do: + + sudo apt-get install xprintidle + +if you are using Debian." + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + (defvar org-clock-in-prepare-hook nil "Hook run when preparing the clock. This hook is run before anything happens to the task that @@ -403,7 +437,6 @@ to add an effort property.") (defvar org-clock-mode-line-timer nil) (defvar org-clock-idle-timer nil) (defvar org-clock-heading) ; defined in org.el -(defvar org-clock-heading-for-remember "") (defvar org-clock-start-time "") (defvar org-clock-leftover-time nil @@ -481,46 +514,55 @@ of a different task.") "Hook called in task selection just before prompting the user.") (defun org-clock-select-task (&optional prompt) - "Select a task that recently was associated with clocking." + "Select a task that was recently associated with clocking." (interactive) - (let (sel-list rpl (i 0) s) - (save-window-excursion - (org-switch-to-buffer-other-window - (get-buffer-create "*Clock Task Select*")) - (erase-buffer) - (when (marker-buffer org-clock-default-task) - (insert (org-add-props "Default Task\n" nil 'face 'bold)) - (setq s (org-clock-insert-selection-line ?d org-clock-default-task)) - (push s sel-list)) - (when (marker-buffer org-clock-interrupted-task) - (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold)) - (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task)) - (push s sel-list)) - (when (org-clocking-p) - (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold)) - (setq s (org-clock-insert-selection-line ?c org-clock-marker)) - (push s sel-list)) - (insert (org-add-props "Recent Tasks\n" nil 'face 'bold)) - (mapc - (lambda (m) - (when (marker-buffer m) - (setq i (1+ i) - s (org-clock-insert-selection-line - (if (< i 10) - (+ i ?0) - (+ i (- ?A 10))) m)) - (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) - (push s sel-list))) - org-clock-history) - (run-hooks 'org-clock-before-select-task-hook) - (org-fit-window-to-buffer) - (message (or prompt "Select task for clocking:")) - (setq rpl (read-char-exclusive)) - (cond - ((eq rpl ?q) nil) - ((eq rpl ?x) nil) - ((assoc rpl sel-list) (cdr (assoc rpl sel-list))) - (t (error "Invalid task choice %c" rpl)))))) + (let (och chl sel-list rpl (i 0) s) + ;; Remove successive dups from the clock history to consider + (mapc (lambda (c) (if (not (equal c (car och))) (push c och))) + org-clock-history) + (setq och (reverse och) chl (length och)) + (if (zerop chl) + (user-error "No recent clock") + (save-window-excursion + (org-switch-to-buffer-other-window + (get-buffer-create "*Clock Task Select*")) + (erase-buffer) + (when (marker-buffer org-clock-default-task) + (insert (org-add-props "Default Task\n" nil 'face 'bold)) + (setq s (org-clock-insert-selection-line ?d org-clock-default-task)) + (push s sel-list)) + (when (marker-buffer org-clock-interrupted-task) + (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold)) + (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task)) + (push s sel-list)) + (when (org-clocking-p) + (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold)) + (setq s (org-clock-insert-selection-line ?c org-clock-marker)) + (push s sel-list)) + (insert (org-add-props "Recent Tasks\n" nil 'face 'bold)) + (mapc + (lambda (m) + (when (marker-buffer m) + (setq i (1+ i) + s (org-clock-insert-selection-line + (if (< i 10) + (+ i ?0) + (+ i (- ?A 10))) m)) + (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) + (push s sel-list))) + och) + (run-hooks 'org-clock-before-select-task-hook) + (goto-char (point-min)) + ;; Set min-height relatively to circumvent a possible but in + ;; `fit-window-to-buffer' + (fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl))) + (message (or prompt "Select task for clocking:")) + (setq cursor-type nil rpl (read-char-exclusive)) + (cond + ((eq rpl ?q) nil) + ((eq rpl ?x) nil) + ((assoc rpl sel-list) (cdr (assoc rpl sel-list))) + (t (user-error "Invalid task choice %c" rpl))))))) (defun org-clock-insert-selection-line (i marker) "Insert a line for the clock selection menu. @@ -547,7 +589,7 @@ pointing to it." org-odd-levels-only) (length prefix))))))) (when (and cat task) - (insert (format "[%c] %-15s %s\n" i cat task)) + (insert (format "[%c] %-12s %s\n" i cat task)) (cons i marker))))) (defvar org-clock-task-overrun nil @@ -560,30 +602,33 @@ pointing to it." If an effort estimate was defined for the current item, use 01:30/01:50 format (clocked/estimated). If not, show simply the clocked time like 01:50." - (let* ((clocked-time (org-clock-get-clocked-time)) - (h (floor clocked-time 60)) - (m (- clocked-time (* 60 h)))) + (let ((clocked-time (org-clock-get-clocked-time))) (if org-clock-effort (let* ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort)) - (effort-h (floor effort-in-minutes 60)) - (effort-m (- effort-in-minutes (* effort-h 60))) (work-done-str (org-propertize - (format org-time-clocksum-format h m) + (org-minutes-to-clocksum-string clocked-time) 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text)) 'org-mode-line-clock-overrun 'org-mode-line-clock))) - (effort-str (format org-time-clocksum-format effort-h effort-m)) + (effort-str (org-minutes-to-clocksum-string effort-in-minutes)) (clockstr (org-propertize (concat " [%s/" effort-str "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") 'face 'org-mode-line-clock))) (format clockstr work-done-str)) - (org-propertize (format - (concat "[" org-time-clocksum-format " (%s)]") - h m org-clock-heading) + (org-propertize (concat "[" (org-minutes-to-clocksum-string clocked-time) + (format " (%s)" org-clock-heading) "]") 'face 'org-mode-line-clock)))) +(defun org-clock-get-last-clock-out-time () + "Get the last clock-out time for the current subtree." + (save-excursion + (let ((end (save-excursion (org-end-of-subtree)))) + (when (re-search-forward (concat org-clock-string + ".*\\]--\\(\\[[^]]+\\]\\)") end t) + (org-time-string-to-time (match-string 1)))))) + (defun org-clock-update-mode-line () (if org-clock-effort (org-clock-notify-once-if-expired) @@ -646,7 +691,7 @@ the mode line." (setq value (- current value)) (if (equal ?+ sign) (setq value (+ current value))))) (setq value (max 0 value) - org-clock-effort (org-minutes-to-hh:mm-string value)) + org-clock-effort (org-minutes-to-clocksum-string value)) (org-entry-put org-clock-marker "Effort" org-clock-effort) (org-clock-update-mode-line) (message "Effort is now %s" org-clock-effort)) @@ -673,9 +718,10 @@ Notification is shown only once." (setq org-clock-notification-was-shown nil))))) (defun org-notify (notification &optional play-sound) - "Send a NOTIFICATION and maybe PLAY-SOUND." + "Send a NOTIFICATION and maybe PLAY-SOUND. +If PLAY-SOUND is non-nil, it overrides `org-clock-sound'." (org-show-notification notification) - (if play-sound (org-clock-play-sound))) + (if play-sound (org-clock-play-sound play-sound))) (defun org-show-notification (notification) "Show notification. @@ -700,21 +746,23 @@ use libnotify if available, or fall back on a message." ;; a fall back option (t (message "%s" notification)))) -(defun org-clock-play-sound () +(defun org-clock-play-sound (&optional clock-sound) "Play sound as configured by `org-clock-sound'. -Use alsa's aplay tool if available." - (cond - ((not org-clock-sound)) - ((eq org-clock-sound t) (beep t) (beep t)) - ((stringp org-clock-sound) - (let ((file (expand-file-name org-clock-sound))) - (if (file-exists-p file) - (if (executable-find "aplay") - (start-process "org-clock-play-notification" nil - "aplay" file) - (condition-case nil - (play-sound-file file) - (error (beep t) (beep t))))))))) +Use alsa's aplay tool if available. +If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." + (let ((org-clock-sound (or clock-sound org-clock-sound))) + (cond + ((not org-clock-sound)) + ((eq org-clock-sound t) (beep t) (beep t)) + ((stringp org-clock-sound) + (let ((file (expand-file-name org-clock-sound))) + (if (file-exists-p file) + (if (executable-find "aplay") + (start-process "org-clock-play-notification" nil + "aplay" file) + (condition-case nil + (play-sound-file file) + (error (beep t) (beep t)))))))))) (defvar org-clock-mode-line-entry nil "Information for the mode line about the running clock.") @@ -887,19 +935,23 @@ was started." (with-output-to-temp-buffer "*Org Clock*" (princ "Select a Clock Resolution Command: -i/q/C-g Ignore this question; the same as keeping all the idle time. +i/q Ignore this question; the same as keeping all the idle time. k/K Keep X minutes of the idle time (default is all). If this amount is less than the default, you will be clocked out that many minutes after the time that idling began, and then clocked back in at the present time. + g/G Indicate that you \"got back\" X minutes ago. This is quite different from 'k': it clocks you out from the beginning of the idle period and clock you back in X minutes ago. + s/S Subtract the idle time from the current clock. This is the same as keeping 0 minutes. + C Cancel the open timer altogether. It will be as though you never clocked in. + j/J Jump to the current clock, to make manual adjustments. For all these options, using uppercase makes your final state @@ -1010,13 +1062,13 @@ If `only-dangling-p' is non-nil, only ask to resolve dangling (defvar org-x11idle-exists-p ;; Check that x11idle exists (and (eq window-system 'x) - (eq (call-process-shell-command "command" nil nil nil "-v" "x11idle") 0) + (eq (call-process-shell-command "command" nil nil nil "-v" org-clock-x11idle-program-name) 0) ;; Check that x11idle can retrieve the idle time - (eq (call-process-shell-command "x11idle" nil nil nil) 0))) + (eq (call-process-shell-command org-clock-x11idle-program-name nil nil nil) 0))) (defun org-x11-idle-seconds () "Return the current X11 idle time in seconds." - (/ (string-to-number (shell-command-to-string "x11idle")) 1000)) + (/ (string-to-number (shell-command-to-string org-clock-x11idle-program-name)) 1000)) (defun org-user-idle-seconds () "Return the number of seconds the user has been idle for. @@ -1037,7 +1089,7 @@ This is performed after `org-clock-idle-time' minutes, to check if the user really wants to stay clocked in after being idle for so long." (when (and org-clock-idle-time (not org-clock-resolving-clocks) - org-clock-marker) + org-clock-marker (marker-buffer org-clock-marker)) (let* ((org-clock-user-idle-seconds (org-user-idle-seconds)) (org-clock-user-idle-start (time-subtract (current-time) @@ -1056,16 +1108,7 @@ so long." 60.0)))) org-clock-user-idle-start))))) -(defvar org-clock-current-task nil - "Task currently clocked in.") -(defun org-clock-set-current () - "Set `org-clock-current-task' to the task currently clocked in." - (setq org-clock-current-task (nth 4 (org-heading-components)))) - -(defun org-clock-delete-current () - "Reset `org-clock-current-task' to nil." - (setq org-clock-current-task nil)) - +(defvar org-clock-current-task nil "Task currently clocked in.") (defvar org-clock-out-time nil) ; store the time of the last clock-out ;;;###autoload @@ -1163,7 +1206,7 @@ make this the default behavior.)" ;; manually (run-hooks 'org-clock-in-prepare-hook) (org-clock-history-push)) - (org-clock-set-current) + (setq org-clock-current-task (nth 4 (org-heading-components))) (cond ((functionp org-clock-in-switch-to-state) (looking-at org-complex-heading-regexp) (let ((newstate (funcall org-clock-in-switch-to-state @@ -1174,23 +1217,15 @@ make this the default behavior.)" org-clock-in-switch-to-state "\\>")))) (org-todo org-clock-in-switch-to-state))) - (setq org-clock-heading-for-remember - (and (looking-at org-complex-heading-regexp) - (match-end 4) - (org-trim (buffer-substring (match-end 1) - (match-end 4))))) (setq org-clock-heading (cond ((and org-clock-heading-function (functionp org-clock-heading-function)) (funcall org-clock-heading-function)) - ((and (looking-at org-complex-heading-regexp) - (match-string 4)) + ((nth 4 (org-heading-components)) (replace-regexp-in-string "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1" - (match-string 4))) + (match-string-no-properties 4))) (t "???"))) - (setq org-clock-heading (org-propertize org-clock-heading - 'face nil)) (org-clock-find-position org-clock-in-resume) (cond ((and org-clock-in-resume @@ -1233,11 +1268,12 @@ make this the default behavior.)" (y-or-n-p (format "You stopped another clock %d mins ago; start this one from then? " - (/ (- (org-float-time (current-time)) + (/ (- (org-float-time + (org-current-time org-clock-rounding-minutes t)) (org-float-time leftover)) 60))) leftover) start-time - (current-time))) + (org-current-time org-clock-rounding-minutes t))) (setq ts (org-insert-time-stamp org-clock-start-time 'with-hm 'inactive)))) (move-marker org-clock-marker (point) (buffer-base-buffer)) @@ -1288,8 +1324,9 @@ for a todo state to switch to, overriding the existing value (if (equal arg '(4)) (org-clock-in (org-clock-select-task)) (let ((start-time (if (or org-clock-continuously (equal arg '(16))) - (or org-clock-out-time (current-time)) - (current-time)))) + (or org-clock-out-time + (org-current-time org-clock-rounding-minutes t)) + (org-current-time org-clock-rounding-minutes t)))) (if (null org-clock-history) (message "No last clock") (let ((org-clock-in-switch-to-state @@ -1461,7 +1498,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." org-todo-keywords-1) nil t "DONE") org-clock-out-switch-to-state)) - (now (current-time)) + (now (org-current-time org-clock-rounding-minutes)) ts te s h m remove) (setq org-clock-out-time now) (save-excursion ; Do not replace this with `with-current-buffer'. @@ -1522,8 +1559,9 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." "\\>")))) (org-todo org-clock-out-switch-to-state)))))) (force-mode-line-update) - (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m - (if remove " => LINE REMOVED" "")) + (message (concat "Clock stopped at %s after " + (org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s") + te (if remove " => LINE REMOVED" "")) (let ((h org-clock-out-hook)) ;; If a closing note needs to be stored in the drawer ;; where clocks are stored, let's temporarily disable @@ -1534,7 +1572,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (setq h (delq 'org-clock-remove-empty-clock-drawer h))) (mapc (lambda (f) (funcall f)) h)) (unless (org-clocking-p) - (org-clock-delete-current))))))) + (setq org-clock-current-task nil))))))) (add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer) @@ -1553,19 +1591,22 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (org-remove-empty-drawer-at clock-drawer (point)) (forward-line 1)))))) -(defun org-clock-timestamps-up nil - "Increase CLOCK timestamps at cursor." - (interactive) - (org-clock-timestamps-change 'up)) +(defun org-clock-timestamps-up (&optional n) + "Increase CLOCK timestamps at cursor. +Optional argument N tells to change by that many units." + (interactive "P") + (org-clock-timestamps-change 'up n)) -(defun org-clock-timestamps-down nil - "Increase CLOCK timestamps at cursor." - (interactive) - (org-clock-timestamps-change 'down)) +(defun org-clock-timestamps-down (&optional n) + "Increase CLOCK timestamps at cursor. +Optional argument N tells to change by that many units." + (interactive "P") + (org-clock-timestamps-change 'down n)) -(defun org-clock-timestamps-change (updown) +(defun org-clock-timestamps-change (updown &optional n) "Change CLOCK timestamps synchronously at cursor. -UPDOWN tells whether to change 'up or 'down." +UPDOWN tells whether to change 'up or 'down. +Optional argument N tells to change by that many units." (setq org-ts-what nil) (when (org-at-timestamp-p t) (let ((tschange (if (eq updown 'up) 'org-timestamp-up @@ -1581,9 +1622,9 @@ UPDOWN tells whether to change 'up or 'down." (if (<= begts2 (point)) (setq updatets1 t)) (if (not ts2) ;; fall back on org-timestamp-up if there is only one - (funcall tschange) + (funcall tschange n) ;; setq this so that (boundp 'org-ts-what is non-nil) - (funcall tschange) + (funcall tschange n) (let ((ts (if updatets1 ts2 ts1)) (begts (if updatets1 begts1 begts2))) (setq tdiff @@ -1677,7 +1718,7 @@ each headline in the time range with point at the headline. Headlines for which HEADLINE-FILTER returns nil are excluded from the clock summation. PROPNAME lets you set a custom text property instead of :org-clock-minutes." (interactive) - (org-unmodified + (org-with-silent-modifications (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" org-clock-string "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) @@ -1792,12 +1833,9 @@ Use \\[org-clock-remove-overlays] to remove the subtree times." (when org-remove-highlights-with-change (org-add-hook 'before-change-functions 'org-clock-remove-overlays nil 'local)))) - (if org-time-clocksum-use-fractional - (message (concat "Total file time: " org-time-clocksum-fractional-format - " (%d hours and %d minutes)") - (/ (+ (* h 60.0) m) 60.0) h m) - (message (concat "Total file time: " org-time-clocksum-format - " (%d hours and %d minutes)") h m h m)))) + (message (concat "Total file time: " + (org-minutes-to-clocksum-string org-clock-file-total-minutes) + " (%d hours and %d minutes)") h m))) (defvar org-clock-overlays nil) (make-variable-buffer-local 'org-clock-overlays) @@ -1809,9 +1847,6 @@ This creates a new overlay and stores it in `org-clock-overlays', so that it will be easy to remove." (let* ((c 60) (h (floor (/ time 60))) (m (- time (* 60 h))) (l (if level (org-get-valid-level level 0) 0)) - (fmt (concat "%s " (if org-time-clocksum-use-fractional - org-time-clocksum-fractional-format - org-time-clocksum-format) "%s")) (off 0) ov tx) (org-move-to-column c) @@ -1820,14 +1855,9 @@ will be easy to remove." (setq ov (make-overlay (point-at-bol) (point-at-eol)) tx (concat (buffer-substring (point-at-bol) (point)) (make-string (+ off (max 0 (- c (current-column)))) ?.) - (org-add-props (if org-time-clocksum-use-fractional - (format fmt - (make-string l ?*) - (/ (+ (* h 60.0) m) 60.0) - (make-string (- 16 l) ?\ )) - (format fmt - (make-string l ?*) h m - (make-string (- 16 l) ?\ ))) + (org-add-props (concat (make-string l ?*) " " + (org-minutes-to-clocksum-string time) + (make-string (- 16 l) ?\ )) (list 'face 'org-clock-overlay)) "")) (if (not (featurep 'xemacs)) @@ -1977,20 +2007,27 @@ buffer and update it." ((> startday 4) (list 39 startday year))))))) -(defun org-clock-special-range (key &optional time as-strings) +(defun org-clock-special-range (key &optional time as-strings wstart mstart) "Return two times bordering a special time range. Key is a symbol specifying the range and can be one of `today', `yesterday', `thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'. -A week starts Monday 0:00 and ends Sunday 24:00. -The range is determined relative to TIME. TIME defaults to the current time. +By default, a week starts Monday 0:00 and ends Sunday 24:00. +The range is determined relative to TIME, which defaults to current time. The return value is a cons cell with two internal times like the ones -returned by `current time' or `encode-time'. if AS-STRINGS is non-nil, -the returned times will be formatted strings." +returned by `current time' or `encode-time'. +If AS-STRINGS is non-nil, the returned times will be formatted strings. +If WSTART is non-nil, use this number to specify the starting day of a +week (monday is 1). +If MSTART is non-nil, use this number to specify the starting day of a +month (1 is the first day of the month). +If you can combine both, the month starting day will have priority." (if (integerp key) (setq key (intern (number-to-string key)))) (let* ((tm (decode-time (or time (current-time)))) (s 0) (m (nth 1 tm)) (h (nth 2 tm)) (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm)) (dow (nth 6 tm)) + (ws (or wstart 1)) + (ms (or mstart 1)) (skey (symbol-name key)) (shift 0) (q (cond ((>= (nth 4 tm) 10) 4) @@ -2045,20 +2082,21 @@ the returned times will be formatted strings." ((memq key '(day today)) (setq d (+ d shift) h 0 m 0 h1 24 m1 0)) ((memq key '(week thisweek)) - (setq diff (+ (* -7 shift) (if (= dow 0) 6 (1- dow))) + (setq diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws))) m 0 h 0 d (- d diff) d1 (+ 7 d))) ((memq key '(month thismonth)) - (setq d 1 h 0 m 0 d1 1 month (+ month shift) month1 (1+ month) h1 0 m1 0)) + (setq d (or ms 1) h 0 m 0 d1 (or ms 1) + month (+ month shift) month1 (1+ month) h1 0 m1 0)) ((memq key '(quarter thisq)) - ; compute if this shift remains in this year - ; if not, compute how many years and quarters we have to shift (via floor*) - ; and compute the shifted years, months and quarters + ;; Compute if this shift remains in this year. If not, compute + ;; how many years and quarters we have to shift (via floor*) and + ;; compute the shifted years, months and quarters. (cond ((< (+ (- q 1) shift) 0) ; shift not in this year (setq interval (* -1 (+ (- q 1) shift))) - ; set tmp to ((years to shift) (quarters to shift)) + ;; Set tmp to ((years to shift) (quarters to shift)). (setq tmp (org-floor* interval 4)) - ; due to the use of floor, 0 quarters actually means 4 + ;; Due to the use of floor, 0 quarters actually means 4. (if (= 0 (nth 1 tmp)) (setq shiftedy (- y (nth 0 tmp)) shiftedm 1 @@ -2088,8 +2126,7 @@ the returned times will be formatted strings." ((memq key '(year thisyear)) (setq txt (format-time-string "the year %Y" ts))) ((memq key '(quarter thisq)) - (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))) - ) + (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))))) (if as-strings (list (format-time-string fm ts) (format-time-string fm te) txt) (list ts te txt)))) @@ -2194,6 +2231,8 @@ the currently selected interval size." (te (plist-get params :tend)) (link (plist-get params :link)) (maxlevel (or (plist-get params :maxlevel) 3)) + (ws (plist-get params :wstart)) + (ms (plist-get params :mstart)) (step (plist-get params :step)) (timestamp (plist-get params :timestamp)) (formatter (or (plist-get params :formatter) @@ -2204,7 +2243,7 @@ the currently selected interval size." ;; Check if we need to do steps (when block ;; Get the range text for the header - (setq cc (org-clock-special-range block nil t) + (setq cc (org-clock-special-range block nil t ws ms) ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) (when step ;; Write many tables, in steps @@ -2284,7 +2323,8 @@ from the dynamic block definition." ;; well-defined number of columns... (let* ((hlchars '((1 . "*") (2 . "/"))) (lwords (assoc (or (plist-get params :lang) - org-export-default-language) + (org-bound-and-true-p org-export-default-language) + "en") org-clock-clocktable-language-setup)) (multifile (plist-get params :multifile)) (block (plist-get params :block)) @@ -2292,10 +2332,14 @@ from the dynamic block definition." (te (plist-get params :tend)) (header (plist-get params :header)) (narrow (plist-get params :narrow)) + (ws (or (plist-get params :wstart) 1)) + (ms (or (plist-get params :mstart) 1)) (link (plist-get params :link)) (maxlevel (or (plist-get params :maxlevel) 3)) (emph (plist-get params :emphasize)) (level-p (plist-get params :level)) + (org-time-clocksum-use-effort-durations + (plist-get params :effort-durations)) (timestamp (plist-get params :timestamp)) (properties (plist-get params :properties)) (ntcol (max 1 (or (plist-get params :tcolumns) 100))) @@ -2334,7 +2378,7 @@ from the dynamic block definition." (when block ;; Get the range text for the header - (setq range-text (nth 2 (org-clock-special-range block nil t)))) + (setq range-text (nth 2 (org-clock-special-range block nil t ws ms)))) ;; Compute the total time (setq total-time (apply '+ (mapcar 'cadr tables))) @@ -2347,13 +2391,14 @@ from the dynamic block definition." (or header ;; Format the standard header (concat + "#+CAPTION: " (nth 9 lwords) " [" (substring (format-time-string (cdr org-time-stamp-formats)) 1 -1) "]" (if block (concat ", for " range-text ".") "") - "\n\n"))) + "\n"))) ;; Insert the narrowing line (when (and narrow (integerp narrow) (not narrow-cut-p)) @@ -2386,7 +2431,7 @@ from the dynamic block definition." (if properties (make-string (length properties) ?|) "") ; properties columns, maybe (concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline (format org-clock-total-time-cell-format - (org-minutes-to-hh:mm-string (or total-time 0))) ; the time + (org-minutes-to-clocksum-string (or total-time 0))) ; the time "|\n") ; close line ;; Now iterate over the tables and insert the data @@ -2410,7 +2455,7 @@ from the dynamic block definition." (if level-p "| " "") ; level column, maybe (if timestamp "| " "") ; timestamp column, maybe (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (org-minutes-to-hh:mm-string (nth 1 tbl))))) ; the time + (org-minutes-to-clocksum-string (nth 1 tbl))))) ; the time ;; Get the list of node entries and iterate over it (setq entries (nth 2 tbl)) @@ -2443,7 +2488,7 @@ from the dynamic block definition." hlc headline hlc "|" ; headline (make-string (min (1- ntcol) (or (- level 1))) ?|) ; empty fields for higher levels - hlc (org-minutes-to-hh:mm-string (nth 3 entry)) hlc ; time + hlc (org-minutes-to-clocksum-string (nth 3 entry)) hlc ; time "|\n" ; close line ))))) ;; When exporting subtrees or regions the region might be @@ -2516,13 +2561,15 @@ from the dynamic block definition." (let* ((p1 (copy-sequence params)) (ts (plist-get p1 :tstart)) (te (plist-get p1 :tend)) + (ws (plist-get p1 :wstart)) + (ms (plist-get p1 :mstart)) (step0 (plist-get p1 :step)) (step (cdr (assoc step0 '((day . 86400) (week . 604800))))) (stepskip0 (plist-get p1 :stepskip0)) (block (plist-get p1 :block)) - cc range-text step-time) + cc range-text step-time tsb) (when block - (setq cc (org-clock-special-range block nil t) + (setq cc (org-clock-special-range block nil t ws ms) ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) (cond ((numberp ts) @@ -2540,17 +2587,21 @@ from the dynamic block definition." (te (setq te (org-float-time (apply 'encode-time (org-parse-time-string te)))))) + (setq tsb + (if (eq step0 'week) + (- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws))) + ts)) (setq p1 (plist-put p1 :header "")) (setq p1 (plist-put p1 :step nil)) (setq p1 (plist-put p1 :block nil)) - (while (< ts te) + (while (< tsb te) (or (bolp) (insert "\n")) (setq p1 (plist-put p1 :tstart (format-time-string (org-time-stamp-format nil t) - (seconds-to-time ts)))) + (seconds-to-time (max tsb ts))))) (setq p1 (plist-put p1 :tend (format-time-string (org-time-stamp-format nil t) - (seconds-to-time (setq ts (+ ts step)))))) + (seconds-to-time (min te (setq tsb (+ tsb step))))))) (insert "\n" (if (eq step0 'day) "Daily report: " "Weekly report starting on: ") (plist-get p1 :tstart) "\n") @@ -2592,6 +2643,8 @@ TIME: The sum of all time spend in this tree, in minutes. This time (timestamp (plist-get params :timestamp)) (ts (plist-get params :tstart)) (te (plist-get params :tend)) + (ws (plist-get params :wstart)) + (ms (plist-get params :mstart)) (block (plist-get params :block)) (link (plist-get params :link)) (tags (plist-get params :tags)) @@ -2603,7 +2656,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time (setq org-clock-file-total-minutes nil) (when block - (setq cc (org-clock-special-range block nil t) + (setq cc (org-clock-special-range block nil t ws ms) ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) (when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts))) (when (integerp te) (setq te (calendar-gregorian-from-absolute te))) @@ -2613,9 +2666,9 @@ TIME: The sum of all time spend in this tree, in minutes. This time (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te)))) ;; Now the times are strings we can parse. (if ts (setq ts (org-float-time - (apply 'encode-time (org-parse-time-string ts))))) + (seconds-to-time (org-matcher-time ts))))) (if te (setq te (org-float-time - (apply 'encode-time (org-parse-time-string te))))) + (seconds-to-time (org-matcher-time te))))) (save-excursion (org-clock-sum ts te (unless (null matcher) @@ -2759,9 +2812,7 @@ The details of what will be saved are regulated by the variable (buffer-file-name b) (or (not org-clock-persist-query-save) (y-or-n-p (concat "Save current clock (" - (substring-no-properties - org-clock-heading) - ") ")))) + org-clock-heading ") ")))) (insert "(setq resume-clock '(\"" (buffer-file-name (org-clocking-buffer)) "\" . " (int-to-string (marker-position org-clock-marker)) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 5a59196ba..a98deecca 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -36,7 +36,7 @@ (declare-function org-clock-sum-today "org-clock" (&optional headline-filter)) (when (featurep 'xemacs) - (error "Do not load this file into XEmacs, use `org-colview-xemacs.el'")) + (error "Do not load this file into XEmacs, use `org-colview-xemacs.el' from the contrib/ directory")) ;;; Column View @@ -223,7 +223,7 @@ This is the compiled version of the format.") (setq s2 (org-columns-add-ellipses (or modval val) width)) (setq string (format f s2)) ;; Create the overlay - (org-unmodified + (org-with-silent-modifications (setq ov (org-columns-new-overlay beg (setq beg (1+ beg)) string (if dateline face1 face))) (overlay-put ov 'keymap org-columns-map) @@ -332,7 +332,7 @@ for the duration of the command.") (remove-hook 'post-command-hook 'org-columns-hscoll-title 'local)) (move-marker org-columns-begin-marker nil) (move-marker org-columns-top-level-marker nil) - (org-unmodified + (org-with-silent-modifications (mapc 'delete-overlay org-columns-overlays) (setq org-columns-overlays nil) (let ((inhibit-read-only t)) @@ -384,7 +384,7 @@ CPHR is the complex heading regexp to use for parsing ITEM." (defun org-columns-quit () "Remove the column overlays and in this way exit column editing." (interactive) - (org-unmodified + (org-with-silent-modifications (org-columns-remove-overlays) (let ((inhibit-read-only t)) (remove-text-properties (point-min) (point-max) '(read-only t)))) @@ -488,7 +488,7 @@ Where possible, use the standard interface for changing this line." (org-agenda-columns))) (t (let ((inhibit-read-only t)) - (org-unmodified + (org-with-silent-modifications (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))) (unwind-protect @@ -589,9 +589,9 @@ an integer, select that value." (if (= nth -1) (setq nth 9))) (when (equal key "ITEM") (error "Cannot edit item headline from here")) - (unless (or allowed (member key '("SCHEDULED" "DEADLINE"))) + (unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))) (error "Allowed values for this property have not been defined")) - (if (member key '("SCHEDULED" "DEADLINE")) + (if (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")) (setq nval (if previous 'earlier 'later)) (if previous (setq allowed (reverse allowed))) (cond @@ -920,7 +920,7 @@ Don't set this, this is meant for dynamic scoping.") (defun org-columns-compute-all () "Compute all columns that have operators defined." - (org-unmodified + (org-with-silent-modifications (remove-text-properties (point-min) (point-max) '(org-summaries t))) (let ((columns org-columns-current-fmt-compiled) (org-columns-time (time-to-number-of-days (current-time))) @@ -996,7 +996,7 @@ Don't set this, this is meant for dynamic scoping.") (if (assoc property sum-alist) (setcdr (assoc property sum-alist) useval) (push (cons property useval) sum-alist) - (org-unmodified + (org-with-silent-modifications (add-text-properties sumpos (1+ sumpos) (list 'org-summaries sum-alist)))) (when (and val (not (equal val (if flag str val)))) @@ -1058,8 +1058,7 @@ Don't set this, this is meant for dynamic scoping.") ((memq fmt '(estimate)) (org-estimate-print n printf)) ((not (numberp n)) "") ((memq fmt '(add_times max_times min_times mean_times)) - (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h)))))) - (format org-time-clocksum-format h m))) + (org-hours-to-clocksum-string n)) ((eq fmt 'checkbox) (cond ((= n (floor n)) "[X]") ((> n 1.) "[-]") @@ -1404,7 +1403,7 @@ and tailing newline characters." ;; OK, the property is not defined. Use appointment duration? (when (and org-agenda-columns-add-appointments-to-effort-sum (setq d (get-text-property (point) 'duration))) - (setq d (org-minutes-to-hh:mm-string d)) + (setq d (org-minutes-to-clocksum-string d)) (put-text-property 0 (length d) 'face 'org-warning d) (push (cons org-effort-property d) p))) (push (cons (org-current-line) p) cache)) @@ -1510,9 +1509,8 @@ This will add overlays to the date lines, to show the summary for each day." (save-excursion (save-restriction (widen) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(org-summaries t))) + (org-with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) (goto-char (point-min)) (org-columns-get-format-and-top-level) (while (setq fm (pop fmt)) diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 9292b9943..bd81f6815 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -113,6 +113,18 @@ any other entries, and any resulting duplicates will be removed entirely." ;;;; Emacs/XEmacs compatibility +(defun org-defvaralias (new-alias base-variable &optional docstring) + "Compatibility function for defvaralias. +Don't do the aliasing when `defvaralias' is not bound." + (declare (indent 1)) + (when (fboundp 'defvaralias) + (defvaralias new-alias base-variable docstring))) + +(eval-and-compile + (when (and (not (boundp 'user-emacs-directory)) + (boundp 'user-init-directory)) + (org-defvaralias 'user-emacs-directory 'user-init-directory))) + ;; Keys (defconst org-xemacs-key-equivalents '(([mouse-1] . [button1]) @@ -226,7 +238,7 @@ ignored in this case." ;; Region compatibility (defvar org-ignore-region nil - "To temporarily disable the active region.") + "Non-nil means temporarily disable the active region.") (defun org-region-active-p () "Is `transient-mark-mode' on and the region active? @@ -484,6 +496,29 @@ With two arguments, return floor and remainder of their quotient." (defun org-release () "N/A") (defun org-git-version () "N/A !!check installation!!")))))) +(defun org-file-equal-p (f1 f2) + "Return t if files F1 and F2 are the same. +Implements `file-equal-p' for older emacsen and XEmacs." + (if (fboundp 'file-equal-p) + (file-equal-p f1 f2) + (let (f1-attr f2-attr) + (and (setq f1-attr (file-attributes (file-truename f1))) + (setq f2-attr (file-attributes (file-truename f2))) + (equal f1-attr f2-attr))))) + +;; `buffer-narrowed-p' is available for Emacs >=24.3 +(defun org-buffer-narrowed-p () + "Compatibility function for `buffer-narrowed-p'." + (if (fboundp 'buffer-narrowed-p) + (buffer-narrowed-p) + (/= (- (point-max) (point-min)) (buffer-size)))) + +(defmacro org-with-silent-modifications (&rest body) + (if (fboundp 'with-silent-modifications) + `(with-silent-modifications ,@body) + `(org-unmodified ,@body))) +(def-edebug-spec org-with-silent-modifications (body)) + (provide 'org-compat) ;;; org-compat.el ends here diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el index 2dfc4addc..b02a7ceff 100644 --- a/lisp/org-crypt.el +++ b/lisp/org-crypt.el @@ -139,11 +139,11 @@ See `org-crypt-disable-auto-save'." (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage.")) ((eq org-crypt-disable-auto-save 'encrypt) (message "org-decrypt: Enabling re-encryption on auto-save.") - (add-hook 'auto-save-hook - (lambda () - (message "org-crypt: Re-encrypting all decrypted entries due to auto-save.") - (org-encrypt-entries)) - nil t)) + (org-add-hook 'auto-save-hook + (lambda () + (message "org-crypt: Re-encrypting all decrypted entries due to auto-save.") + (org-encrypt-entries)) + nil t)) (t nil)))) (defun org-crypt-key-for-heading () @@ -264,7 +264,7 @@ See `org-crypt-disable-auto-save'." "Add a hook to automatically encrypt entries before a file is saved to disk." (add-hook 'org-mode-hook - (lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t)))) + (lambda () (org-add-hook 'before-save-hook 'org-encrypt-entries nil t)))) (add-hook 'org-reveal-start-hook 'org-decrypt-entry) diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el index e0f4d10bc..dd4b1b0e1 100644 --- a/lisp/org-datetree.el +++ b/lisp/org-datetree.el @@ -72,7 +72,8 @@ tree can be found." (goto-char (prog1 (point) (widen)))))) (defun org-datetree-find-year-create (year) - (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(.*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)") + "Find the YEAR datetree or create it." + (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)") match) (goto-char (point-min)) (while (and (setq match (re-search-forward re nil t)) @@ -90,6 +91,7 @@ tree can be found." (org-datetree-insert-line year))))) (defun org-datetree-find-month-create (year month) + "Find the datetree for YEAR and MONTH or create it." (org-narrow-to-subtree) (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year)) match) @@ -109,6 +111,7 @@ tree can be found." (org-datetree-insert-line year month))))) (defun org-datetree-find-day-create (year month day) + "Find the datetree for YEAR, MONTH and DAY or create it." (org-narrow-to-subtree) (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month)) match) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el deleted file mode 100644 index 5253d9100..000000000 --- a/lisp/org-docbook.el +++ /dev/null @@ -1,1453 +0,0 @@ -;;; org-docbook.el --- DocBook exporter for org-mode -;; -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. -;; -;; Emacs Lisp Archive Entry -;; Filename: org-docbook.el -;; Author: Baoqiu Cui -;; Maintainer: Baoqiu Cui -;; Keywords: org, wp, docbook -;; Description: Converts an org-mode buffer into DocBook -;; URL: - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; -;; This library implements a DocBook exporter for org-mode. The basic -;; idea and design is very similar to what `org-export-as-html' has. -;; Code prototype was also started with `org-export-as-html'. -;; -;; Put this file into your load-path and the following line into your -;; ~/.emacs: -;; -;; (require 'org-docbook) -;; -;; The interactive functions are similar to those of the HTML and LaTeX -;; exporters: -;; -;; M-x `org-export-as-docbook' -;; M-x `org-export-as-docbook-pdf' -;; M-x `org-export-as-docbook-pdf-and-open' -;; M-x `org-export-as-docbook-batch' -;; M-x `org-export-as-docbook-to-buffer' -;; M-x `org-export-region-as-docbook' -;; M-x `org-replace-region-by-docbook' -;; -;; Note that, in order to generate PDF files using the DocBook XML files -;; created by DocBook exporter, the following two variables have to be -;; set based on what DocBook tools you use for XSLT processor and XSL-FO -;; processor: -;; -;; org-export-docbook-xslt-proc-command -;; org-export-docbook-xsl-fo-proc-command -;; -;; Check the document of these two variables to see examples of how they -;; can be set. -;; -;; If the Org file to be exported contains special characters written in -;; TeX-like syntax, like \alpha and \beta, you need to include the right -;; entity file(s) in the DOCTYPE declaration for the DocBook XML file. -;; This is required to make the DocBook XML file valid. The DOCTYPE -;; declaration string can be set using the following variable: -;; -;; org-export-docbook-doctype -;; -;;; Code: - -(eval-when-compile - (require 'cl)) - -(require 'footnote) -(require 'org) -(require 'org-exp) -(require 'org-html) -(require 'format-spec) - -;;; Variables: - -(defvar org-docbook-para-open nil) -(defvar org-export-docbook-inline-images t) -(defvar org-export-docbook-link-org-files-as-docbook nil) - -(declare-function org-id-find-id-file "org-id" (id)) - -;;; User variables: - -(defgroup org-export-docbook nil - "Options for exporting Org-mode files to DocBook." - :tag "Org Export DocBook" - :group 'org-export) - -(defcustom org-export-docbook-extension ".xml" - "Extension of DocBook XML files." - :group 'org-export-docbook - :type 'string) - -(defcustom org-export-docbook-header "\n" - "Header of DocBook XML files." - :group 'org-export-docbook - :type 'string) - -(defcustom org-export-docbook-doctype nil - "DOCTYPE declaration string for DocBook XML files. -This can be used to include entities that are needed to handle -special characters in Org files. - -For example, if the Org file to be exported contains XHTML -entities, you can set this variable to: - -\" -%xhtml1-symbol; -]> -\" - -If you want to process DocBook documents without an Internet -connection, it is suggested that you download the required entity -file(s) and use system identifier(s) (external files) in the -DOCTYPE declaration." - :group 'org-export-docbook - :type 'string) - -(defcustom org-export-docbook-article-header "
    " - "Article header of DocBook XML files." - :group 'org-export-docbook - :type 'string) - -(defcustom org-export-docbook-section-id-prefix "sec-" - "Prefix of section IDs used during exporting. -This can be set before exporting to avoid same set of section IDs -being used again and again, which can be a problem when multiple -people work on the same document." - :group 'org-export-docbook - :type 'string) - -(defcustom org-export-docbook-footnote-id-prefix "fn-" - "The prefix of footnote IDs used during exporting. -Like `org-export-docbook-section-id-prefix', this variable can help -avoid same set of footnote IDs being used multiple times." - :group 'org-export-docbook - :type 'string) - -(defcustom org-export-docbook-footnote-separator ", " - "Text used to separate footnotes." - :group 'org-export-docbook - :version "24.1" - :type 'string) - -(defcustom org-export-docbook-emphasis-alist - `(("*" "" "") - ("/" "" "") - ("_" "" "") - ("=" "" "") - ("~" "" "") - ("+" "" "")) - "A list of DocBook expressions to convert emphasis fontifiers. -Each element of the list is a list of three elements. -The first element is the character used as a marker for fontification. -The second element is a format string to wrap fontified text with. -The third element decides whether to protect converted text from other -conversions." - :group 'org-export-docbook - :type 'alist) - -(defcustom org-export-docbook-default-image-attributes - `(("align" . "\"center\"") - ("valign". "\"middle\"")) - "Alist of default DocBook image attributes. -These attributes will be inserted into element by -default, but users can override them using `#+ATTR_DocBook:'." - :group 'org-export-docbook - :type 'alist) - -(defcustom org-export-docbook-inline-image-extensions - '("jpeg" "jpg" "png" "gif" "svg") - "Extensions of image files that can be inlined into DocBook." - :group 'org-export-docbook - :type '(repeat (string :tag "Extension"))) - -(defcustom org-export-docbook-coding-system nil - "Coding system for DocBook XML files." - :group 'org-export-docbook - :type 'coding-system) - -(defcustom org-export-docbook-xslt-stylesheet nil - "File name of the XSLT stylesheet used by DocBook exporter. -This XSLT stylesheet is used by -`org-export-docbook-xslt-proc-command' to generate the Formatting -Object (FO) files. You can use either `fo/docbook.xsl' that -comes with DocBook, or any customization layer you may have." - :group 'org-export-docbook - :version "24.1" - :type 'string) - -(defcustom org-export-docbook-xslt-proc-command nil - "Format of XSLT processor command used by DocBook exporter. -This command is used to process a DocBook XML file to generate -the Formatting Object (FO) file. - -The value of this variable should be a format control string that -includes three arguments: `%i', `%o', and `%s'. During exporting -time, `%i' is replaced by the input DocBook XML file name, `%o' -is replaced by the output FO file name, and `%s' is replaced by -`org-export-docbook-xslt-stylesheet' (or the #+XSLT option if it -is specified in the Org file). - -For example, if you use Saxon as the XSLT processor, you may want -to set the variable to - - \"java com.icl.saxon.StyleSheet -o %o %i %s\" - -If you use Xalan, you can set it to - - \"java org.apache.xalan.xslt.Process -out %o -in %i -xsl %s\" - -For xsltproc, the following string should work: - - \"xsltproc --output %o %s %i\" - -You can include additional stylesheet parameters in this command. -Just make sure that they meet the syntax requirement of each -processor." - :group 'org-export-docbook - :type 'string) - -(defcustom org-export-docbook-xsl-fo-proc-command nil - "Format of XSL-FO processor command used by DocBook exporter. -This command is used to process a Formatting Object (FO) file to -generate the PDF file. - -The value of this variable should be a format control string that -includes two arguments: `%i' and `%o'. During exporting time, -`%i' is replaced by the input FO file name, and `%o' is replaced -by the output PDF file name. - -For example, if you use FOP as the XSL-FO processor, you can set -the variable to - - \"fop %i %o\"" - :group 'org-export-docbook - :type 'string) - -(defcustom org-export-docbook-keywords-markup "%s" - "A printf format string to be applied to keywords by DocBook exporter." - :group 'org-export-docbook - :type 'string) - -(defcustom org-export-docbook-timestamp-markup "%s" - "A printf format string to be applied to time stamps by DocBook exporter." - :group 'org-export-docbook - :type 'string) - -;;; Hooks - -(defvar org-export-docbook-final-hook nil - "Hook run at the end of DocBook export, in the new buffer.") - -;;; Autoload functions: - -;;;###autoload -(defun org-export-as-docbook-batch () - "Call `org-export-as-docbook' in batch style. -This function can be used in batch processing. - -For example: - -$ emacs --batch - --load=$HOME/lib/emacs/org.el - --visit=MyOrgFile.org --funcall org-export-as-docbook-batch" - (org-export-as-docbook)) - -;;;###autoload -(defun org-export-as-docbook-to-buffer () - "Call `org-export-as-docbook' with output to a temporary buffer. -No file is created." - (interactive) - (org-export-as-docbook nil "*Org DocBook Export*") - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window "*Org DocBook Export*"))) - -;;;###autoload -(defun org-replace-region-by-docbook (beg end) - "Replace the region from BEG to END with its DocBook export. -It assumes the region has `org-mode' syntax, and then convert it to -DocBook. This can be used in any buffer. For example, you could -write an itemized list in `org-mode' syntax in an DocBook buffer and -then use this command to convert it." - (interactive "r") - (let (reg docbook buf) - (save-window-excursion - (if (derived-mode-p 'org-mode) - (setq docbook (org-export-region-as-docbook - beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq docbook (org-export-region-as-docbook - (point-min) (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert docbook))) - -;;;###autoload -(defun org-export-region-as-docbook (beg end &optional body-only buffer) - "Convert region from BEG to END in `org-mode' buffer to DocBook. -If prefix arg BODY-ONLY is set, omit file header and footer and -only produce the region of converted text, useful for -cut-and-paste operations. If BUFFER is a buffer or a string, -use/create that buffer as a target of the converted DocBook. If -BUFFER is the symbol `string', return the produced DocBook as a -string and leave not buffer behind. For example, a Lisp program -could call this function in the following way: - - (setq docbook (org-export-region-as-docbook beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (interactive "r\nP") - (when (org-called-interactively-p 'any) - (setq buffer "*Org DocBook Export*")) - (let ((transient-mark-mode t) - (zmacs-regions t) - rtn) - (goto-char end) - (set-mark (point)) ;; To activate the region - (goto-char beg) - (setq rtn (org-export-as-docbook nil buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (org-called-interactively-p 'any) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -;;;###autoload -(defun org-export-as-docbook-pdf (&optional ext-plist to-buffer body-only pub-dir) - "Export as DocBook XML file, and generate PDF file." - (interactive "P") - (if (or (not org-export-docbook-xslt-proc-command) - (not (string-match "%[ios].+%[ios].+%[ios]" org-export-docbook-xslt-proc-command))) - (error "XSLT processor command is not set correctly")) - (if (or (not org-export-docbook-xsl-fo-proc-command) - (not (string-match "%[io].+%[io]" org-export-docbook-xsl-fo-proc-command))) - (error "XSL-FO processor command is not set correctly")) - (message "Exporting to PDF...") - (let* ((wconfig (current-window-configuration)) - (opt-plist - (org-export-process-option-filters - (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist)))) - (docbook-buf (org-export-as-docbook ext-plist to-buffer body-only pub-dir)) - (filename (buffer-file-name docbook-buf)) - (base (file-name-sans-extension filename)) - (fofile (concat base ".fo")) - (pdffile (concat base ".pdf"))) - (and (file-exists-p pdffile) (delete-file pdffile)) - (message "Processing DocBook XML file...") - (shell-command (format-spec org-export-docbook-xslt-proc-command - (format-spec-make - ?i (shell-quote-argument filename) - ?o (shell-quote-argument fofile) - ?s (shell-quote-argument - (or (plist-get opt-plist :xslt) - org-export-docbook-xslt-stylesheet))))) - (shell-command (format-spec org-export-docbook-xsl-fo-proc-command - (format-spec-make - ?i (shell-quote-argument fofile) - ?o (shell-quote-argument pdffile)))) - (message "Processing DocBook file...done") - (if (not (file-exists-p pdffile)) - (error "PDF file was not produced") - (set-window-configuration wconfig) - (message "Exporting to PDF...done") - pdffile))) - -;;;###autoload -(defun org-export-as-docbook-pdf-and-open () - "Export as DocBook XML file, generate PDF file, and open it." - (interactive) - (let ((pdffile (org-export-as-docbook-pdf))) - (if pdffile - (org-open-file pdffile) - (error "PDF file was not produced")))) - -(defvar org-heading-keyword-regexp-format) ; defined in org.el - -;;;###autoload -(defun org-export-as-docbook (&optional ext-plist to-buffer body-only pub-dir) - "Export the current buffer as a DocBook file. -If there is an active region, export only the region. When -HIDDEN is obsolete and does nothing. EXT-PLIST is a -property list with external parameters overriding org-mode's -default settings, but still inferior to file-local settings. -When TO-BUFFER is non-nil, create a buffer with that name and -export to that buffer. If TO-BUFFER is the symbol `string', -don't leave any buffer behind but just return the resulting HTML -as a string. When BODY-ONLY is set, don't produce the file -header and footer, simply return the content of the document (all -top-level sections). When PUB-DIR is set, use this as the -publishing directory." - (interactive "P") - (run-hooks 'org-export-first-hook) - - ;; Make sure we have a file name when we need it. - (when (and (not (or to-buffer body-only)) - (not buffer-file-name)) - (if (buffer-base-buffer) - (org-set-local 'buffer-file-name - (with-current-buffer (buffer-base-buffer) - buffer-file-name)) - (error "Need a file name to be able to export"))) - - (message "Exporting...") - (setq-default org-todo-line-regexp org-todo-line-regexp) - (setq-default org-deadline-line-regexp org-deadline-line-regexp) - (setq-default org-done-keywords org-done-keywords) - (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp) - (let* ((opt-plist - (org-export-process-option-filters - (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist)))) - (link-validate (plist-get opt-plist :link-validation-function)) - valid - (odd org-odd-levels-only) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (level-offset (if subtree-p - (save-excursion - (goto-char rbeg) - (+ (funcall outline-level) - (if org-odd-levels-only 1 0))) - 0)) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-export-directory :docbook opt-plist))) - (org-current-export-file buffer-file-name) - (level 0) (line "") (origline "") txt todo - (filename (if to-buffer nil - (expand-file-name - (concat - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory buffer-file-name))) - org-export-docbook-extension) - (file-name-as-directory - (or pub-dir (org-export-directory :docbook opt-plist)))))) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (auto-insert nil); Avoid any auto-insert stuff for the new file - (buffer (if to-buffer - (cond - ((eq to-buffer 'string) - (get-buffer-create "*Org DocBook Export*")) - (t (get-buffer-create to-buffer))) - (find-file-noselect filename))) - ;; org-levels-open is a global variable - (org-levels-open (make-vector org-level-max nil)) - (date (plist-get opt-plist :date)) - (author (or (plist-get opt-plist :author) - user-full-name)) - (email (plist-get opt-plist :email)) - firstname othername surname - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "UNTITLED")) - ;; We will use HTML table formatter to export tables to DocBook - ;; format, so need to set html-table-tag here. - (html-table-tag (plist-get opt-plist :html-table-tag)) - (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)")) - (quote-re (format org-heading-keyword-regexp-format - org-quote-string)) - (inquote nil) - (infixed nil) - (inverse nil) - (llt org-plain-list-ordered-item-terminator) - (email (plist-get opt-plist :email)) - (language (plist-get opt-plist :language)) - (lang-words nil) - cnt - (start 0) - (coding-system (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system)) - (coding-system-for-write (or org-export-docbook-coding-system - coding-system)) - (save-buffer-coding-system (or org-export-docbook-coding-system - coding-system)) - (charset (and coding-system-for-write - (fboundp 'coding-system-get) - (coding-system-get coding-system-for-write - 'mime-charset))) - (region - (buffer-substring - (if region-p (region-beginning) (point-min)) - (if region-p (region-end) (point-max)))) - (org-export-footnotes-seen nil) - (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) - (lines - (org-split-string - (org-export-preprocess-string - region - :emph-multiline t - :for-backend 'docbook - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get opt-plist :drawers) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :timestamps (plist-get opt-plist :timestamps) - :archived-trees - (plist-get opt-plist :archived-trees) - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :add-text - (plist-get opt-plist :text) - :LaTeX-fragments - (plist-get opt-plist :LaTeX-fragments)) - "[\r\n]")) - ;; Use literal output to show check boxes. - (checkbox-start - (nth 1 (assoc "=" org-export-docbook-emphasis-alist))) - (checkbox-end - (nth 2 (assoc "=" org-export-docbook-emphasis-alist))) - table-open type - table-buffer table-orig-buffer - ind item-type starter - rpl path attr caption label desc descp desc1 desc2 link - fnc item-tag item-number - footref-seen footnote-list - id-file - ) - - ;; Fine detailed info about author name. - (if (string-match "\\([^ ]+\\) \\(.+ \\)?\\([^ ]+\\)" author) - (progn - (setq firstname (match-string 1 author) - othername (or (match-string 2 author) "") - surname (match-string 3 author)))) - - ;; Get all footnote text. - (setq footnote-list - (org-export-docbook-get-footnotes lines)) - - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (setq org-min-level (org-get-min-level lines level-offset)) - (setq org-last-level org-min-level) - (org-init-section-numbers) - - ;; Get and save the date. - (cond - ((and date (string-match "%" date)) - (setq date (format-time-string date))) - (date) - (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) - - ;; Get the language-dependent settings - (setq lang-words (or (assoc language org-export-language-setup) - (assoc "en" org-export-language-setup))) - - ;; Switch to the output buffer. Use fundamental-mode for now. We - ;; could turn on nXML mode later and do some indentation. - (set-buffer buffer) - (let ((inhibit-read-only t)) (erase-buffer)) - (fundamental-mode) - (org-install-letbind) - - (and (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system coding-system-for-write)) - - ;; The main body... - (let ((case-fold-search nil) - (org-odd-levels-only odd)) - - ;; Create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - - ;; Insert DocBook file header, title, and author info. - (unless body-only - (insert org-export-docbook-header) - (if org-export-docbook-doctype - (insert org-export-docbook-doctype)) - (insert "\n") - (insert (format "\n" - (org-version) emacs-major-version)) - (insert org-export-docbook-article-header) - (insert (format - "\n %s - - - - %s %s %s - - %s - - \n" - (org-docbook-expand title) - firstname othername surname - (if (and org-export-email-info - email (string-match "\\S-" email)) - (concat "" email "") "") - ))) - - (org-init-section-numbers) - - (org-export-docbook-open-para) - - ;; Loop over all the lines... - (while (setq line (pop lines) origline line) - (catch 'nextline - - ;; End of quote section? - (when (and inquote (string-match org-outline-regexp-bol line)) - (insert "]]>\n") - (org-export-docbook-open-para) - (setq inquote nil)) - ;; Inside a quote section? - (when inquote - (insert (org-docbook-protect line) "\n") - (throw 'nextline nil)) - - ;; Fixed-width, verbatim lines (examples) - (when (and org-export-with-fixed-width - (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line)) - (when (not infixed) - (setq infixed t) - (org-export-docbook-close-para-maybe) - (insert "\n") - (org-export-docbook-open-para)) - (throw 'nextline nil)) - - ;; Protected HTML - (when (get-text-property 0 'org-protected line) - (let (par (ind (get-text-property 0 'original-indentation line))) - (when (re-search-backward - "\\(\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t) - (setq par (match-string 1)) - (replace-match "\\2\n")) - (insert line "\n") - (while (and lines - (or (= (length (car lines)) 0) - (not ind) - (equal ind (get-text-property 0 'original-indentation (car lines)))) - (or (= (length (car lines)) 0) - (get-text-property 0 'org-protected (car lines)))) - (insert (pop lines) "\n")) - (and par (insert "\n"))) - (throw 'nextline nil)) - - ;; Start of block quotes and verses - (when (or (equal "ORG-BLOCKQUOTE-START" line) - (and (equal "ORG-VERSE-START" line) - (setq inverse t))) - (org-export-docbook-close-para-maybe) - (insert "
    ") - ;; Check whether attribution for this blockquote exists. - (let (tmp1 - attribution - (end (if inverse "ORG-VERSE-END" "ORG-BLOCKQUOTE-END")) - (quote-lines nil)) - (while (and (setq tmp1 (pop lines)) - (not (equal end tmp1))) - (push tmp1 quote-lines)) - (push tmp1 lines) ; Put back quote end mark - ;; Check the last line in the quote to see if it contains - ;; the attribution. - (setq tmp1 (pop quote-lines)) - (if (string-match "\\(^.*\\)\\(--[ \t]+\\)\\(.+\\)$" tmp1) - (progn - (setq attribution (match-string 3 tmp1)) - (when (save-match-data - (string-match "[^ \t]" (match-string 1 tmp1))) - (push (match-string 1 tmp1) lines))) - (push tmp1 lines)) - (while (setq tmp1 (pop quote-lines)) - (push tmp1 lines)) - (when attribution - (insert "" attribution ""))) - ;; Insert for verse. - (if inverse - (insert "\n") - (org-export-docbook-open-para)) - (throw 'nextline nil)) - - ;; End of block quotes - (when (equal "ORG-BLOCKQUOTE-END" line) - (org-export-docbook-close-para-maybe) - (insert "
    \n") - (org-export-docbook-open-para) - (throw 'nextline nil)) - - ;; End of verses - (when (equal "ORG-VERSE-END" line) - (insert "\n\n") - (org-export-docbook-open-para) - (setq inverse nil) - (throw 'nextline nil)) - - ;; Text centering. Element does not - ;; seem to work with FOP, so for now we use to - ;; center the text, which can contain multiple paragraphs. - (when (equal "ORG-CENTER-START" line) - (org-export-docbook-close-para-maybe) - (insert "\n" - "\n" - "\n") - (org-export-docbook-open-para) - (throw 'nextline nil)) - - (when (equal "ORG-CENTER-END" line) - (org-export-docbook-close-para-maybe) - (insert "\n" - "\n\n") - (org-export-docbook-open-para) - (throw 'nextline nil)) - - ;; Make targets to anchors. Note that currently FOP does not - ;; seem to support tags when generating PDF output, - ;; but this can be used in DocBook --> HTML conversion. - (setq start 0) - (while (string-match - "<<]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start) - (cond - ((get-text-property (match-beginning 1) 'org-protected line) - (setq start (match-end 1))) - ((match-end 2) - (setq line (replace-match - (format "@" - (org-solidify-link-text (match-string 1 line))) - t t line))) - (t - (setq line (replace-match - (format "@" - (org-solidify-link-text (match-string 1 line))) - t t line))))) - - ;; Put time stamps and related keywords into special mark-up - ;; elements. - (setq line (org-export-docbook-handle-time-stamps line)) - - ;; Replace "&", "<" and ">" by "&", "<" and ">". - ;; Handle @<..> HTML tags (replace "@>..<" by "<..>"). - ;; Also handle sub_superscripts and check boxes. - (or (string-match org-table-hline-regexp line) - (setq line (org-docbook-expand line))) - - ;; Format the links - (setq start 0) - (while (string-match org-bracket-link-analytic-regexp++ line start) - (setq start (match-beginning 0)) - (setq path (save-match-data (org-link-unescape - (match-string 3 line)))) - (setq type (cond - ((match-end 2) (match-string 2 line)) - ((save-match-data - (or (file-name-absolute-p path) - (string-match "^\\.\\.?/" path))) - "file") - (t "internal"))) - (setq path (org-extract-attributes (org-link-unescape path))) - (setq attr (get-text-property 0 'org-attributes path) - caption (get-text-property 0 'org-caption path) - label (get-text-property 0 'org-label path)) - (setq desc1 (if (match-end 5) (match-string 5 line)) - desc2 (if (match-end 2) (concat type ":" path) path) - descp (and desc1 (not (equal desc1 desc2))) - desc (or desc1 desc2)) - ;; Make an image out of the description if that is so wanted - (when (and descp (org-file-image-p - desc org-export-docbook-inline-image-extensions)) - (save-match-data - (if (string-match "^file:" desc) - (setq desc (substring desc (match-end 0)))))) - ;; FIXME: do we need to unescape here somewhere? - (cond - ((equal type "internal") - (setq rpl (format "%s" - (org-solidify-link-text - (save-match-data (org-link-unescape path)) nil) - (org-export-docbook-format-desc desc)))) - ((and (equal type "id") - (setq id-file (org-id-find-id-file path))) - ;; This is an id: link to another file (if it was the same file, - ;; it would have become an internal link...) - (save-match-data - (setq id-file (file-relative-name - id-file (file-name-directory org-current-export-file))) - (setq id-file (concat (file-name-sans-extension id-file) - org-export-docbook-extension)) - (setq rpl (format "%s" - id-file path (org-export-docbook-format-desc desc))))) - ((member type '("http" "https")) - ;; Standard URL, just check if we need to inline an image - (if (and (or (eq t org-export-docbook-inline-images) - (and org-export-docbook-inline-images (not descp))) - (org-file-image-p - path org-export-docbook-inline-image-extensions)) - (setq rpl (org-export-docbook-format-image - (concat type ":" path))) - (setq link (concat type ":" path)) - (setq rpl (format "%s" - (org-export-html-format-href link) - (org-export-docbook-format-desc desc))) - )) - ((member type '("ftp" "mailto" "news")) - ;; Standard URL - (setq link (concat type ":" path)) - (setq rpl (format "%s" - (org-export-html-format-href link) - (org-export-docbook-format-desc desc)))) - ((string= type "coderef") - (setq rpl (format (org-export-get-coderef-format path (and descp desc)) - (cdr (assoc path org-export-code-refs))))) - ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - ;; The link protocol has a function for format the link - (setq rpl - (save-match-data - (funcall fnc (org-link-unescape path) desc1 'html)))) - - ((string= type "file") - ;; FILE link - (let* ((filename path) - (abs-p (file-name-absolute-p filename)) - thefile file-is-image-p search) - (save-match-data - (if (string-match "::\\(.*\\)" filename) - (setq search (match-string 1 filename) - filename (replace-match "" t nil filename))) - (setq valid - (if (functionp link-validate) - (funcall link-validate filename current-dir) - t)) - (setq file-is-image-p - (org-file-image-p - filename org-export-docbook-inline-image-extensions)) - (setq thefile (if abs-p (expand-file-name filename) filename)) - ;; Carry over the properties (expand-file-name will - ;; discard the properties of filename) - (add-text-properties 0 (1- (length thefile)) - (list 'org-caption caption - 'org-attributes attr - 'org-label label) - thefile) - (when (and org-export-docbook-link-org-files-as-docbook - (string-match "\\.org$" thefile)) - (setq thefile (concat (substring thefile 0 - (match-beginning 0)) - org-export-docbook-extension)) - (if (and search - ;; make sure this is can be used as target search - (not (string-match "^[0-9]*$" search)) - (not (string-match "^\\*" search)) - (not (string-match "^/.*/$" search))) - (setq thefile (concat thefile "#" - (org-solidify-link-text - (org-link-unescape search))))) - (when (string-match "^file:" desc) - (setq desc (replace-match "" t t desc)) - (if (string-match "\\.org$" desc) - (setq desc (replace-match "" t t desc)))))) - (setq rpl (if (and file-is-image-p - (or (eq t org-export-docbook-inline-images) - (and org-export-docbook-inline-images - (not descp)))) - (progn - (message "image %s %s" thefile org-docbook-para-open) - (org-export-docbook-format-image thefile)) - (format "%s" - thefile (org-export-docbook-format-desc desc)))) - (if (not valid) (setq rpl desc)))) - - (t - ;; Just publish the path, as default - (setq rpl (concat "<" type ":" - (save-match-data (org-link-unescape path)) - ">")))) - (setq line (replace-match rpl t t line) - start (+ start (length rpl)))) - - ;; TODO items: can we do something better?! - (if (and (string-match org-todo-line-regexp line) - (match-beginning 2)) - (setq line - (concat (substring line 0 (match-beginning 2)) - "[" (match-string 2 line) "]" - (substring line (match-end 2))))) - - ;; Does this contain a reference to a footnote? - (when org-export-with-footnotes - (setq start 0) - (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start) - ;; Discard protected matches not clearly identified as - ;; footnote markers. - (if (or (get-text-property (match-beginning 2) 'org-protected line) - (not (get-text-property (match-beginning 2) 'org-footnote line))) - (setq start (match-end 2)) - (let* ((num (match-string 2 line)) - (footnote-def (assoc num footnote-list))) - (if (assoc num footref-seen) - (setq line (replace-match - (format "%s" - (match-string 1 line) - org-export-docbook-footnote-id-prefix num) - t t line)) - (setq line (replace-match - (concat - (format "%s%s" - (match-string 1 line) - org-export-docbook-footnote-id-prefix - num - (if footnote-def - (save-match-data - (org-docbook-expand (cdr footnote-def))) - (format "FOOTNOTE DEFINITION NOT FOUND: %s" num))) - ;; If another footnote is following the - ;; current one, add a separator. - (if (save-match-data - (string-match "\\`\\[[0-9]+\\]" - (substring line (match-end 0)))) - org-export-docbook-footnote-separator - "")) - t t line)) - (push (cons num 1) footref-seen)))))) - - (cond - ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line) - ;; This is a headline - (setq level (org-tr-level (- (match-end 1) (match-beginning 1) - level-offset)) - txt (match-string 2 line)) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (org-export-docbook-level-start level txt) - ;; QUOTES - (when (string-match quote-re line) - (org-export-docbook-close-para-maybe) - (insert ". - ;; Org-mode supports line break "\\" in HTML exporter, and - ;; some DocBook users may also want to force line breaks - ;; even though DocBook only supports that in - ;; . - - (insert line "\n"))))) - - ;; Properly close all local lists and other lists - (when inquote - (insert "]]>\n") - (org-export-docbook-open-para)) - - ;; Close all open sections. - (org-export-docbook-level-start 1 nil) - - (unless (plist-get opt-plist :buffer-will-be-killed) - (normal-mode) - (if (eq major-mode (default-value 'major-mode)) - (nxml-mode))) - - ;; Remove empty paragraphs. Replace them with a newline. - (goto-char (point-min)) - (while (re-search-forward - "[ \r\n\t]*\\(\\)[ \r\n\t]*[ \r\n\t]*" nil t) - (when (not (get-text-property (match-beginning 1) 'org-protected)) - (replace-match "\n") - (backward-char 1))) - ;; Fill empty sections with . This is to make sure - ;; that the DocBook document generated is valid and well-formed. - (goto-char (point-min)) - (while (re-search-forward - "\\([ \r\n\t]*\\)" nil t) - (when (not (get-text-property (match-beginning 0) 'org-protected)) - (replace-match "\n\n" nil nil nil 1))) - ;; Insert the last closing tag. - (goto-char (point-max)) - (unless body-only - (insert "
    ")) - (run-hooks 'org-export-docbook-final-hook) - (or to-buffer (save-buffer)) - (goto-char (point-min)) - (or (org-export-push-to-kill-ring "DocBook") - (message "Exporting... done")) - (if (eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer))) - (current-buffer))))) - -(defun org-export-docbook-open-para () - "Insert , but first close previous paragraph if any." - (org-export-docbook-close-para-maybe) - (insert "\n") - (setq org-docbook-para-open t)) - -(defun org-export-docbook-close-para-maybe () - "Close DocBook paragraph if there is one open." - (when org-docbook-para-open - (insert "\n") - (setq org-docbook-para-open nil))) - -(defun org-export-docbook-close-li (&optional type) - "Close list if necessary." - (org-export-docbook-close-para-maybe) - (if (equal type "d") - (insert "\n") - (insert "\n"))) - -(defun org-export-docbook-level-start (level title) - "Insert a new level in DocBook export. -When TITLE is nil, just close all open levels." - (org-export-docbook-close-para-maybe) - (let* ((target (and title (org-get-text-property-any 0 'target title))) - (l org-level-max) - section-number) - (while (>= l level) - (if (aref org-levels-open (1- l)) - (progn - (insert "\n") - (aset org-levels-open (1- l) nil))) - (setq l (1- l))) - (when title - ;; If title is nil, this means this function is called to close - ;; all levels, so the rest is done only if title is given. - ;; - ;; Format tags: put them into a superscript like format. - (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) - (setq title - (replace-match - (if org-export-with-tags - (save-match-data - (concat - "" - (match-string 1 title) - "")) - "") - t t title))) - (aset org-levels-open (1- level) t) - (setq section-number (org-section-number level)) - (insert (format "\n
    \n%s" - org-export-docbook-section-id-prefix - (replace-regexp-in-string "\\." "_" section-number) - title)) - (org-export-docbook-open-para)))) - -(defun org-docbook-expand (string) - "Prepare STRING for DocBook export. -Applies all active conversions. If there are links in the -string, don't modify these." - (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) - m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-docbook-do-expand s) res) - (push l res)) - (push (org-docbook-do-expand string) res) - (apply 'concat (nreverse res)))) - -(defun org-docbook-do-expand (s) - "Apply all active conversions to translate special ASCII to DocBook." - (setq s (org-html-protect s)) - (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" t nil s))) - (if org-export-with-emphasize - (setq s (org-export-docbook-convert-emphasize s))) - (if org-export-with-special-strings - (setq s (org-export-docbook-convert-special-strings s))) - (if org-export-with-sub-superscripts - (setq s (org-export-docbook-convert-sub-super s))) - (if org-export-with-TeX-macros - (let ((start 0) wd rep) - (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?" - s start)) - (if (get-text-property (match-beginning 0) 'org-protected s) - (setq start (match-end 0)) - (setq wd (match-string 1 s)) - (if (setq rep (org-entity-get-representation wd 'html)) - (setq s (replace-match rep t t s)) - (setq start (+ start (length wd)))))))) - s) - -(defun org-export-docbook-format-desc (desc) - "Make sure DESC is valid as a description in a link." - (save-match-data - (org-docbook-do-expand desc))) - -(defun org-export-docbook-convert-emphasize (string) - "Apply emphasis for DocBook exporting." - (let ((s 0) rpl) - (while (string-match org-emph-re string s) - (if (not (equal - (substring string (match-beginning 3) (1+ (match-beginning 3))) - (substring string (match-beginning 4) (1+ (match-beginning 4))))) - (setq s (match-beginning 0) - rpl - (concat - (match-string 1 string) - (nth 1 (assoc (match-string 3 string) - org-export-docbook-emphasis-alist)) - (match-string 4 string) - (nth 2 (assoc (match-string 3 string) - org-export-docbook-emphasis-alist)) - (match-string 5 string)) - string (replace-match rpl t t string) - s (+ s (- (length rpl) 2))) - (setq s (1+ s)))) - string)) - -(defun org-docbook-protect (string) - (org-html-protect string)) - -;; For now, simply return string as it is. -(defun org-export-docbook-convert-special-strings (string) - "Convert special characters in STRING to DocBook." - string) - -(defun org-export-docbook-get-footnotes (lines) - "Given a list of LINES, return a list of alist footnotes." - (let ((list nil) line) - (while (setq line (pop lines)) - (if (string-match "^[ \t]*\\[\\([0-9]+\\)\\] \\(.+\\)" line) - (push (cons (match-string 1 line) (match-string 2 line)) - list))) - list)) - -(defun org-export-docbook-format-image (src) - "Create image element in DocBook." - (save-match-data - (let* ((caption (org-find-text-property-in-string 'org-caption src)) - (attr (or (org-find-text-property-in-string 'org-attributes src) - "")) - (label (org-find-text-property-in-string 'org-label src)) - (default-attr org-export-docbook-default-image-attributes) - tmp) - (setq caption (and caption (org-html-do-expand caption))) - (while (setq tmp (pop default-attr)) - (if (not (string-match (concat (car tmp) "=") attr)) - (setq attr (concat attr " " (car tmp) "=" (cdr tmp))))) - (format " -\n\n -%s" - (if label (concat " xml:id=\"" label "\"") "") - src attr - (if caption - (concat "\n" - caption - "\n\n") - "") - )))) - -(defun org-export-docbook-preprocess (parameters) - "Extra preprocessing work for DocBook export." - ;; Merge lines starting with "\par" to one line. Such lines are - ;; regarded as the continuation of a long footnote. - (goto-char (point-min)) - (while (re-search-forward "\n\\(\\\\par\\>\\)" nil t) - (if (not (get-text-property (match-beginning 1) 'org-protected)) - (replace-match "")))) - -(defun org-export-docbook-finalize-table (table) - "Clean up TABLE and turn it into DocBook format. -This function adds a label to the table if it is available, and -also changes TABLE to informaltable if caption does not exist. -TABLE is a string containing the HTML code generated by -`org-format-table-html' for a table in Org-mode buffer." - (let (table-with-label) - ;; Get the label if it exists, and move it into the element. - (setq table-with-label - (if (string-match - "^
    \n\\(\\(.\\|\n\\)+\\)
    " - table) - (replace-match (concat "") - nil t table) - table)) - ;; Change
    into if caption does not exist. - (if (string-match - "^
    \n\\(\\(.\\|\n\\)+\\)
    " - table-with-label) - (replace-match (concat "") - nil t table-with-label) - table-with-label))) - -;; Note: This function is very similar to -;; org-export-html-convert-sub-super. They can be merged in the future. -(defun org-export-docbook-convert-sub-super (string) - "Convert sub- and superscripts in STRING for DocBook." - (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) - (while (string-match org-match-substring-regexp string s) - (cond - ((and requireb (match-end 8)) (setq s (match-end 2))) - ((get-text-property (match-beginning 2) 'org-protected string) - (setq s (match-end 2))) - (t - (setq s (match-end 1) - key (if (string= (match-string 2 string) "_") - "subscript" - "superscript") - c (or (match-string 8 string) - (match-string 6 string) - (match-string 5 string)) - string (replace-match - (concat (match-string 1 string) - "<" key ">" c "") - t t string))))) - (while (string-match "\\\\\\([_^]\\)" string) - (setq string (replace-match (match-string 1 string) t t string))) - string)) - -(defun org-export-docbook-protect-tags (string) - "Change ``<...>'' in string STRING into ``@<...>''. -This is normally needed when STRING contains DocBook elements -that need to be preserved in later phase of DocBook exporting." - (let ((start 0)) - (while (string-match "<\\([^>]*\\)>" string start) - (setq string (replace-match - "@<\\1>" t nil string) - start (match-end 0))) - string)) - -(defun org-export-docbook-handle-time-stamps (line) - "Format time stamps in string LINE." - (let (replaced - (kw-markup (org-export-docbook-protect-tags - org-export-docbook-keywords-markup)) - (ts-markup (org-export-docbook-protect-tags - org-export-docbook-timestamp-markup))) - (while (string-match org-maybe-keyword-time-regexp line) - (setq replaced - (concat replaced - (substring line 0 (match-beginning 0)) - (if (match-end 1) - (format kw-markup - (match-string 1 line))) - " " - (format ts-markup - (substring (org-translate-time - (match-string 3 line)) 1 -1))) - line (substring line (match-end 0)))) - (concat replaced line))) - -(defun org-export-docbook-list-line (line pos struct prevs) - "Insert list syntax in export buffer. Return LINE, maybe modified. - -POS is the item position or line position the line had before -modifications to buffer. STRUCT is the list structure. PREVS is -the alist of previous items." - (let* ((get-type - (function - ;; Translate type of list containing POS to "ordered", - ;; "variable" or "itemized". - (lambda (pos struct prevs) - (let ((type (org-list-get-list-type pos struct prevs))) - (cond - ((eq 'ordered type) "ordered") - ((eq 'descriptive type) "variable") - (t "itemized")))))) - (get-closings - (function - ;; Return list of all items and sublists ending at POS, in - ;; reverse order. - (lambda (pos) - (let (out) - (catch 'exit - (mapc (lambda (e) - (let ((end (nth 6 e)) - (item (car e))) - (cond - ((= end pos) (push item out)) - ((>= item pos) (throw 'exit nil))))) - struct)) - out))))) - ;; First close any previous item, or list, ending at POS. - (mapc (lambda (e) - (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) - (first-item (org-list-get-list-begin e struct prevs)) - (type (funcall get-type first-item struct prevs))) - ;; Ending for every item - (org-export-docbook-close-para-maybe) - (insert (if (equal type "variable") - "\n" - "\n")) - ;; We're ending last item of the list: end list. - (when lastp - (insert (format "\n" type)) - (org-export-docbook-open-para)))) - (funcall get-closings pos)) - (cond - ;; At an item: insert appropriate tags in export buffer. - ((assq pos struct) - (string-match (concat "[ \t]*\\(\\S-+[ \t]*\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\][ \t]*\\)?" - "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" - "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?" - "\\(.*\\)") - line) - (let* ((checkbox (match-string 3 line)) - (desc-tag (or (match-string 4 line) "???")) - (body (match-string 5 line)) - (list-beg (org-list-get-list-begin pos struct prevs)) - (firstp (= list-beg pos)) - ;; Always refer to first item to determine list type, in - ;; case list is ill-formed. - (type (funcall get-type list-beg struct prevs)) - ;; Special variables for ordered lists. - (counter (let ((count-tmp (org-list-get-counter pos struct))) - (cond - ((not count-tmp) nil) - ((string-match "[A-Za-z]" count-tmp) - (- (string-to-char (upcase count-tmp)) 64)) - ((string-match "[0-9]+" count-tmp) - count-tmp))))) - ;; When FIRSTP, a new list or sub-list is starting. - (when firstp - (org-export-docbook-close-para-maybe) - (insert (format "<%slist>\n" type))) - (insert (cond - ((equal type "variable") - (format "%s" desc-tag)) - ((and (equal type "ordered") counter) - (format "" counter)) - (t ""))) - ;; For DocBook, we need to open a para right after tag - ;; . - (org-export-docbook-open-para) - ;; If line had a checkbox, some additional modification is required. - (when checkbox (setq body (concat checkbox " " body))) - ;; Return modified line - body)) - ;; At a list ender: normal text follows: need . - ((equal "ORG-LIST-END-MARKER" line) - (org-export-docbook-open-para) - (throw 'nextline nil)) - ;; Not at an item: return line unchanged (side-effects only). - (t line)))) - -(provide 'org-docbook) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-docbook.el ends here diff --git a/lisp/org-docview.el b/lisp/org-docview.el index be99ad99a..72ccc46d6 100644 --- a/lisp/org-docview.el +++ b/lisp/org-docview.el @@ -51,9 +51,22 @@ (org-autoload "doc-view" '(doc-view-goto-page)) -(org-add-link-type "docview" 'org-docview-open) +(org-add-link-type "docview" 'org-docview-open 'org-docview-export) (add-hook 'org-store-link-functions 'org-docview-store-link) +(defun org-docview-export (link description format) + "Export a docview link from Org files." + (let* ((path (when (string-match "\\(.+\\)::.+" link) + (match-string 1 link))) + (desc (or description link))) + (when (stringp path) + (setq path (org-link-escape (expand-file-name path))) + (cond + ((eq format 'html) (format "%s" path desc)) + ((eq format 'latex) (format "\href{%s}{%s}" path desc)) + ((eq format 'ascii) (format "%s (%s)" desc path)) + (t path))))) + (defun org-docview-open (link) (when (string-match "\\(.*\\)::\\([0-9]+\\)$" link) (let* ((path (match-string 1 link)) diff --git a/lisp/org-element.el b/lisp/org-element.el index 5be147719..73d0b46c9 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -30,25 +30,28 @@ ;; to at least one element. ;; ;; An element always starts and ends at the beginning of a line. With -;; a few exceptions (namely `babel-call', `clock', `headline', `item', -;; `keyword', `planning', `property-drawer' and `section' types), it -;; can also accept a fixed set of keywords as attributes. Those are -;; called "affiliated keywords" to distinguish them from other -;; keywords, which are full-fledged elements. Almost all affiliated -;; keywords are referenced in `org-element-affiliated-keywords'; the -;; others are export attributes and start with "ATTR_" prefix. +;; a few exceptions (`clock', `headline', `inlinetask', `item', +;; `planning', `node-property', `quote-section' `section' and +;; `table-row' types), it can also accept a fixed set of keywords as +;; attributes. Those are called "affiliated keywords" to distinguish +;; them from other keywords, which are full-fledged elements. Almost +;; all affiliated keywords are referenced in +;; `org-element-affiliated-keywords'; the others are export attributes +;; and start with "ATTR_" prefix. ;; ;; Element containing other elements (and only elements) are called ;; greater elements. Concerned types are: `center-block', `drawer', ;; `dynamic-block', `footnote-definition', `headline', `inlinetask', -;; `item', `plain-list', `quote-block', `section' and `special-block'. +;; `item', `plain-list', `property-drawer', `quote-block', `section' +;; and `special-block'. ;; ;; Other element types are: `babel-call', `clock', `comment', -;; `comment-block', `example-block', `export-block', `fixed-width', -;; `horizontal-rule', `keyword', `latex-environment', `paragraph', -;; `planning', `property-drawer', `quote-section', `src-block', -;; `table', `table-row' and `verse-block'. Among them, `paragraph' -;; and `verse-block' types can contain Org objects and plain text. +;; `comment-block', `diary-sexp', `example-block', `export-block', +;; `fixed-width', `horizontal-rule', `keyword', `latex-environment', +;; `node-property', `paragraph', `planning', `quote-section', +;; `src-block', `table', `table-row' and `verse-block'. Among them, +;; `paragraph' and `verse-block' types can contain Org objects and +;; plain text. ;; ;; Objects are related to document's contents. Some of them are ;; recursive. Associated types are of the following: `bold', `code', @@ -59,7 +62,7 @@ ;; `table-cell', `target', `timestamp', `underline' and `verbatim'. ;; ;; Some elements also have special properties whose value can hold -;; objects themselves (i.e. an item tag or an headline name). Such +;; objects themselves (i.e. an item tag or a headline name). Such ;; values are called "secondary strings". Any object belongs to ;; either an element or a secondary string. ;; @@ -69,9 +72,15 @@ ;; refer to the beginning and ending buffer positions of the ;; considered element or object, `:post-blank', which holds the number ;; of blank lines, or white spaces, at its end and `:parent' which -;; refers to the element or object containing it. Greater elements -;; and elements containing objects will also have `:contents-begin' -;; and `:contents-end' properties to delimit contents. +;; refers to the element or object containing it. Greater elements, +;; elements and objects containing objects will also have +;; `:contents-begin' and `:contents-end' properties to delimit +;; contents. Eventually, greater elements and elements accepting +;; affiliated keywords will have a `:post-affiliated' property, +;; referring to the buffer position after all such keywords. +;; +;; At the lowest level, a `:parent' property is also attached to any +;; string, as a text property. ;; ;; Lisp-wise, an element or an object can be represented as a list. ;; It follows the pattern (TYPE PROPERTIES CONTENTS), where: @@ -107,11 +116,10 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - +(eval-when-compile (require 'cl)) (require 'org) + ;;; Definitions And Rules ;; @@ -128,6 +136,8 @@ org-outline-regexp "\\|" ;; Footnote definitions. "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|" + ;; Diary sexps. + "%%(" "\\|" "[ \t]*\\(?:" ;; Empty lines. "$" "\\|" @@ -150,7 +160,7 @@ ;; Lists. (let ((term (case org-plain-list-ordered-item-terminator (?\) ")") (?. "\\.") (otherwise "[.)]"))) - (alpha (and org-alphabetical-lists "\\|[A-Za-z]"))) + (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]"))) (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)" "\\(?:[ \t]\\|$\\)")) "\\)\\)") @@ -160,22 +170,23 @@ is not sufficient to know if point is at a paragraph ending. See `org-element-paragraph-parser' for more information.") (defconst org-element-all-elements - '(center-block clock comment comment-block drawer dynamic-block example-block - export-block fixed-width footnote-definition headline - horizontal-rule inlinetask item keyword latex-environment - babel-call paragraph plain-list planning property-drawer - quote-block quote-section section special-block src-block table - table-row verse-block) + '(babel-call center-block clock comment comment-block diary-sexp drawer + dynamic-block example-block export-block fixed-width + footnote-definition headline horizontal-rule inlinetask item + keyword latex-environment node-property paragraph plain-list + planning property-drawer quote-block quote-section section + special-block src-block table table-row verse-block) "Complete list of element types.") (defconst org-element-greater-elements '(center-block drawer dynamic-block footnote-definition headline inlinetask - item plain-list quote-block section special-block table) + item plain-list property-drawer quote-block section + special-block table) "List of recursive element types aka Greater Elements.") (defconst org-element-all-successors '(export-snippet footnote-reference inline-babel-call inline-src-block - latex-or-entity line-break link macro radio-target + latex-or-entity line-break link macro plain-link radio-target statistics-cookie sub/superscript table-cell target text-markup timestamp) "Complete list of successors.") @@ -187,7 +198,6 @@ is not sufficient to know if point is at a paragraph ending. See (verbatim . text-markup) (entity . latex-or-entity) (latex-fragment . latex-or-entity)) "Alist of translations between object type and successor name. - Sharing the same successor comes handy when, for example, the regexp matching one object can also match the other object.") @@ -199,11 +209,11 @@ regexp matching one object can also match the other object.") "Complete list of object types.") (defconst org-element-recursive-objects - '(bold italic link macro subscript radio-target strike-through superscript + '(bold italic link subscript radio-target strike-through superscript table-cell underline) "List of recursive object types.") -(defconst org-element-block-name-alist +(defvar org-element-block-name-alist '(("CENTER" . org-element-center-block-parser) ("COMMENT" . org-element-comment-block-parser) ("EXAMPLE" . org-element-example-block-parser) @@ -214,6 +224,12 @@ regexp matching one object can also match the other object.") Names must be uppercase. Any block whose name has no association is parsed with `org-element-special-block-parser'.") +(defconst org-element-link-type-is-file + '("file" "file+emacs" "file+sys" "docview") + "List of link types equivalent to \"file\". +Only these types can accept search options and an explicit +application to open them.") + (defconst org-element-affiliated-keywords '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT" "RESULTS" "SOURCE" "SRCNAME" "TBLNAME") @@ -242,8 +258,8 @@ Don't modify it, set `org-element-affiliated-keywords' instead.") The key is the old name and the value the new one. The property holding their value will be named after the translated name.") -(defconst org-element-multiple-keywords '("HEADER") - "List of affiliated keywords that can occur more that once in an element. +(defconst org-element-multiple-keywords '("CAPTION" "HEADER") + "List of affiliated keywords that can occur more than once in an element. Their value will be consed into a list of strings, which will be returned as the value of the property. @@ -254,8 +270,8 @@ This list is checked after translations have been applied. See By default, all keywords setting attributes (i.e. \"ATTR_LATEX\") allow multiple occurrences and need not to be in this list.") -(defconst org-element-parsed-keywords '("AUTHOR" "CAPTION" "DATE" "TITLE") - "List of keywords whose value can be parsed. +(defconst org-element-parsed-keywords '("CAPTION") + "List of affiliated keywords whose value can be parsed. Their value will be stored as a secondary string: a list of strings and objects. @@ -264,10 +280,10 @@ This list is checked after translations have been applied. See `org-element-keyword-translation-alist'.") (defconst org-element-dual-keywords '("CAPTION" "RESULTS") - "List of keywords which can have a secondary value. + "List of affiliated keywords which can have a secondary value. In Org syntax, they can be written with optional square brackets -before the colons. For example, results keyword can be +before the colons. For example, RESULTS keyword can be associated to a hash value with the following: #+RESULTS[hash-string]: some-source @@ -275,46 +291,40 @@ associated to a hash value with the following: This list is checked after translations have been applied. See `org-element-keyword-translation-alist'.") +(defconst org-element-document-properties '("AUTHOR" "DATE" "TITLE") + "List of properties associated to the whole document. +Any keyword in this list will have its value parsed and stored as +a secondary string.") + (defconst org-element-object-restrictions - '((bold export-snippet inline-babel-call inline-src-block latex-or-entity link - radio-target sub/superscript target text-markup timestamp) - (footnote-reference export-snippet footnote-reference inline-babel-call - inline-src-block latex-or-entity line-break link macro - radio-target sub/superscript target text-markup - timestamp) - (headline inline-babel-call inline-src-block latex-or-entity link macro - radio-target statistics-cookie sub/superscript target text-markup - timestamp) - (inlinetask inline-babel-call inline-src-block latex-or-entity link macro - radio-target sub/superscript target text-markup timestamp) - (italic export-snippet inline-babel-call inline-src-block latex-or-entity - link radio-target sub/superscript target text-markup timestamp) - (item export-snippet footnote-reference inline-babel-call latex-or-entity - link macro radio-target sub/superscript target text-markup) - (keyword latex-or-entity macro sub/superscript text-markup) - (link export-snippet inline-babel-call inline-src-block latex-or-entity link - sub/superscript text-markup) - (macro macro) - (paragraph export-snippet footnote-reference inline-babel-call - inline-src-block latex-or-entity line-break link macro - radio-target statistics-cookie sub/superscript target text-markup - timestamp) - (radio-target export-snippet latex-or-entity sub/superscript) - (strike-through export-snippet inline-babel-call inline-src-block - latex-or-entity link radio-target sub/superscript target - text-markup timestamp) - (subscript export-snippet inline-babel-call inline-src-block latex-or-entity - sub/superscript target text-markup) - (superscript export-snippet inline-babel-call inline-src-block - latex-or-entity sub/superscript target text-markup) - (table-cell export-snippet latex-or-entity link macro radio-target - sub/superscript target text-markup timestamp) - (table-row table-cell) - (underline export-snippet inline-babel-call inline-src-block latex-or-entity - link radio-target sub/superscript target text-markup timestamp) - (verse-block footnote-reference inline-babel-call inline-src-block - latex-or-entity line-break link macro radio-target - sub/superscript target text-markup timestamp)) + (let* ((standard-set + (remq 'plain-link (remq 'table-cell org-element-all-successors))) + (standard-set-no-line-break (remq 'line-break standard-set))) + `((bold ,@standard-set) + (footnote-reference ,@standard-set) + (headline ,@standard-set-no-line-break) + (inlinetask ,@standard-set-no-line-break) + (italic ,@standard-set) + (item ,@standard-set-no-line-break) + (keyword ,@standard-set) + ;; Ignore all links excepted plain links in a link description. + ;; Also ignore radio-targets and line breaks. + (link export-snippet inline-babel-call inline-src-block latex-or-entity + macro plain-link statistics-cookie sub/superscript text-markup) + (paragraph ,@standard-set) + ;; Remove any variable object from radio target as it would + ;; prevent it from being properly recognized. + (radio-target latex-or-entity sub/superscript) + (strike-through ,@standard-set) + (subscript ,@standard-set) + (superscript ,@standard-set) + ;; Ignore inline babel call and inline src block as formulas are + ;; possible. Also ignore line breaks and statistics cookies. + (table-cell export-snippet footnote-reference latex-or-entity link macro + radio-target sub/superscript target text-markup timestamp) + (table-row table-cell) + (underline ,@standard-set) + (verse-block ,@standard-set))) "Alist of objects restrictions. CAR is an element or object type containing objects and CDR is @@ -322,8 +332,7 @@ a list of successors that will be called within an element or object of such type. For example, in a `radio-target' object, one can only find -entities, export snippets, latex-fragments, subscript and -superscript. +entities, latex-fragments, subscript and superscript. This alist also applies to secondary string. For example, an `headline' type element doesn't directly contain objects, but @@ -336,6 +345,11 @@ still has an entry since one of its properties (`:title') does.") (footnote-reference . :inline-definition)) "Alist between element types and location of secondary value.") +(defconst org-element-object-variables '(org-link-abbrev-alist-local) + "List of buffer-local variables used when parsing objects. +These variables are copied to the temporary buffer created by +`org-export-secondary-string'.") + ;;; Accessors and Setters @@ -363,11 +377,14 @@ It can also return the following special value: (defsubst org-element-property (property element) "Extract the value from the PROPERTY of an ELEMENT." - (plist-get (nth 1 element) property)) + (if (stringp element) (get-text-property 0 property element) + (plist-get (nth 1 element) property))) (defsubst org-element-contents (element) "Extract contents from an ELEMENT." - (and (consp element) (nthcdr 2 element))) + (cond ((not (consp element)) nil) + ((symbolp (car element)) (nthcdr 2 element)) + (t element))) (defsubst org-element-restriction (element) "Return restriction associated to ELEMENT. @@ -379,14 +396,15 @@ element or object type." (defsubst org-element-put-property (element property value) "In ELEMENT set PROPERTY to VALUE. Return modified element." - (when (consp element) - (setcar (cdr element) (plist-put (nth 1 element) property value))) - element) + (if (stringp element) (org-add-props element nil property value) + (setcar (cdr element) (plist-put (nth 1 element) property value)) + element)) (defsubst org-element-set-contents (element &rest contents) "Set ELEMENT contents to CONTENTS. Return modified element." (cond ((not element) (list contents)) + ((not (symbolp (car element))) contents) ((cdr element) (setcdr (cdr element) contents)) (t (nconc element contents)))) @@ -415,18 +433,18 @@ objects, or a strings. The function takes care of setting `:parent' property for CHILD. Return parent element." - (if (not parent) children - ;; Link every child to PARENT. - (mapc (lambda (child) - (unless (stringp child) - (org-element-put-property child :parent parent))) - children) - ;; Add CHILDREN at the end of PARENT contents. + ;; Link every child to PARENT. If PARENT is nil, it is a secondary + ;; string: parent is the list itself. + (mapc (lambda (child) + (org-element-put-property child :parent (or parent children))) + children) + ;; Add CHILDREN at the end of PARENT contents. + (when parent (apply 'org-element-set-contents parent - (nconc (org-element-contents parent) children)) - ;; Return modified PARENT element. - parent)) + (nconc (org-element-contents parent) children))) + ;; Return modified PARENT element. + (or parent children)) @@ -466,24 +484,27 @@ Return parent element." ;;;; Center Block -(defun org-element-center-block-parser (limit) +(defun org-element-center-block-parser (limit affiliated) "Parse a center block. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `center-block' and CDR is a plist containing `:begin', `:end', `:hiddenp', `:contents-begin', -`:contents-end' and `:post-blank' keywords. +`:contents-end', `:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the block." (let ((case-fold-search t)) (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit) + (org-element-paragraph-parser limit affiliated) (let ((block-end-line (match-beginning 0))) - (let* ((keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (let* ((begin (car affiliated)) + (post-affiliated (point)) ;; Empty blocks have no contents. (contents-begin (progn (forward-line) (and (< (point) block-end-line) @@ -503,8 +524,9 @@ Assume point is at the beginning of the block." :hiddenp hidden :contents-begin contents-begin :contents-end contents-end - :post-blank (count-lines pos-before-blank end)) - (cadr keywords)))))))) + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) (defun org-element-center-block-interpreter (center-block contents) "Interpret CENTER-BLOCK element as Org syntax. @@ -514,49 +536,52 @@ CONTENTS is the contents of the element." ;;;; Drawer -(defun org-element-drawer-parser (limit) +(defun org-element-drawer-parser (limit affiliated) "Parse a drawer. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `drawer' and CDR is a plist containing `:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin', -`:contents-end' and `:post-blank' keywords. +`:contents-end', `:post-blank' and `:post-affiliated' keywords. Assume point is at beginning of drawer." (let ((case-fold-search t)) (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) ;; Incomplete drawer: parse it as a paragraph. - (org-element-paragraph-parser limit) - (let ((drawer-end-line (match-beginning 0))) - (save-excursion - (let* ((case-fold-search t) - (name (progn (looking-at org-drawer-regexp) - (org-match-string-no-properties 1))) - (keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) - ;; Empty drawers have no contents. - (contents-begin (progn (forward-line) - (and (< (point) drawer-end-line) - (point)))) - (contents-end (and contents-begin drawer-end-line)) - (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char drawer-end-line) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) - (list 'drawer - (nconc - (list :begin begin - :end end - :drawer-name name - :hiddenp hidden - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end)) - (cadr keywords))))))))) + (org-element-paragraph-parser limit affiliated) + (save-excursion + (let* ((drawer-end-line (match-beginning 0)) + (name (progn (looking-at org-drawer-regexp) + (org-match-string-no-properties 1))) + (begin (car affiliated)) + (post-affiliated (point)) + ;; Empty drawers have no contents. + (contents-begin (progn (forward-line) + (and (< (point) drawer-end-line) + (point)))) + (contents-end (and contents-begin drawer-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char drawer-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (skip-chars-backward " \t") + (if (bolp) (point) (line-end-position))))) + (list 'drawer + (nconc + (list :begin begin + :end end + :drawer-name name + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) (defun org-element-drawer-interpreter (drawer contents) "Interpret DRAWER element as Org syntax. @@ -568,29 +593,32 @@ CONTENTS is the contents of the element." ;;;; Dynamic Block -(defun org-element-dynamic-block-parser (limit) +(defun org-element-dynamic-block-parser (limit affiliated) "Parse a dynamic block. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `dynamic-block' and CDR is a plist containing `:block-name', `:begin', `:end', `:hiddenp', -`:contents-begin', `:contents-end', `:arguments' and -`:post-blank' keywords. +`:contents-begin', `:contents-end', `:arguments', `:post-blank' +and `:post-affiliated' keywords. Assume point is at beginning of dynamic block." (let ((case-fold-search t)) (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit) + (org-element-paragraph-parser limit affiliated) (let ((block-end-line (match-beginning 0))) (save-excursion (let* ((name (progn (looking-at org-dblock-start-re) (org-match-string-no-properties 1))) (arguments (org-match-string-no-properties 3)) - (keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (begin (car affiliated)) + (post-affiliated (point)) ;; Empty blocks have no contents. (contents-begin (progn (forward-line) (and (< (point) block-end-line) @@ -612,8 +640,9 @@ Assume point is at beginning of dynamic block." :hiddenp hidden :contents-begin contents-begin :contents-end contents-end - :post-blank (count-lines pos-before-blank end)) - (cadr keywords))))))))) + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-dynamic-block-interpreter (dynamic-block contents) "Interpret DYNAMIC-BLOCK element as Org syntax. @@ -627,28 +656,31 @@ CONTENTS is the contents of the element." ;;;; Footnote Definition -(defun org-element-footnote-definition-parser (limit) +(defun org-element-footnote-definition-parser (limit affiliated) "Parse a footnote definition. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `footnote-definition' and CDR is a plist containing `:label', `:begin' `:end', `:contents-begin', -`:contents-end' and `:post-blank' keywords. +`:contents-end', `:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the footnote definition." (save-excursion (let* ((label (progn (looking-at org-footnote-definition-re) (org-match-string-no-properties 1))) - (keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (begin (car affiliated)) + (post-affiliated (point)) (ending (save-excursion (if (progn (end-of-line) (re-search-forward (concat org-outline-regexp-bol "\\|" org-footnote-definition-re "\\|" - "^[ \t]*$") limit 'move)) + "^\\([ \t]*\n\\)\\{2,\\}") limit 'move)) (match-beginning 0) (point)))) (contents-begin (progn (search-forward "]") @@ -666,8 +698,9 @@ Assume point is at the beginning of the footnote definition." :end end :contents-begin contents-begin :contents-end contents-end - :post-blank (count-lines ending end)) - (cadr keywords)))))) + :post-blank (count-lines ending end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) (defun org-element-footnote-definition-interpreter (footnote-definition contents) "Interpret FOOTNOTE-DEFINITION element as Org syntax. @@ -680,19 +713,19 @@ CONTENTS is the contents of the footnote-definition." ;;;; Headline (defun org-element-headline-parser (limit &optional raw-secondary-p) - "Parse an headline. + "Parse a headline. Return a list whose CAR is `headline' and CDR is a plist -containing `:raw-value', `:title', `:begin', `:end', -`:pre-blank', `:hiddenp', `:contents-begin' and `:contents-end', -`:level', `:priority', `:tags', `:todo-keyword',`:todo-type', -`:scheduled', `:deadline', `:timestamp', `:clock', `:category', -`:quotedp', `:archivedp', `:commentedp' and `:footnote-section-p' -keywords. +containing `:raw-value', `:title', `:alt-title', `:begin', +`:end', `:pre-blank', `:hiddenp', `:contents-begin' and +`:contents-end', `:level', `:priority', `:tags', +`:todo-keyword',`:todo-type', `:scheduled', `:deadline', +`:closed', `:quotedp', `:archivedp', `:commentedp' and +`:footnote-section-p' keywords. The plist also contains any property set in the property drawer, -with its name in lowercase, the underscores replaced with hyphens -and colons at the beginning (i.e. `:custom-id'). +with its name in upper cases and colons added at the +beginning (i.e. `:CUSTOM_ID'). When RAW-SECONDARY-P is non-nil, headline's title will not be parsed as a secondary string, but as a plain string instead. @@ -718,25 +751,37 @@ Assume point is at beginning of the headline." (archivedp (member org-archive-tag tags)) (footnote-section-p (and org-footnote-section (string= org-footnote-section raw-value))) - ;; Normalize property names: ":SOME_PROP:" becomes - ;; ":some-prop". - (standard-props (let (plist) - (mapc - (lambda (p) - (let ((p-name (downcase (car p)))) - (while (string-match "_" p-name) - (setq p-name - (replace-match "-" nil nil p-name))) - (setq p-name (intern (concat ":" p-name))) - (setq plist - (plist-put plist p-name (cdr p))))) - (org-entry-properties nil 'standard)) - plist)) - (time-props (org-entry-properties nil 'special "CLOCK")) - (scheduled (cdr (assoc "SCHEDULED" time-props))) - (deadline (cdr (assoc "DEADLINE" time-props))) - (clock (cdr (assoc "CLOCK" time-props))) - (timestamp (cdr (assoc "TIMESTAMP" time-props))) + ;; Upcase property names. It avoids confusion between + ;; properties obtained through property drawer and default + ;; properties from the parser (e.g. `:end' and :END:) + (standard-props + (let (plist) + (mapc + (lambda (p) + (setq plist + (plist-put plist + (intern (concat ":" (upcase (car p)))) + (cdr p)))) + (org-entry-properties nil 'standard)) + plist)) + (time-props + ;; Read time properties on the line below the headline. + (save-excursion + (when (progn (forward-line) + (looking-at org-planning-or-clock-line-re)) + (let ((end (line-end-position)) plist) + (while (re-search-forward + org-keyword-time-not-clock-regexp end t) + (goto-char (match-end 1)) + (skip-chars-forward " \t") + (let ((keyword (match-string 1)) + (time (org-element-timestamp-parser))) + (cond ((equal keyword org-scheduled-string) + (setq plist (plist-put plist :scheduled time))) + ((equal keyword org-deadline-string) + (setq plist (plist-put plist :deadline time))) + (t (setq plist (plist-put plist :closed time)))))) + plist)))) (begin (point)) (end (save-excursion (goto-char (org-end-of-subtree t t)))) (pos-after-head (progn (forward-line) (point))) @@ -778,10 +823,6 @@ Assume point is at beginning of the headline." :tags tags :todo-keyword todo :todo-type todo-type - :scheduled scheduled - :deadline deadline - :timestamp timestamp - :clock clock :post-blank (count-lines (if (not contents-end) pos-after-head (goto-char contents-end) @@ -792,7 +833,15 @@ Assume point is at beginning of the headline." :archivedp archivedp :commentedp commentedp :quotedp quotedp) + time-props standard-props)))) + (let ((alt-title (org-element-property :ALT_TITLE headline))) + (when alt-title + (org-element-put-property + headline :alt-title + (if raw-secondary-p alt-title + (org-element-parse-secondary-string + alt-title (org-element-restriction 'headline) headline))))) (org-element-put-property headline :title (if raw-secondary-p raw-value @@ -855,12 +904,11 @@ Return a list whose CAR is `inlinetask' and CDR is a plist containing `:title', `:begin', `:end', `:hiddenp', `:contents-begin' and `:contents-end', `:level', `:priority', `:raw-value', `:tags', `:todo-keyword', `:todo-type', -`:scheduled', `:deadline', `:timestamp', `:clock' and -`:post-blank' keywords. +`:scheduled', `:deadline', `:closed' and `:post-blank' keywords. The plist also contains any property set in the property drawer, -with its name in lowercase, the underscores replaced with hyphens -and colons at the beginning (i.e. `:custom-id'). +with its name in upper cases and colons added at the +beginning (i.e. `:CUSTOM_ID'). When optional argument RAW-SECONDARY-P is non-nil, inline-task's title will not be parsed as a secondary string, but as a plain @@ -868,8 +916,7 @@ string instead. Assume point is at beginning of the inline task." (save-excursion - (let* ((keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (let* ((begin (point)) (components (org-heading-components)) (todo (nth 2 components)) (todo-type (and todo @@ -877,25 +924,38 @@ Assume point is at beginning of the inline task." (tags (let ((raw-tags (nth 5 components))) (and raw-tags (org-split-string raw-tags ":")))) (raw-value (or (nth 4 components) "")) - ;; Normalize property names: ":SOME_PROP:" becomes - ;; ":some-prop". - (standard-props (let (plist) - (mapc - (lambda (p) - (let ((p-name (downcase (car p)))) - (while (string-match "_" p-name) - (setq p-name - (replace-match "-" nil nil p-name))) - (setq p-name (intern (concat ":" p-name))) - (setq plist - (plist-put plist p-name (cdr p))))) - (org-entry-properties nil 'standard)) - plist)) - (time-props (org-entry-properties nil 'special "CLOCK")) - (scheduled (cdr (assoc "SCHEDULED" time-props))) - (deadline (cdr (assoc "DEADLINE" time-props))) - (clock (cdr (assoc "CLOCK" time-props))) - (timestamp (cdr (assoc "TIMESTAMP" time-props))) + ;; Upcase property names. It avoids confusion between + ;; properties obtained through property drawer and default + ;; properties from the parser (e.g. `:end' and :END:) + (standard-props + (let (plist) + (mapc + (lambda (p) + (setq plist + (plist-put plist + (intern (concat ":" (upcase (car p)))) + (cdr p)))) + (org-entry-properties nil 'standard)) + plist)) + (time-props + ;; Read time properties on the line below the inlinetask + ;; opening string. + (save-excursion + (when (progn (forward-line) + (looking-at org-planning-or-clock-line-re)) + (let ((end (line-end-position)) plist) + (while (re-search-forward + org-keyword-time-not-clock-regexp end t) + (goto-char (match-end 1)) + (skip-chars-forward " \t") + (let ((keyword (match-string 1)) + (time (org-element-timestamp-parser))) + (cond ((equal keyword org-scheduled-string) + (setq plist (plist-put plist :scheduled time))) + ((equal keyword org-deadline-string) + (setq plist (plist-put plist :deadline time))) + (t (setq plist (plist-put plist :closed time)))))) + plist)))) (task-end (save-excursion (end-of-line) (and (re-search-forward "^\\*+ END" limit t) @@ -925,13 +985,9 @@ Assume point is at beginning of the inline task." :tags tags :todo-keyword todo :todo-type todo-type - :scheduled scheduled - :deadline deadline - :timestamp timestamp - :clock clock :post-blank (count-lines before-blank end)) - standard-props - (cadr keywords))))) + time-props + standard-props)))) (org-element-put-property inlinetask :title (if raw-secondary-p raw-value @@ -1090,15 +1146,19 @@ CONTENTS is the contents of the element." ;;;; Plain List -(defun org-element-plain-list-parser (limit &optional structure) +(defun org-element-plain-list-parser (limit affiliated structure) "Parse a plain list. -Optional argument STRUCTURE, when non-nil, is the structure of -the plain list being parsed. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. STRUCTURE is the structure of the plain list being +parsed. Return a list whose CAR is `plain-list' and CDR is a plist containing `:type', `:begin', `:end', `:contents-begin' and -`:contents-end', `:structure' and `:post-blank' keywords. +`:contents-end', `:structure', `:post-blank' and +`:post-affiliated' keywords. Assume point is at the beginning of the list." (save-excursion @@ -1107,8 +1167,7 @@ Assume point is at the beginning of the list." (parents (org-list-parents-alist struct)) (type (org-list-get-list-type (point) struct prevs)) (contents-begin (point)) - (keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (begin (car affiliated)) (contents-end (progn (goto-char (org-list-get-list-end (point) struct prevs)) (unless (bolp) (forward-line)) @@ -1125,8 +1184,9 @@ Assume point is at the beginning of the list." :contents-begin contents-begin :contents-end contents-end :structure struct - :post-blank (count-lines contents-end end)) - (cadr keywords)))))) + :post-blank (count-lines contents-end end) + :post-affiliated contents-begin) + (cdr affiliated)))))) (defun org-element-plain-list-interpreter (plain-list contents) "Interpret PLAIN-LIST element as Org syntax. @@ -1138,27 +1198,83 @@ CONTENTS is the contents of the element." (buffer-string))) +;;;; Property Drawer + +(defun org-element-property-drawer-parser (limit affiliated) + "Parse a property drawer. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `property-drawer' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end', `:post-blank' and `:post-affiliated' keywords. + +Assume point is at the beginning of the property drawer." + (save-excursion + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) + ;; Incomplete drawer: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (save-excursion + (let* ((drawer-end-line (match-beginning 0)) + (begin (car affiliated)) + (post-affiliated (point)) + (contents-begin (progn (forward-line) + (and (< (point) drawer-end-line) + (point)))) + (contents-end (and contents-begin drawer-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char drawer-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (skip-chars-backward " \t") + (if (bolp) (point) (line-end-position))))) + (list 'property-drawer + (nconc + (list :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-property-drawer-interpreter (property-drawer contents) + "Interpret PROPERTY-DRAWER element as Org syntax. +CONTENTS is the properties within the drawer." + (format ":PROPERTIES:\n%s:END:" contents)) + + ;;;; Quote Block -(defun org-element-quote-block-parser (limit) +(defun org-element-quote-block-parser (limit affiliated) "Parse a quote block. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `quote-block' and CDR is a plist containing `:begin', `:end', `:hiddenp', `:contents-begin', -`:contents-end' and `:post-blank' keywords. +`:contents-end', `:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the block." (let ((case-fold-search t)) (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit) + (org-element-paragraph-parser limit affiliated) (let ((block-end-line (match-beginning 0))) (save-excursion - (let* ((keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (let* ((begin (car affiliated)) + (post-affiliated (point)) ;; Empty blocks have no contents. (contents-begin (progn (forward-line) (and (< (point) block-end-line) @@ -1178,8 +1294,9 @@ Assume point is at the beginning of the block." :hiddenp hidden :contents-begin contents-begin :contents-end contents-end - :post-blank (count-lines pos-before-blank end)) - (cadr keywords))))))))) + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-quote-block-interpreter (quote-block contents) "Interpret QUOTE-BLOCK element as Org syntax. @@ -1221,14 +1338,18 @@ CONTENTS is the contents of the element." ;;;; Special Block -(defun org-element-special-block-parser (limit) +(defun org-element-special-block-parser (limit affiliated) "Parse a special block. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `special-block' and CDR is a plist containing `:type', `:begin', `:end', `:hiddenp', -`:contents-begin', `:contents-end' and `:post-blank' keywords. +`:contents-begin', `:contents-end', `:post-blank' and +`:post-affiliated' keywords. Assume point is at the beginning of the block." (let* ((case-fold-search t) @@ -1238,11 +1359,11 @@ Assume point is at the beginning of the block." (re-search-forward (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t))) ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit) + (org-element-paragraph-parser limit affiliated) (let ((block-end-line (match-beginning 0))) (save-excursion - (let* ((keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (let* ((begin (car affiliated)) + (post-affiliated (point)) ;; Empty blocks have no contents. (contents-begin (progn (forward-line) (and (< (point) block-end-line) @@ -1263,8 +1384,9 @@ Assume point is at the beginning of the block." :hiddenp hidden :contents-begin contents-begin :contents-end contents-end - :post-blank (count-lines pos-before-blank end)) - (cadr keywords))))))))) + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-special-block-interpreter (special-block contents) "Interpret SPECIAL-BLOCK element as Org syntax. @@ -1290,28 +1412,35 @@ CONTENTS is the contents of the element." ;;;; Babel Call -(defun org-element-babel-call-parser (limit) +(defun org-element-babel-call-parser (limit affiliated) "Parse a babel call. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `babel-call' and CDR is a plist -containing `:begin', `:end', `:info' and `:post-blank' as -keywords." +containing `:begin', `:end', `:info', `:post-blank' and +`:post-affiliated' as keywords." (save-excursion (let ((case-fold-search t) (info (progn (looking-at org-babel-block-lob-one-liner-regexp) (org-babel-lob-get-info))) - (begin (point-at-bol)) + (begin (car affiliated)) + (post-affiliated (point)) (pos-before-blank (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (skip-chars-backward " \t") (if (bolp) (point) (line-end-position))))) (list 'babel-call - (list :begin begin - :end end - :info info - :post-blank (count-lines pos-before-blank end)))))) + (nconc + (list :begin begin + :end end + :info info + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) (defun org-element-babel-call-interpreter (babel-call contents) "Interpret BABEL-CALL element as Org syntax. @@ -1340,13 +1469,13 @@ as keywords." (let* ((case-fold-search nil) (begin (point)) (value (progn (search-forward org-clock-string (line-end-position) t) - (org-skip-whitespace) - (looking-at "\\[.*\\]") - (org-match-string-no-properties 0))) - (time (and (progn (goto-char (match-end 0)) - (looking-at " +=> +\\(\\S-+\\)[ \t]*$")) - (org-match-string-no-properties 1))) - (status (if time 'closed 'running)) + (skip-chars-forward " \t") + (org-element-timestamp-parser))) + (duration (and (search-forward " => " (line-end-position) t) + (progn (skip-chars-forward " \t") + (looking-at "\\(\\S-+\\)[ \t]*$")) + (org-match-string-no-properties 1))) + (status (if duration 'closed 'running)) (post-blank (let ((before-blank (progn (forward-line) (point)))) (skip-chars-forward " \r\t\n" limit) (skip-chars-backward " \t") @@ -1356,7 +1485,7 @@ as keywords." (list 'clock (list :status status :value value - :time time + :duration duration :begin begin :end end :post-blank post-blank))))) @@ -1365,30 +1494,34 @@ as keywords." "Interpret CLOCK element as Org syntax. CONTENTS is nil." (concat org-clock-string " " - (org-element-property :value clock) - (let ((time (org-element-property :time clock))) - (and time + (org-element-timestamp-interpreter + (org-element-property :value clock) nil) + (let ((duration (org-element-property :duration clock))) + (and duration (concat " => " (apply 'format "%2s:%02s" - (org-split-string time ":"))))))) + (org-split-string duration ":"))))))) ;;;; Comment -(defun org-element-comment-parser (limit) +(defun org-element-comment-parser (limit affiliated) "Parse a comment. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `comment' and CDR is a plist -containing `:begin', `:end', `:value' and `:post-blank' -keywords. +containing `:begin', `:end', `:value', `:post-blank', +`:post-affiliated' keywords. Assume point is at comment beginning." (save-excursion - (let* ((keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (let* ((begin (car affiliated)) + (post-affiliated (point)) (value (prog2 (looking-at "[ \t]*# ?") (buffer-substring-no-properties (match-end 0) (line-end-position)) @@ -1415,8 +1548,9 @@ Assume point is at comment beginning." (list :begin begin :end end :value value - :post-blank (count-lines com-end end)) - (cadr keywords)))))) + :post-blank (count-lines com-end end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) (defun org-element-comment-interpreter (comment contents) "Interpret COMMENT element as Org syntax. @@ -1426,25 +1560,28 @@ CONTENTS is nil." ;;;; Comment Block -(defun org-element-comment-block-parser (limit) +(defun org-element-comment-block-parser (limit affiliated) "Parse an export block. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `comment-block' and CDR is a plist -containing `:begin', `:end', `:hiddenp', `:value' and -`:post-blank' keywords. +containing `:begin', `:end', `:hiddenp', `:value', `:post-blank' +and `:post-affiliated' keywords. Assume point is at comment block beginning." (let ((case-fold-search t)) (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit) + (org-element-paragraph-parser limit affiliated) (let ((contents-end (match-beginning 0))) (save-excursion - (let* ((keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (let* ((begin (car affiliated)) + (post-affiliated (point)) (contents-begin (progn (forward-line) (point))) (hidden (org-invisible-p2)) (pos-before-blank (progn (goto-char contents-end) @@ -1461,8 +1598,9 @@ Assume point is at comment block beginning." :end end :value value :hiddenp hidden - :post-blank (count-lines pos-before-blank end)) - (cadr keywords))))))))) + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-comment-block-interpreter (comment-block contents) "Interpret COMMENT-BLOCK element as Org syntax. @@ -1471,22 +1609,63 @@ CONTENTS is nil." (org-remove-indentation (org-element-property :value comment-block)))) +;;;; Diary Sexp + +(defun org-element-diary-sexp-parser (limit affiliated) + "Parse a diary sexp. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `diary-sexp' and CDR is a plist +containing `:begin', `:end', `:value', `:post-blank' and +`:post-affiliated' keywords." + (save-excursion + (let ((begin (car affiliated)) + (post-affiliated (point)) + (value (progn (looking-at "\\(%%(.*\\)[ \t]*$") + (org-match-string-no-properties 1))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (skip-chars-backward " \t") + (if (bolp) (point) (line-end-position))))) + (list 'diary-sexp + (nconc + (list :value value + :begin begin + :end end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-diary-sexp-interpreter (diary-sexp contents) + "Interpret DIARY-SEXP as Org syntax. +CONTENTS is nil." + (org-element-property :value diary-sexp)) + + ;;;; Example Block -(defun org-element-example-block-parser (limit) +(defun org-element-example-block-parser (limit affiliated) "Parse an example block. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `example-block' and CDR is a plist containing `:begin', `:end', `:number-lines', `:preserve-indent', `:retain-labels', `:use-labels', `:label-fmt', `:hiddenp', -`:switches', `:value' and `:post-blank' keywords." +`:switches', `:value', `:post-blank' and `:post-affiliated' +keywords." (let ((case-fold-search t)) (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit) + (org-element-paragraph-parser limit affiliated) (let ((contents-end (match-beginning 0))) (save-excursion (let* ((switches @@ -1512,8 +1691,8 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent', (string-match "-l +\"\\([^\"\n]+\\)\"" switches) (match-string 1 switches))) ;; Standard block parsing. - (keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (begin (car affiliated)) + (post-affiliated (point)) (contents-begin (progn (forward-line) (point))) (hidden (org-invisible-p2)) (value (org-unescape-code-in-string @@ -1537,8 +1716,9 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent', :use-labels use-labels :label-fmt label-fmt :hiddenp hidden - :post-blank (count-lines pos-before-blank end)) - (cadr keywords))))))))) + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-example-block-interpreter (example-block contents) "Interpret EXAMPLE-BLOCK element as Org syntax. @@ -1553,14 +1733,17 @@ CONTENTS is nil." ;;;; Export Block -(defun org-element-export-block-parser (limit) +(defun org-element-export-block-parser (limit affiliated) "Parse an export block. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `export-block' and CDR is a plist -containing `:begin', `:end', `:type', `:hiddenp', `:value' and -`:post-blank' keywords. +containing `:begin', `:end', `:type', `:hiddenp', `:value', +`:post-blank' and `:post-affiliated' keywords. Assume point is at export-block beginning." (let* ((case-fold-search t) @@ -1570,11 +1753,11 @@ Assume point is at export-block beginning." (re-search-forward (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t))) ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit) + (org-element-paragraph-parser limit affiliated) (let ((contents-end (match-beginning 0))) (save-excursion - (let* ((keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (let* ((begin (car affiliated)) + (post-affiliated (point)) (contents-begin (progn (forward-line) (point))) (hidden (org-invisible-p2)) (pos-before-blank (progn (goto-char contents-end) @@ -1592,8 +1775,9 @@ Assume point is at export-block beginning." :type type :value value :hiddenp hidden - :post-blank (count-lines pos-before-blank end)) - (cadr keywords))))))))) + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-export-block-interpreter (export-block contents) "Interpret EXPORT-BLOCK element as Org syntax. @@ -1606,18 +1790,22 @@ CONTENTS is nil." ;;;; Fixed-width -(defun org-element-fixed-width-parser (limit) +(defun org-element-fixed-width-parser (limit affiliated) "Parse a fixed-width section. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `fixed-width' and CDR is a plist -containing `:begin', `:end', `:value' and `:post-blank' keywords. +containing `:begin', `:end', `:value', `:post-blank' and +`:post-affiliated' keywords. Assume point is at the beginning of the fixed-width area." (save-excursion - (let* ((keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (let* ((begin (car affiliated)) + (post-affiliated (point)) value (end-area (progn @@ -1639,8 +1827,9 @@ Assume point is at the beginning of the fixed-width area." (list :begin begin :end end :value value - :post-blank (count-lines end-area end)) - (cadr keywords)))))) + :post-blank (count-lines end-area end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) (defun org-element-fixed-width-interpreter (fixed-width contents) "Interpret FIXED-WIDTH element as Org syntax. @@ -1651,26 +1840,31 @@ CONTENTS is nil." ;;;; Horizontal Rule -(defun org-element-horizontal-rule-parser (limit) +(defun org-element-horizontal-rule-parser (limit affiliated) "Parse an horizontal rule. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `horizontal-rule' and CDR is a plist -containing `:begin', `:end' and `:post-blank' keywords." +containing `:begin', `:end', `:post-blank' and `:post-affiliated' +keywords." (save-excursion - (let* ((keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) - (post-hr (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) + (let ((begin (car affiliated)) + (post-affiliated (point)) + (post-hr (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) (skip-chars-backward " \t") (if (bolp) (point) (line-end-position))))) (list 'horizontal-rule (nconc (list :begin begin :end end - :post-blank (count-lines post-hr end)) - (cadr keywords)))))) + :post-blank (count-lines post-hr end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) (defun org-element-horizontal-rule-interpreter (horizontal-rule contents) "Interpret HORIZONTAL-RULE element as Org syntax. @@ -1680,31 +1874,37 @@ CONTENTS is nil." ;;;; Keyword -(defun org-element-keyword-parser (limit) +(defun org-element-keyword-parser (limit affiliated) "Parse a keyword at point. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `keyword' and CDR is a plist -containing `:key', `:value', `:begin', `:end' and `:post-blank' -keywords." +containing `:key', `:value', `:begin', `:end', `:post-blank' and +`:post-affiliated' keywords." (save-excursion - (let* ((case-fold-search t) - (begin (point)) - (key (progn (looking-at "[ \t]*#\\+\\(\\S-+\\):") - (upcase (org-match-string-no-properties 1)))) - (value (org-trim (buffer-substring-no-properties - (match-end 0) (point-at-eol)))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (let ((begin (car affiliated)) + (post-affiliated (point)) + (key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):") + (upcase (org-match-string-no-properties 1)))) + (value (org-trim (buffer-substring-no-properties + (match-end 0) (point-at-eol)))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (skip-chars-backward " \t") + (if (bolp) (point) (line-end-position))))) (list 'keyword - (list :key key - :value value - :begin begin - :end end - :post-blank (count-lines pos-before-blank end)))))) + (nconc + (list :key key + :value value + :begin begin + :end end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) (defun org-element-keyword-interpreter (keyword contents) "Interpret KEYWORD element as Org syntax. @@ -1716,39 +1916,42 @@ CONTENTS is nil." ;;;; Latex Environment -(defun org-element-latex-environment-parser (limit) +(defun org-element-latex-environment-parser (limit affiliated) "Parse a LaTeX environment. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `latex-environment' and CDR is a plist -containing `:begin', `:end', `:value' and `:post-blank' -keywords. +containing `:begin', `:end', `:value', `:post-blank' and +`:post-affiliated' keywords. Assume point is at the beginning of the latex environment." (save-excursion - (let* ((case-fold-search t) - (code-begin (point)) - (keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) - (env (progn (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}") - (regexp-quote (match-string 1)))) - (code-end - (progn (re-search-forward - (format "^[ \t]*\\\\end{%s}[ \t]*$" env) limit t) - (forward-line) - (point))) - (value (buffer-substring-no-properties code-begin code-end)) - (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) - (list 'latex-environment - (nconc - (list :begin begin - :end end - :value value - :post-blank (count-lines code-end end)) - (cadr keywords)))))) + (let ((case-fold-search t) + (code-begin (point))) + (looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}") + (if (not (re-search-forward (format "^[ \t]*\\\\end{%s}[ \t]*$" + (regexp-quote (match-string 1))) + limit t)) + ;; Incomplete latex environment: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let* ((code-end (progn (forward-line) (point))) + (begin (car affiliated)) + (value (buffer-substring-no-properties code-begin code-end)) + (end (progn (skip-chars-forward " \r\t\n" limit) + (skip-chars-backward " \t") + (if (bolp) (point) (line-end-position))))) + (list 'latex-environment + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines code-end end) + :post-affiliated code-begin) + (cdr affiliated)))))))) (defun org-element-latex-environment-interpreter (latex-environment contents) "Interpret LATEX-ENVIRONMENT element as Org syntax. @@ -1756,28 +1959,58 @@ CONTENTS is nil." (org-element-property :value latex-environment)) -;;;; Paragraph +;;;; Node Property -(defun org-element-paragraph-parser (limit) - "Parse a paragraph. +(defun org-element-node-property-parser (limit) + "Parse a node-property at point. LIMIT bounds the search. +Return a list whose CAR is `node-property' and CDR is a plist +containing `:key', `:value', `:begin', `:end' and `:post-blank' +keywords." + (save-excursion + (let ((case-fold-search t) + (begin (point)) + (key (progn (looking-at "[ \t]*:\\(.*?\\):[ \t]+\\(.*?\\)[ \t]*$") + (org-match-string-no-properties 1))) + (value (org-match-string-no-properties 2)) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (point-at-bol))))) + (list 'node-property + (list :key key + :value value + :begin begin + :end end + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-node-property-interpreter (node-property contents) + "Interpret NODE-PROPERTY element as Org syntax. +CONTENTS is nil." + (format org-property-format + (format ":%s:" (org-element-property :key node-property)) + (org-element-property :value node-property))) + + +;;;; Paragraph + +(defun org-element-paragraph-parser (limit affiliated) + "Parse a paragraph. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + Return a list whose CAR is `paragraph' and CDR is a plist containing `:begin', `:end', `:contents-begin' and -`:contents-end' and `:post-blank' keywords. +`:contents-end', `:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the paragraph." (save-excursion - (let* ((contents-begin (point)) - ;; INNER-PAR-P is non-nil when paragraph is at the - ;; beginning of an item or a footnote reference. In that - ;; case, we mustn't look for affiliated keywords since they - ;; belong to the container. - (inner-par-p (not (bolp))) - (keywords (unless inner-par-p - (org-element--collect-affiliated-keywords))) - (begin (if inner-par-p contents-begin (car keywords))) + (let* ((begin (car affiliated)) + (contents-begin (point)) (before-blank (let ((case-fold-search t)) (end-of-line) @@ -1849,8 +2082,9 @@ Assume point is at the beginning of the paragraph." :end end :contents-begin contents-begin :contents-end contents-end - :post-blank (count-lines before-blank end)) - (cadr keywords)))))) + :post-blank (count-lines before-blank end) + :post-affiliated contents-begin) + (cdr affiliated)))))) (defun org-element-paragraph-interpreter (paragraph contents) "Interpret PARAGRAPH element as Org syntax. @@ -1879,13 +2113,11 @@ and `:post-blank' keywords." (end (point)) closed deadline scheduled) (goto-char begin) - (while (re-search-forward org-keyword-time-not-clock-regexp - (line-end-position) t) + (while (re-search-forward org-keyword-time-not-clock-regexp end t) (goto-char (match-end 1)) - (org-skip-whitespace) - (let ((time (buffer-substring-no-properties - (1+ (point)) (1- (match-end 0)))) - (keyword (match-string 1))) + (skip-chars-forward " \t" end) + (let ((keyword (match-string 1)) + (time (org-element-timestamp-parser))) (cond ((equal keyword org-closed-string) (setq closed time)) ((equal keyword org-deadline-string) (setq deadline time)) (t (setq scheduled time))))) @@ -1903,69 +2135,21 @@ CONTENTS is nil." (mapconcat 'identity (delq nil - (list (let ((closed (org-element-property :closed planning))) - (when closed (concat org-closed-string " [" closed "]"))) - (let ((deadline (org-element-property :deadline planning))) - (when deadline (concat org-deadline-string " <" deadline ">"))) + (list (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat org-deadline-string " " + (org-element-timestamp-interpreter deadline nil)))) (let ((scheduled (org-element-property :scheduled planning))) (when scheduled - (concat org-scheduled-string " <" scheduled ">"))))) + (concat org-scheduled-string " " + (org-element-timestamp-interpreter scheduled nil)))) + (let ((closed (org-element-property :closed planning))) + (when closed + (concat org-closed-string " " + (org-element-timestamp-interpreter closed nil)))))) " ")) -;;;; Property Drawer - -(defun org-element-property-drawer-parser (limit) - "Parse a property drawer. - -LIMIT bounds the search. - -Return a list whose CAR is `property-drawer' and CDR is a plist -containing `:begin', `:end', `:hiddenp', `:contents-begin', -`:contents-end', `:properties' and `:post-blank' keywords. - -Assume point is at the beginning of the property drawer." - (save-excursion - (let ((case-fold-search t) - (begin (point)) - (prop-begin (progn (forward-line) (point))) - (hidden (org-invisible-p2)) - (properties - (let (val) - (while (not (looking-at "^[ \t]*:END:[ \t]*$")) - (when (looking-at "[ \t]*:\\([A-Za-z][-_A-Za-z0-9]*\\):") - (push (cons (org-match-string-no-properties 1) - (org-trim - (buffer-substring-no-properties - (match-end 0) (point-at-eol)))) - val)) - (forward-line)) - val)) - (prop-end (progn (re-search-forward "^[ \t]*:END:" limit t) - (point-at-bol))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) - (list 'property-drawer - (list :begin begin - :end end - :hiddenp hidden - :properties properties - :post-blank (count-lines pos-before-blank end)))))) - -(defun org-element-property-drawer-interpreter (property-drawer contents) - "Interpret PROPERTY-DRAWER element as Org syntax. -CONTENTS is nil." - (let ((props (org-element-property :properties property-drawer))) - (concat - ":PROPERTIES:\n" - (mapconcat (lambda (p) - (format org-property-format (format ":%s:" (car p)) (cdr p))) - (nreverse props) "\n") - "\n:END:"))) - - ;;;; Quote Section (defun org-element-quote-section-parser (limit) @@ -1999,28 +2183,30 @@ CONTENTS is nil." ;;;; Src Block -(defun org-element-src-block-parser (limit) +(defun org-element-src-block-parser (limit affiliated) "Parse a src block. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `src-block' and CDR is a plist containing `:language', `:switches', `:parameters', `:begin', `:end', `:hiddenp', `:number-lines', `:retain-labels', -`:use-labels', `:label-fmt', `:preserve-indent', `:value' and -`:post-blank' keywords. +`:use-labels', `:label-fmt', `:preserve-indent', `:value', +`:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the block." (let ((case-fold-search t)) (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit) + (org-element-paragraph-parser limit affiliated) (let ((contents-end (match-beginning 0))) (save-excursion - (let* ((keywords (org-element--collect-affiliated-keywords)) - ;; Get beginning position. - (begin (car keywords)) + (let* ((begin (car affiliated)) + (post-affiliated (point)) ;; Get language as a string. (language (progn @@ -2081,8 +2267,9 @@ Assume point is at the beginning of the block." :label-fmt label-fmt :hiddenp hidden :value value - :post-blank (count-lines pos-before-blank end)) - (cadr keywords))))))))) + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-src-block-interpreter (src-block contents) "Interpret SRC-BLOCK element as Org syntax. @@ -2111,22 +2298,25 @@ CONTENTS is nil." ;;;; Table -(defun org-element-table-parser (limit) +(defun org-element-table-parser (limit affiliated) "Parse a table at point. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `table' and CDR is a plist containing `:begin', `:end', `:tblfm', `:type', `:contents-begin', -`:contents-end', `:value' and `:post-blank' keywords. +`:contents-end', `:value', `:post-blank' and `:post-affiliated' +keywords. Assume point is at the beginning of the table." (save-excursion (let* ((case-fold-search t) (table-begin (point)) (type (if (org-at-table.el-p) 'table.el 'org)) - (keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (begin (car affiliated)) (table-end (if (re-search-forward org-table-any-border-regexp limit 'm) (goto-char (match-beginning 0)) @@ -2154,8 +2344,9 @@ Assume point is at the beginning of the table." :value (and (eq type 'table.el) (buffer-substring-no-properties table-begin table-end)) - :post-blank (count-lines pos-before-blank end)) - (cadr keywords)))))) + :post-blank (count-lines pos-before-blank end) + :post-affiliated table-begin) + (cdr affiliated)))))) (defun org-element-table-interpreter (table contents) "Interpret TABLE element as Org syntax. @@ -2211,25 +2402,28 @@ CONTENTS is the contents of the table row." ;;;; Verse Block -(defun org-element-verse-block-parser (limit) +(defun org-element-verse-block-parser (limit affiliated) "Parse a verse block. -LIMIT bounds the search. +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. Return a list whose CAR is `verse-block' and CDR is a plist containing `:begin', `:end', `:contents-begin', `:contents-end', -`:hiddenp' and `:post-blank' keywords. +`:hiddenp', `:post-blank' and `:post-affiliated' keywords. Assume point is at beginning of the block." (let ((case-fold-search t)) (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit) + (org-element-paragraph-parser limit affiliated) (let ((contents-end (match-beginning 0))) (save-excursion - (let* ((keywords (org-element--collect-affiliated-keywords)) - (begin (car keywords)) + (let* ((begin (car affiliated)) + (post-affiliated (point)) (hidden (progn (forward-line) (org-invisible-p2))) (contents-begin (point)) (pos-before-blank (progn (goto-char contents-end) @@ -2245,8 +2439,9 @@ Assume point is at beginning of the block." :contents-begin contents-begin :contents-end contents-end :hiddenp hidden - :post-blank (count-lines pos-before-blank end)) - (cadr keywords))))))))) + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) (defun org-element-verse-block-interpreter (verse-block contents) "Interpret VERSE-BLOCK element as Org syntax. @@ -2748,12 +2943,15 @@ Return a list whose CAR is `line-break', and CDR a plist with `:begin', `:end' and `:post-blank' keywords. Assume point is at the beginning of the line break." - (list 'line-break (list :begin (point) :end (point-at-eol) :post-blank 0))) + (list 'line-break + (list :begin (point) + :end (progn (forward-line) (point)) + :post-blank 0))) (defun org-element-line-break-interpreter (line-break contents) "Interpret LINE-BREAK object as Org syntax. CONTENTS is nil." - "\\\\") + "\\\\\n") (defun org-element-line-break-successor (limit) "Search for the next line-break object. @@ -2776,14 +2974,15 @@ beginning position." "Parse link at point. Return a list whose CAR is `link' and CDR a plist with `:type', -`:path', `:raw-link', `:begin', `:end', `:contents-begin', -`:contents-end' and `:post-blank' as keywords. +`:path', `:raw-link', `:application', `:search-option', `:begin', +`:end', `:contents-begin', `:contents-end' and `:post-blank' as +keywords. Assume point is at the beginning of the link." (save-excursion (let ((begin (point)) end contents-begin contents-end link-end post-blank path type - raw-link link) + raw-link link search-option application) (cond ;; Type 1: Text targeted from a radio target. ((and org-target-link-regexp (looking-at org-target-link-regexp)) @@ -2795,11 +2994,12 @@ Assume point is at the beginning of the link." (setq contents-begin (match-beginning 3) contents-end (match-end 3) link-end (match-end 0) - ;; RAW-LINK is the original link. - raw-link (org-match-string-no-properties 1) - link (org-translate-link - (org-link-expand-abbrev - (org-link-unescape raw-link)))) + ;; RAW-LINK is the original link. Expand any + ;; abbreviation in it. + raw-link (org-translate-link + (org-link-expand-abbrev + (org-match-string-no-properties 1))) + link (org-link-unescape raw-link)) ;; Determine TYPE of link and set PATH accordingly. (cond ;; File type. @@ -2838,10 +3038,26 @@ Assume point is at the beginning of the link." ;; LINK-END variable. (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t")) end (point)) + ;; Extract search option and opening application out of + ;; "file"-type links. + (when (member type org-element-link-type-is-file) + ;; Application. + (cond ((string-match "^file\\+\\(.*\\)$" type) + (setq application (match-string 1 type))) + ((not (string-match "^file" type)) + (setq application type))) + ;; Extract search option from PATH. + (when (string-match "::\\(.*\\)$" path) + (setq search-option (match-string 1 path) + path (replace-match "" nil nil path))) + ;; Make sure TYPE always report "file". + (setq type "file")) (list 'link (list :type type :path path :raw-link (or raw-link path) + :application application + :search-option search-option :begin begin :end end :contents-begin contents-begin @@ -2872,6 +3088,16 @@ beginning position." (when (re-search-forward link-regexp limit t) (cons 'link (match-beginning 0)))))) +(defun org-element-plain-link-successor (limit) + "Search for the next plain link object. + +LIMIT bounds the search. + +Return value is a cons cell whose CAR is `link' and CDR is +beginning position." + (and (save-excursion (re-search-forward org-plain-link-re limit t)) + (cons 'link (match-beginning 0)))) + ;;;; Macro @@ -2891,20 +3117,19 @@ Assume point is at the macro." (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) (end (point)) - (args (let ((args (org-match-string-no-properties 3)) args2) + (args (let ((args (org-match-string-no-properties 3))) (when args ;; Do not use `org-split-string' since empty ;; strings are meaningful here. - (setq args (split-string args ",")) - (while args - (while (string-match "\\\\\\'" (car args)) - ;; Repair bad splits, when comma is protected, - ;; and thus not a real separator. - (setcar (cdr args) (concat (substring (car args) 0 -1) - "," (nth 1 args))) - (pop args)) - (push (pop args) args2)) - (mapcar 'org-trim (nreverse args2)))))) + (split-string + (replace-regexp-in-string + "\\(\\\\*\\)\\(,\\)" + (lambda (str) + (let ((len (length (match-string 1 str)))) + (concat (make-string (/ len 2) ?\\) + (if (zerop (mod len 2)) "\000" ",")))) + args nil t) + "\000"))))) (list 'macro (list :key key :value value @@ -3168,7 +3393,7 @@ LIMIT bounds the search. Return value is a cons cell whose CAR is `table-cell' and CDR is beginning position." - (when (looking-at "[ \t]*.*?[ \t]+|") (cons 'table-cell (point)))) + (when (looking-at "[ \t]*.*?[ \t]*|") (cons 'table-cell (point)))) ;;;; Target @@ -3222,39 +3447,167 @@ Assume point is at the beginning of the timestamp." (save-excursion (let* ((begin (point)) (activep (eq (char-after) ?<)) - (main-value + (raw-value (progn - (looking-at "[<[]\\(\\(%%\\)?.*?\\)[]>]\\(?:--[<[]\\(.*?\\)[]>]\\)?") - (match-string-no-properties 1))) - (range-end (match-string-no-properties 3)) - (type (cond ((match-string 2) 'diary) - ((and activep range-end) 'active-range) - (activep 'active) - (range-end 'inactive-range) - (t 'inactive))) + (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?") + (match-string-no-properties 0))) + (date-start (match-string-no-properties 1)) + (date-end (match-string 3)) + (diaryp (match-beginning 2)) (post-blank (progn (goto-char (match-end 0)) (skip-chars-forward " \t"))) - (end (point))) + (end (point)) + (time-range + (and (not diaryp) + (string-match + "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" + date-start) + (cons (string-to-number (match-string 2 date-start)) + (string-to-number (match-string 3 date-start))))) + (type (cond (diaryp 'diary) + ((and activep (or date-end time-range)) 'active-range) + (activep 'active) + ((or date-end time-range) 'inactive-range) + (t 'inactive))) + (repeater-props + (and (not diaryp) + (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)>" + raw-value) + (list + :repeater-type + (let ((type (match-string 1 raw-value))) + (cond ((equal "++" type) 'catch-up) + ((equal ".+" type) 'restart) + (t 'cumulate))) + :repeater-value (string-to-number (match-string 2 raw-value)) + :repeater-unit + (case (string-to-char (match-string 3 raw-value)) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year))))) + year-start month-start day-start hour-start minute-start year-end + month-end day-end hour-end minute-end) + ;; Parse date-start. + (unless diaryp + (let ((date (org-parse-time-string date-start t))) + (setq year-start (nth 5 date) + month-start (nth 4 date) + day-start (nth 3 date) + hour-start (nth 2 date) + minute-start (nth 1 date)))) + ;; Compute date-end. It can be provided directly in time-stamp, + ;; or extracted from time range. Otherwise, it defaults to the + ;; same values as date-start. + (unless diaryp + (let ((date (and date-end (org-parse-time-string date-end t)))) + (setq year-end (or (nth 5 date) year-start) + month-end (or (nth 4 date) month-start) + day-end (or (nth 3 date) day-start) + hour-end (or (nth 2 date) (car time-range) hour-start) + minute-end (or (nth 1 date) (cdr time-range) minute-start)))) (list 'timestamp - (list :type type - :value main-value - :range-end range-end - :begin begin - :end end - :post-blank post-blank))))) + (nconc (list :type type + :raw-value raw-value + :year-start year-start + :month-start month-start + :day-start day-start + :hour-start hour-start + :minute-start minute-start + :year-end year-end + :month-end month-end + :day-end day-end + :hour-end hour-end + :minute-end minute-end + :begin begin + :end end + :post-blank post-blank) + repeater-props))))) (defun org-element-timestamp-interpreter (timestamp contents) "Interpret TIMESTAMP object as Org syntax. CONTENTS is nil." - (let ((type (org-element-property :type timestamp) )) - (concat - (format (if (memq type '(inactive inactive-range)) "[%s]" "<%s>") - (org-element-property :value timestamp)) - (let ((range-end (org-element-property :range-end timestamp))) - (when range-end - (concat "--" - (format (if (eq type 'inactive-range) "[%s]" "<%s>") - range-end))))))) + ;; Use `:raw-value' if specified. + (or (org-element-property :raw-value timestamp) + ;; Otherwise, build timestamp string. + (let* ((repeat-string + (concat + (case (org-element-property :repeater-type timestamp) + (cumulate "+") (catch-up "++") (restart ".+")) + (let ((val (org-element-property :repeater-value timestamp))) + (and val (number-to-string val))) + (case (org-element-property :repeater-unit timestamp) + (hour "h") (day "d") (week "w") (month "m") (year "y")))) + (build-ts-string + ;; Build an Org timestamp string from TIME. ACTIVEP is + ;; non-nil when time stamp is active. If WITH-TIME-P is + ;; non-nil, add a time part. HOUR-END and MINUTE-END + ;; specify a time range in the timestamp. REPEAT-STRING + ;; is the repeater string, if any. + (lambda (time activep &optional with-time-p hour-end minute-end) + (let ((ts (format-time-string + (funcall (if with-time-p 'cdr 'car) + org-time-stamp-formats) + time))) + (when (and hour-end minute-end) + (string-match "[012]?[0-9]:[0-5][0-9]" ts) + (setq ts + (replace-match + (format "\\&-%02d:%02d" hour-end minute-end) + nil nil ts))) + (unless activep (setq ts (format "[%s]" (substring ts 1 -1)))) + (when (org-string-nw-p repeat-string) + (setq ts (concat (substring ts 0 -1) + " " + repeat-string + (substring ts -1)))) + ;; Return value. + ts))) + (type (org-element-property :type timestamp))) + (case type + ((active inactive) + (let* ((minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp)) + (time-range-p (and hour-start hour-end minute-start minute-end + (or (/= hour-start hour-end) + (/= minute-start minute-end))))) + (funcall + build-ts-string + (encode-time 0 + (or minute-start 0) + (or hour-start 0) + (org-element-property :day-start timestamp) + (org-element-property :month-start timestamp) + (org-element-property :year-start timestamp)) + (eq type 'active) + (and hour-start minute-start) + (and time-range-p hour-end) + (and time-range-p minute-end)))) + ((active-range inactive-range) + (let ((minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp))) + (concat + (funcall + build-ts-string (encode-time + 0 + (or minute-start 0) + (or hour-start 0) + (org-element-property :day-start timestamp) + (org-element-property :month-start timestamp) + (org-element-property :year-start timestamp)) + (eq type 'active-range) + (and hour-start minute-start)) + "--" + (funcall build-ts-string + (encode-time 0 + (or minute-end 0) + (or hour-end 0) + (org-element-property :day-end timestamp) + (org-element-property :month-end timestamp) + (org-element-property :year-end timestamp)) + (eq type 'active-range) + (and hour-end minute-end))))))))) (defun org-element-timestamp-successor (limit) "Search for the next timestamp object. @@ -3345,8 +3698,8 @@ CONTENTS is nil." ;; `org-element--current-element' makes use of special modes. They ;; are activated for fixed element chaining (i.e. `plain-list' > ;; `item') or fixed conditional element chaining (i.e. `headline' > -;; `section'). Special modes are: `first-section', `section', -;; `quote-section', `item' and `table-row'. +;; `section'). Special modes are: `first-section', `item', +;; `node-property', `quote-section', `section' and `table-row'. (defun org-element--current-element (limit &optional granularity special structure) @@ -3367,8 +3720,8 @@ nil), secondary values will not be parsed, since they only contain objects. Optional argument SPECIAL, when non-nil, can be either -`first-section', `section', `quote-section', `table-row' and -`item'. +`first-section', `item', `node-property', `quote-section', +`section', and `table-row'. If STRUCTURE isn't provided but SPECIAL is set to `item', it will be computed. @@ -3376,13 +3729,6 @@ be computed. This function assumes point is always at the beginning of the element it has to parse." (save-excursion - ;; If point is at an affiliated keyword, try moving to the - ;; beginning of the associated element. If none is found, the - ;; keyword is orphaned and will be treated as plain text. - (when (looking-at org-element--affiliated-re) - (let ((opoint (point))) - (while (looking-at org-element--affiliated-re) (forward-line)) - (when (looking-at "[ \t]*$") (goto-char opoint)))) (let ((case-fold-search t) ;; Determine if parsing depth allows for secondary strings ;; parsing. It only applies to elements referenced in @@ -3394,6 +3740,8 @@ element it has to parse." (org-element-item-parser limit structure raw-secondary-p)) ;; Table Row. ((eq special 'table-row) (org-element-table-row-parser limit)) + ;; Node Property. + ((eq special 'node-property) (org-element-node-property-parser limit)) ;; Headline. ((org-with-limited-levels (org-at-heading-p)) (org-element-headline-parser limit raw-secondary-p)) @@ -3406,180 +3754,144 @@ element it has to parse." limit))) ;; When not at bol, point is at the beginning of an item or ;; a footnote definition: next item is always a paragraph. - ((not (bolp)) (org-element-paragraph-parser limit)) + ((not (bolp)) (org-element-paragraph-parser limit (list (point)))) ;; Planning and Clock. - ((and (looking-at org-planning-or-clock-line-re)) + ((looking-at org-planning-or-clock-line-re) (if (equal (match-string 1) org-clock-string) (org-element-clock-parser limit) (org-element-planning-parser limit))) ;; Inlinetask. ((org-at-heading-p) (org-element-inlinetask-parser limit raw-secondary-p)) - ;; LaTeX Environment. - ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}") - (if (save-excursion - (re-search-forward - (format "[ \t]*\\\\end{%s}[ \t]*" - (regexp-quote (match-string 1))) - nil t)) - (org-element-latex-environment-parser limit) - (org-element-paragraph-parser limit))) - ;; Drawer and Property Drawer. - ((looking-at org-drawer-regexp) - (let ((name (match-string 1))) - (cond - ((not (save-excursion - (re-search-forward "^[ \t]*:END:[ \t]*$" nil t))) - (org-element-paragraph-parser limit)) - ((equal "PROPERTIES" name) - (org-element-property-drawer-parser limit)) - (t (org-element-drawer-parser limit))))) - ;; Fixed Width - ((looking-at "[ \t]*:\\( \\|$\\)") - (org-element-fixed-width-parser limit)) - ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and - ;; Keywords. - ((looking-at "[ \t]*#") - (goto-char (match-end 0)) - (cond ((looking-at "\\(?: \\|$\\)") - (beginning-of-line) - (org-element-comment-parser limit)) - ((looking-at "\\+BEGIN_\\(\\S-+\\)") - (beginning-of-line) - (let ((parser (assoc (upcase (match-string 1)) - org-element-block-name-alist))) - (if parser (funcall (cdr parser) limit) - (org-element-special-block-parser limit)))) - ((looking-at "\\+CALL:") - (beginning-of-line) - (org-element-babel-call-parser limit)) - ((looking-at "\\+BEGIN:? ") - (beginning-of-line) - (org-element-dynamic-block-parser limit)) - ((looking-at "\\+\\S-+:") - (beginning-of-line) - (org-element-keyword-parser limit)) - (t - (beginning-of-line) - (org-element-paragraph-parser limit)))) - ;; Footnote Definition. - ((looking-at org-footnote-definition-re) - (org-element-footnote-definition-parser limit)) - ;; Horizontal Rule. - ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") - (org-element-horizontal-rule-parser limit)) - ;; Table. - ((org-at-table-p t) (org-element-table-parser limit)) - ;; List. - ((looking-at (org-item-re)) - (org-element-plain-list-parser limit (or structure (org-list-struct)))) - ;; Default element: Paragraph. - (t (org-element-paragraph-parser limit)))))) + ;; From there, elements can have affiliated keywords. + (t (let ((affiliated (org-element--collect-affiliated-keywords limit))) + (cond + ;; Jumping over affiliated keywords put point off-limits. + ;; Parse them as regular keywords. + ((>= (point) limit) + (goto-char (car affiliated)) + (org-element-keyword-parser limit nil)) + ;; LaTeX Environment. + ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}[ \t]*$") + (org-element-latex-environment-parser limit affiliated)) + ;; Drawer and Property Drawer. + ((looking-at org-drawer-regexp) + (if (equal (match-string 1) "PROPERTIES") + (org-element-property-drawer-parser limit affiliated) + (org-element-drawer-parser limit affiliated))) + ;; Fixed Width + ((looking-at "[ \t]*:\\( \\|$\\)") + (org-element-fixed-width-parser limit affiliated)) + ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and + ;; Keywords. + ((looking-at "[ \t]*#") + (goto-char (match-end 0)) + (cond ((looking-at "\\(?: \\|$\\)") + (beginning-of-line) + (org-element-comment-parser limit affiliated)) + ((looking-at "\\+BEGIN_\\(\\S-+\\)") + (beginning-of-line) + (let ((parser (assoc (upcase (match-string 1)) + org-element-block-name-alist))) + (if parser (funcall (cdr parser) limit affiliated) + (org-element-special-block-parser limit affiliated)))) + ((looking-at "\\+CALL:") + (beginning-of-line) + (org-element-babel-call-parser limit affiliated)) + ((looking-at "\\+BEGIN:? ") + (beginning-of-line) + (org-element-dynamic-block-parser limit affiliated)) + ((looking-at "\\+\\S-+:") + (beginning-of-line) + (org-element-keyword-parser limit affiliated)) + (t + (beginning-of-line) + (org-element-paragraph-parser limit affiliated)))) + ;; Footnote Definition. + ((looking-at org-footnote-definition-re) + (org-element-footnote-definition-parser limit affiliated)) + ;; Horizontal Rule. + ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") + (org-element-horizontal-rule-parser limit affiliated)) + ;; Diary Sexp. + ((looking-at "%%(") + (org-element-diary-sexp-parser limit affiliated)) + ;; Table. + ((org-at-table-p t) (org-element-table-parser limit affiliated)) + ;; List. + ((looking-at (org-item-re)) + (org-element-plain-list-parser + limit affiliated (or structure (org-list-struct)))) + ;; Default element: Paragraph. + (t (org-element-paragraph-parser limit affiliated))))))))) ;; Most elements can have affiliated keywords. When looking for an ;; element beginning, we want to move before them, as they belong to ;; that element, and, in the meantime, collect information they give ;; into appropriate properties. Hence the following function. -;; -;; Usage of optional arguments may not be obvious at first glance: -;; -;; - TRANS-LIST is used to polish keywords names that have evolved -;; during Org history. In example, even though =result= and -;; =results= coexist, we want to have them under the same =result= -;; property. It's also true for "srcname" and "name", where the -;; latter seems to be preferred nowadays (thus the "name" property). -;; -;; - CONSED allows to regroup multi-lines keywords under the same -;; property, while preserving their own identity. This is mostly -;; used for "attr_latex" and al. -;; -;; - PARSED prepares a keyword value for export. This is useful for -;; "caption". Objects restrictions for such keywords are defined in -;; `org-element-object-restrictions'. -;; -;; - DUALS is used to take care of keywords accepting a main and an -;; optional secondary values. For example "results" has its -;; source's name as the main value, and may have an hash string in -;; optional square brackets as the secondary one. -;; -;; A keyword may belong to more than one category. -(defun org-element--collect-affiliated-keywords - (&optional key-re trans-list consed parsed duals) - "Collect affiliated keywords before point. - -Optional argument KEY-RE is a regexp matching keywords, which -puts matched keyword in group 1. It defaults to -`org-element--affiliated-re'. - -TRANS-LIST is an alist where key is the keyword and value the -property name it should be translated to, without the colons. It -defaults to `org-element-keyword-translation-alist'. - -CONSED is a list of strings. Any keyword belonging to that list -will have its value consed. The check is done after keyword -translation. It defaults to `org-element-multiple-keywords'. - -PARSED is a list of strings. Any keyword member of this list -will have its value parsed. The check is done after keyword -translation. If a keyword is a member of both CONSED and PARSED, -it's value will be a list of parsed strings. It defaults to -`org-element-parsed-keywords'. - -DUALS is a list of strings. Any keyword member of this list can -have two parts: one mandatory and one optional. Its value is -a cons cell whose CAR is the former, and the CDR the latter. If -a keyword is a member of both PARSED and DUALS, both values will -be parsed. It defaults to `org-element-dual-keywords'. +(defun org-element--collect-affiliated-keywords (limit) + "Collect affiliated keywords from point down to LIMIT. Return a list whose CAR is the position at the first of them and -CDR a plist of keywords and values." - (save-excursion +CDR a plist of keywords and values and move point to the +beginning of the first line after them. + +As a special case, if element doesn't start at the beginning of +the line (i.e. a paragraph starting an item), CAR is current +position of point and CDR is nil." + (if (not (bolp)) (list (point)) (let ((case-fold-search t) - (key-re (or key-re org-element--affiliated-re)) - (trans-list (or trans-list org-element-keyword-translation-alist)) - (consed (or consed org-element-multiple-keywords)) - (parsed (or parsed org-element-parsed-keywords)) - (duals (or duals org-element-dual-keywords)) + (origin (point)) ;; RESTRICT is the list of objects allowed in parsed ;; keywords value. (restrict (org-element-restriction 'keyword)) output) - (unless (bobp) - (while (and (not (bobp)) (progn (forward-line -1) (looking-at key-re))) - (let* ((raw-kwd (upcase (match-string 1))) - ;; Apply translation to RAW-KWD. From there, KWD is - ;; the official keyword. - (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd)) - ;; Find main value for any keyword. - (value - (save-match-data - (org-trim - (buffer-substring-no-properties - (match-end 0) (point-at-eol))))) - ;; If KWD is a dual keyword, find its secondary - ;; value. Maybe parse it. - (dual-value - (and (member kwd duals) - (let ((sec (org-match-string-no-properties 2))) - (if (or (not sec) (not (member kwd parsed))) sec - (org-element-parse-secondary-string sec restrict))))) - ;; Attribute a property name to KWD. - (kwd-sym (and kwd (intern (concat ":" (downcase kwd)))))) - ;; Now set final shape for VALUE. - (when (member kwd parsed) - (setq value (org-element-parse-secondary-string value restrict))) - (when (member kwd duals) - ;; VALUE is mandatory. Set it to nil if there is none. - (setq value (and value (cons value dual-value)))) - ;; Attributes are always consed. - (when (or (member kwd consed) (string-match "^ATTR_" kwd)) - (setq value (cons value (plist-get output kwd-sym)))) - ;; Eventually store the new value in OUTPUT. - (setq output (plist-put output kwd-sym value)))) - (unless (looking-at key-re) (forward-line 1))) - (list (point) output)))) + (while (and (< (point) limit) (looking-at org-element--affiliated-re)) + (let* ((raw-kwd (upcase (match-string 1))) + ;; Apply translation to RAW-KWD. From there, KWD is + ;; the official keyword. + (kwd (or (cdr (assoc raw-kwd + org-element-keyword-translation-alist)) + raw-kwd)) + ;; Find main value for any keyword. + (value + (save-match-data + (org-trim + (buffer-substring-no-properties + (match-end 0) (point-at-eol))))) + ;; PARSEDP is non-nil when keyword should have its + ;; value parsed. + (parsedp (member kwd org-element-parsed-keywords)) + ;; If KWD is a dual keyword, find its secondary + ;; value. Maybe parse it. + (dualp (member kwd org-element-dual-keywords)) + (dual-value + (and dualp + (let ((sec (org-match-string-no-properties 2))) + (if (or (not sec) (not parsedp)) sec + (org-element-parse-secondary-string sec restrict))))) + ;; Attribute a property name to KWD. + (kwd-sym (and kwd (intern (concat ":" (downcase kwd)))))) + ;; Now set final shape for VALUE. + (when parsedp + (setq value (org-element-parse-secondary-string value restrict))) + (when dualp + (setq value (and (or value dual-value) (cons value dual-value)))) + (when (or (member kwd org-element-multiple-keywords) + ;; Attributes can always appear on multiple lines. + (string-match "^ATTR_" kwd)) + (setq value (cons value (plist-get output kwd-sym)))) + ;; Eventually store the new value in OUTPUT. + (setq output (plist-put output kwd-sym value)) + ;; Move to next keyword. + (forward-line))) + ;; If affiliated keywords are orphaned: move back to first one. + ;; They will be parsed as a paragraph. + (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil)) + ;; Return value. + (cons origin output)))) @@ -3658,19 +3970,30 @@ looked after. Optional argument PARENT, when non-nil, is the element or object containing the secondary string. It is used to set correctly `:parent' property within the string." - (with-temp-buffer - (insert string) - (let ((secondary (org-element--parse-objects - (point-min) (point-max) nil restriction))) - (mapc (lambda (obj) (org-element-put-property obj :parent parent)) - secondary)))) + ;; Copy buffer-local variables listed in + ;; `org-element-object-variables' into temporary buffer. This is + ;; required since object parsing is dependent on these variables. + (let ((pairs (delq nil (mapcar (lambda (var) + (when (boundp var) + (cons var (symbol-value var)))) + org-element-object-variables)))) + (with-temp-buffer + (mapc (lambda (pair) (org-set-local (car pair) (cdr pair))) pairs) + (insert string) + (let ((secondary (org-element--parse-objects + (point-min) (point-max) nil restriction))) + (when parent + (mapc (lambda (obj) (org-element-put-property obj :parent parent)) + secondary)) + secondary)))) -(defun org-element-map (data types fun &optional info first-match no-recursion) +(defun org-element-map + (data types fun &optional info first-match no-recursion with-affiliated) "Map a function on selected elements or objects. -DATA is an Org buffer parse tree, as returned by, i.e., -`org-element-parse-buffer'. TYPES is a symbol or list of symbols -of elements or objects types (see `org-element-all-elements' and +DATA is a parse tree, an element, an object, a string, or a list +of such constructs. TYPES is a symbol or list of symbols of +elements or objects types (see `org-element-all-elements' and `org-element-all-objects' for a complete list of types). FUN is the function called on the matching element or object. It has to accept one argument: the element or object itself. @@ -3687,11 +4010,15 @@ representing elements or objects types. `org-element-map' won't enter any recursive element or object whose type belongs to that list. Though, FUN can still be applied on them. +When optional argument WITH-AFFILIATED is non-nil, FUN will also +apply to matching objects within parsed affiliated keywords (see +`org-element-parsed-keywords'). + Nil values returned from FUN do not appear in the results. Examples: --------- +--------- Assuming TREE is a variable containing an Org buffer parse tree, the following example will return a flat list of all `src-block' @@ -3702,22 +4029,26 @@ and `example-block' elements in it: The following snippet will find the first headline with a level of 1 and a \"phone\" tag, and will return its beginning position: - \(org-element-map - tree 'headline + \(org-element-map tree 'headline \(lambda (hl) \(and (= (org-element-property :level hl) 1) \(member \"phone\" (org-element-property :tags hl)) \(org-element-property :begin hl))) nil t) -Eventually, this last example will return a flat list of all -`bold' type objects containing a `latex-snippet' type object: +The next example will return a flat list of all `plain-list' type +elements in TREE that are not a sub-list themselves: - \(org-element-map - tree 'bold + \(org-element-map tree 'plain-list 'identity nil nil 'plain-list) + +Eventually, this example will return a flat list of all `bold' +type objects containing a `latex-snippet' type object, even +looking into captions: + + \(org-element-map tree 'bold \(lambda (b) - \(and (org-element-map b 'latex-snippet 'identity nil t) - b)))" + \(and (org-element-map b 'latex-snippet 'identity nil t) b)) + nil nil nil t)" ;; Ensure TYPES and NO-RECURSION are a list, even of one element. (unless (listp types) (setq types (list types))) (unless (listp no-recursion) (setq no-recursion (list no-recursion))) @@ -3739,6 +4070,12 @@ Eventually, this last example will return a flat list of all (setq category 'elements))))) types) category))) + ;; Compute properties for affiliated keywords if necessary. + (--affiliated-alist + (and with-affiliated + (mapcar (lambda (kwd) + (cons kwd (intern (concat ":" (downcase kwd))))) + org-element-affiliated-keywords))) --acc --walk-tree (--walk-tree @@ -3751,9 +4088,8 @@ Eventually, this last example will return a flat list of all ((not --data)) ;; Ignored element in an export context. ((and info (memq --data (plist-get info :ignore-list)))) - ;; Secondary string: only objects can be found there. - ((not --type) - (when (eq --category 'objects) (mapc --walk-tree --data))) + ;; List of elements or objects. + ((not --type) (mapc --walk-tree --data)) ;; Unconditionally enter parse trees. ((eq --type 'org-data) (mapc --walk-tree (org-element-contents --data))) @@ -3768,12 +4104,40 @@ Eventually, this last example will return a flat list of all (t (push result --acc))))) ;; If --DATA has a secondary string that can contain ;; objects with their type among TYPES, look into it. - (when (eq --category 'objects) + (when (and (eq --category 'objects) (not (stringp --data))) (let ((sec-prop (assq --type org-element-secondary-value-alist))) (when sec-prop (funcall --walk-tree (org-element-property (cdr sec-prop) --data))))) + ;; If --DATA has any affiliated keywords and + ;; WITH-AFFILIATED is non-nil, look for objects in + ;; them. + (when (and with-affiliated + (eq --category 'objects) + (memq --type org-element-all-elements)) + (mapc (lambda (kwd-pair) + (let ((kwd (car kwd-pair)) + (value (org-element-property + (cdr kwd-pair) --data))) + ;; Pay attention to the type of value. + ;; Preserve order for multiple keywords. + (cond + ((not value)) + ((and (member kwd org-element-multiple-keywords) + (member kwd org-element-dual-keywords)) + (mapc (lambda (line) + (funcall --walk-tree (cdr line)) + (funcall --walk-tree (car line))) + (reverse value))) + ((member kwd org-element-multiple-keywords) + (mapc (lambda (line) (funcall --walk-tree line)) + (reverse value))) + ((member kwd org-element-dual-keywords) + (funcall --walk-tree (cdr value)) + (funcall --walk-tree (car value))) + (t (funcall --walk-tree value))))) + --affiliated-alist)) ;; Determine if a recursion into --DATA is possible. (cond ;; --TYPE is explicitly removed from recursion. @@ -3793,6 +4157,7 @@ Eventually, this last example will return a flat list of all (funcall --walk-tree data) ;; Return value in a proper order. (nreverse --acc)))) +(put 'org-element-map 'lisp-indent-function 2) ;; The following functions are internal parts of the parser. ;; @@ -3851,7 +4216,7 @@ Elements are accumulated into ACC." (not cbeg))) ;; Greater element: parse it between `contents-begin' and ;; `contents-end'. Make sure GRANULARITY allows the - ;; recursion, or ELEMENT is an headline, in which case going + ;; recursion, or ELEMENT is a headline, in which case going ;; inside is mandatory, in order to get sub-level headings. ((and (memq type org-element-greater-elements) (or (memq granularity '(element object nil)) @@ -3866,6 +4231,7 @@ Elements are accumulated into ACC." (if (org-element-property :quotedp element) 'quote-section 'section)) (plain-list 'item) + (property-drawer 'node-property) (table 'table-row)) (and (memq type '(item plain-list)) (org-element-property :structure element)) @@ -3885,9 +4251,9 @@ Elements are accumulated into ACC." Objects are accumulated in ACC. -RESTRICTION is a list of object types which are allowed in the -current object." - (let (candidates) +RESTRICTION is a list of object successors which are allowed in +the current object." + (let ((candidates 'initial)) (save-excursion (goto-char beg) (while (and (< (point) end) @@ -3939,44 +4305,35 @@ current object." "Return an alist of candidates for the next object. LIMIT bounds the search, and RESTRICTION narrows candidates to -some object types. +some object successors. -Return value is an alist whose CAR is position and CDR the object -type, as a symbol. +OBJECTS is the previous candidates alist. If it is set to +`initial', no search has been done before, and all symbols in +RESTRICTION should be looked after. -OBJECTS is the previous candidates alist." - ;; Filter out any object found but not belonging to RESTRICTION. - (setq objects - (org-remove-if-not - (lambda (obj) - (let ((type (car obj))) - (memq (or (cdr (assq type org-element-object-successor-alist)) - type) - restriction))) - objects)) - (let (next-candidates types-to-search) - ;; If no previous result, search every object type in RESTRICTION. - ;; Otherwise, keep potential candidates (old objects located after - ;; point) and ask to search again those which had matched before. - (if (not objects) (setq types-to-search restriction) - (mapc (lambda (obj) - (if (< (cdr obj) (point)) (push (car obj) types-to-search) - (push obj next-candidates))) - objects)) - ;; Call the appropriate successor function for each type to search - ;; and accumulate matches. - (mapc - (lambda (type) - (let* ((successor-fun - (intern - (format "org-element-%s-successor" - (or (cdr (assq type org-element-object-successor-alist)) - type)))) - (obj (funcall successor-fun limit))) - (and obj (push obj next-candidates)))) - types-to-search) - ;; Return alist. - next-candidates)) +Return value is an alist whose CAR is the object type and CDR its +beginning position." + (delq + nil + (if (eq objects 'initial) + ;; When searching for the first time, look for every successor + ;; allowed in RESTRICTION. + (mapcar + (lambda (res) + (funcall (intern (format "org-element-%s-successor" res)) limit)) + restriction) + ;; Focus on objects returned during last search. Keep those + ;; still after point. Search again objects before it. + (mapcar + (lambda (obj) + (if (>= (cdr obj) (point)) obj + (let* ((type (car obj)) + (succ (or (cdr (assq type org-element-object-successor-alist)) + type))) + (and succ + (funcall (intern (format "org-element-%s-successor" succ)) + limit))))) + objects)))) @@ -4014,8 +4371,8 @@ Return Org syntax as a string." (mapconcat (lambda (obj) (org-element-interpret-data obj parent)) (org-element-contents data) "")) - ;; Plain text. - ((stringp data) data) + ;; Plain text: remove `:parent' text property from output. + ((stringp data) (org-no-properties data)) ;; Element/Object without contents. ((not (org-element-contents data)) (funcall (intern (format "org-element-%s-interpreter" type)) @@ -4083,7 +4440,7 @@ If there is no affiliated keyword, return the empty string." ;; All attribute keywords can have multiple lines. (string-match "^ATTR_" keyword)) (mapconcat (lambda (line) (funcall keyword-to-org keyword line)) - value + (reverse value) "") (funcall keyword-to-org keyword value))))) ;; List all ELEMENT's properties matching an attribute line or an @@ -4242,7 +4599,7 @@ is always the element at point. The following positions contain element's siblings, then parents, siblings of parents, until the first element of current section." (org-with-wide-buffer - ;; If at an headline, parse it. It is the sole element that + ;; If at a headline, parse it. It is the sole element that ;; doesn't require to know about context. Be sure to disallow ;; secondary string parsing, though. (if (org-with-limited-levels (org-at-heading-p)) @@ -4252,27 +4609,40 @@ first element of current section." (list (org-element-headline-parser (point-max) t)))) ;; Otherwise move at the beginning of the section containing ;; point. - (let ((origin (point)) - (end (save-excursion - (org-with-limited-levels (outline-next-heading)) (point))) - element type special-flag trail struct prevs parent) - (org-with-limited-levels - (if (org-with-limited-levels (org-before-first-heading-p)) - (goto-char (point-min)) - (org-back-to-heading) - (forward-line))) - (org-skip-whitespace) - (beginning-of-line) - ;; Parse successively each element, skipping those ending - ;; before original position. - (catch 'exit - (while t - (setq element + (catch 'exit + (let ((origin (point)) + (end (save-excursion + (org-with-limited-levels (outline-next-heading)) (point))) + element type special-flag trail struct prevs parent) + (org-with-limited-levels + (if (org-before-first-heading-p) + ;; In empty lines at buffer's beginning, return nil. + (progn (goto-char (point-min)) + (org-skip-whitespace) + (when (or (eobp) (> (line-beginning-position) origin)) + (throw 'exit nil))) + (org-back-to-heading) + (forward-line) + (org-skip-whitespace) + (when (> (line-beginning-position) origin) + ;; In blank lines just after the headline, point still + ;; belongs to the headline. + (throw 'exit + (progn (org-back-to-heading) + (if (not keep-trail) + (org-element-headline-parser (point-max) t) + (list (org-element-headline-parser + (point-max) t)))))))) + (beginning-of-line) + ;; Parse successively each element, skipping those ending + ;; before original position. + (while t + (setq element (org-element--current-element end 'element special-flag struct) - type (car element)) + type (car element)) (org-element-put-property element :parent parent) (when keep-trail (push element trail)) - (cond + (cond ;; 1. Skip any element ending before point. Also skip ;; element ending at point when we're sure that another ;; element has started. @@ -4302,7 +4672,8 @@ first element of current section." (memq type '(center-block drawer dynamic-block inlinetask item - plain-list quote-block special-block)))) + plain-list property-drawer quote-block + special-block)))) (throw 'exit (if keep-trail trail element)) (setq parent element) (case type @@ -4318,7 +4689,7 @@ first element of current section." (goto-char cbeg))))))))))) ;;;###autoload -(defun org-element-context () +(defun org-element-context (&optional element) "Return closest element or object around point. Return value is a list like (TYPE PROPS) where TYPE is the type @@ -4328,16 +4699,36 @@ associated to it. Possible types are defined in `org-element-all-elements' and `org-element-all-objects'. Properties depend on element or object type, but always include `:begin', `:end', `:parent' and -`:post-blank'." +`:post-blank'. + +Optional argument ELEMENT, when non-nil, is the closest element +containing point, as returned by `org-element-at-point'. +Providing it allows for quicker computation." (org-with-wide-buffer (let* ((origin (point)) - (element (org-element-at-point)) - (type (car element)) + (element (or element (org-element-at-point))) + (type (org-element-type element)) end) ;; Check if point is inside an element containing objects or at ;; a secondary string. In that case, move to beginning of the ;; element or secondary string and set END to the other side. - (if (not (or (and (eq type 'item) + (if (not (or (let ((post (org-element-property :post-affiliated element))) + (and post (> post origin) + (< (org-element-property :begin element) origin) + (progn (beginning-of-line) + (looking-at org-element--affiliated-re) + (member (upcase (match-string 1)) + org-element-parsed-keywords)) + ;; We're at an affiliated keyword. Change + ;; type to retrieve correct restrictions. + (setq type 'keyword) + ;; Determine if we're at main or dual value. + (if (and (match-end 2) (<= origin (match-end 2))) + (progn (goto-char (match-beginning 2)) + (setq end (match-end 2))) + (goto-char (match-end 0)) + (setq end (line-end-position))))) + (and (eq type 'item) (let ((tag (org-element-property :tag element))) (and tag (progn @@ -4359,13 +4750,21 @@ object type, but always include `:begin', `:end', `:parent' and :contents-begin element)) (cend (org-element-property :contents-end element))) - (and (>= origin cbeg) + (and cbeg cend ; cbeg is nil for table rules + (>= origin cbeg) (<= origin cend) - (progn (goto-char cbeg) (setq end cend))))))) + (progn (goto-char cbeg) (setq end cend))))) + (and (eq type 'keyword) + (let ((key (org-element-property :key element))) + (and (member key org-element-document-properties) + (progn (beginning-of-line) + (search-forward key (line-end-position) t) + (forward-char) + (setq end (line-end-position)))))))) element - (let ((restriction (org-element-restriction element)) + (let ((restriction (org-element-restriction type)) (parent element) - candidates) + (candidates 'initial)) (catch 'exit (while (setq candidates (org-element--get-next-object-candidates end restriction candidates)) @@ -4399,10 +4798,11 @@ object type, but always include `:begin', `:end', `:parent' and (org-element-put-property object :parent parent) (setq parent object restriction (org-element-restriction object) + candidates 'initial end cend))))))) parent)))))) -(defsubst org-element-nested-p (elem-A elem-B) +(defun org-element-nested-p (elem-A elem-B) "Non-nil when elements ELEM-A and ELEM-B are nested." (let ((beg-A (org-element-property :begin elem-A)) (beg-B (org-element-property :begin elem-B)) diff --git a/lisp/org-entities.el b/lisp/org-entities.el index 3f8cc9c6d..019b6c830 100644 --- a/lisp/org-entities.el +++ b/lisp/org-entities.el @@ -66,8 +66,8 @@ ASCII replacement Plain ASCII, no extensions. Symbols that cannot be Latin1 replacement Use the special characters available in latin1. utf-8 replacement Use the special characters available in utf-8. -If you define new entities here that require specific LaTeX packages to be -loaded, add these packages to `org-export-latex-packages-alist'." +If you define new entities here that require specific LaTeX +packages to be loaded, add these packages to `org-latex-packages-alist'." :group 'org-entities :version "24.1" :type '(repeat @@ -318,6 +318,7 @@ loaded, add these packages to `org-export-latex-packages-alist'." ("prop" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") ("proptp" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") ("not" "\\textlnot{}" nil "¬" "[angled dash]" "¬" "¬") + ("neg" "\\neg{}" t "¬" "[angled dash]" "¬" "¬") ("land" "\\land" t "∧" "[logical and]" "[logical and]" "∧") ("wedge" "\\wedge" t "∧" "[logical and]" "[logical and]" "∧") ("lor" "\\lor" t "∨" "[logical or]" "[logical or]" "∨") diff --git a/lisp/org-exp-blocks.el b/lisp/org-exp-blocks.el deleted file mode 100644 index d3789ad3a..000000000 --- a/lisp/org-exp-blocks.el +++ /dev/null @@ -1,402 +0,0 @@ -;;; org-exp-blocks.el --- pre-process blocks when exporting org files - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte - -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; -;; This is a utility for pre-processing blocks in org files before -;; export using the `org-export-preprocess-hook'. It can be used for -;; exporting new types of blocks from org-mode files and also for -;; changing the default export behavior of existing org-mode blocks. -;; The `org-export-blocks' and `org-export-interblocks' variables can -;; be used to control how blocks and the spaces between blocks -;; respectively are processed upon export. -;; -;; The type of a block is defined as the string following =#+begin_=, -;; so for example the following block would be of type ditaa. Note -;; that both upper or lower case are allowed in =#+BEGIN_= and -;; =#+END_=. -;; -;; #+begin_ditaa blue.png -r -S -;; +---------+ -;; | cBLU | -;; | | -;; | +----+ -;; | |cPNK| -;; | | | -;; +----+----+ -;; #+end_ditaa -;; -;;; Currently Implemented Block Types -;; -;; ditaa :: (DEPRECATED--use "#+begin_src ditaa" code blocks) Convert -;; ascii pictures to actual images using ditaa -;; http://ditaa.sourceforge.net/. To use this set -;; `org-ditaa-jar-path' to the path to ditaa.jar on your -;; system (should be set automatically in most cases) . -;; -;; dot :: (DEPRECATED--use "#+begin_src dot" code blocks) Convert -;; graphs defined using the dot graphing language to images -;; using the dot utility. For information on dot see -;; http://www.graphviz.org/ -;; -;; export-comment :: Wrap comments with titles and author information, -;; in their own divs with author-specific ids allowing for -;; css coloring of comments based on the author. -;; -;;; Adding new blocks -;; -;; When adding a new block type first define a formatting function -;; along the same lines as `org-export-blocks-format-dot' and then use -;; `org-export-blocks-add-block' to add your block type to -;; `org-export-blocks'. - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'find-func) -(require 'org-compat) - -(declare-function org-split-string "org" (string &optional separators)) -(declare-function org-remove-indentation "org" (code &optional n)) - -(defvar org-protecting-blocks nil) ; From org.el - -(defun org-export-blocks-set (var value) - "Set the value of `org-export-blocks' and install fontification." - (set var value) - (mapc (lambda (spec) - (if (nth 2 spec) - (setq org-protecting-blocks - (delete (symbol-name (car spec)) - org-protecting-blocks)) - (add-to-list 'org-protecting-blocks - (symbol-name (car spec))))) - value)) - -(defcustom org-export-blocks - '((export-comment org-export-blocks-format-comment t) - (ditaa org-export-blocks-format-ditaa nil) - (dot org-export-blocks-format-dot nil)) - "Use this alist to associate block types with block exporting functions. -The type of a block is determined by the text immediately -following the '#+BEGIN_' portion of the block header. Each block -export function should accept three arguments." - :group 'org-export-general - :type '(repeat - (list - (symbol :tag "Block name") - (function :tag "Block formatter") - (boolean :tag "Fontify content as Org syntax"))) - :set 'org-export-blocks-set) - -(defun org-export-blocks-add-block (block-spec) - "Add a new block type to `org-export-blocks'. -BLOCK-SPEC should be a three element list the first element of -which should indicate the name of the block, the second element -should be the formatting function called by -`org-export-blocks-preprocess' and the third element a flag -indicating whether these types of blocks should be fontified in -org-mode buffers (see `org-protecting-blocks'). For example the -BLOCK-SPEC for ditaa blocks is as follows. - - (ditaa org-export-blocks-format-ditaa nil)" - (unless (member block-spec org-export-blocks) - (setq org-export-blocks (cons block-spec org-export-blocks)) - (org-export-blocks-set 'org-export-blocks org-export-blocks))) - -(defcustom org-export-interblocks - '() - "Use this a-list to associate block types with block exporting functions. -The type of a block is determined by the text immediately -following the '#+BEGIN_' portion of the block header. Each block -export function should accept three arguments." - :group 'org-export-general - :type 'alist) - -(defcustom org-export-blocks-witheld - '(hidden) - "List of block types (see `org-export-blocks') which should not be exported." - :group 'org-export-general - :type 'list) - -(defcustom org-export-blocks-postblock-hook nil - "Run after blocks have been processed with `org-export-blocks-preprocess'." - :group 'org-export-general - :version "24.1" - :type 'hook) - -(defun org-export-blocks-html-quote (body &optional open close) - "Protect BODY from org html export. -The optional OPEN and CLOSE tags will be inserted around BODY." - (concat - "\n#+BEGIN_HTML\n" - (or open "") - body (if (string-match "\n$" body) "" "\n") - (or close "") - "#+END_HTML\n")) - -(defun org-export-blocks-latex-quote (body &optional open close) - "Protect BODY from org latex export. -The optional OPEN and CLOSE tags will be inserted around BODY." - (concat - "\n#+BEGIN_LaTeX\n" - (or open "") - body (if (string-match "\n$" body) "" "\n") - (or close "") - "#+END_LaTeX\n")) - -(defvar org-src-preserve-indentation) ; From org-src.el -(defun org-export-blocks-preprocess () - "Export all blocks according to the `org-export-blocks' block export alist. -Does not export block types specified in specified in BLOCKS -which defaults to the value of `org-export-blocks-witheld'." - (interactive) - (save-window-excursion - (let ((case-fold-search t) - (interblock (lambda (start end) - (mapcar (lambda (pair) (funcall (second pair) start end)) - org-export-interblocks))) - matched indentation type types func - start end body headers preserve-indent progress-marker) - (goto-char (point-min)) - (setq start (point)) - (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]")) - (while (re-search-forward beg-re nil t) - (let* ((match-start (copy-marker (match-beginning 0))) - (body-start (copy-marker (match-end 0))) - (indentation (length (match-string 1))) - (inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s" - (regexp-quote (downcase (match-string 2))))) - (type (intern (downcase (match-string 2)))) - (headers (save-match-data - (org-split-string (match-string 3) "[ \t]+"))) - (balanced 1) - (preserve-indent (or org-src-preserve-indentation - (member "-i" headers))) - match-end) - (while (and (not (zerop balanced)) - (re-search-forward inner-re nil t)) - (if (string= (downcase (match-string 1)) "end") - (decf balanced) - (incf balanced))) - (when (not (zerop balanced)) - (error "Unbalanced begin/end_%s blocks with %S" - type (buffer-substring match-start (point)))) - (setq match-end (copy-marker (match-end 0))) - (unless preserve-indent - (setq body (save-match-data (org-remove-indentation - (buffer-substring - body-start (match-beginning 0)))))) - (unless (memq type types) (setq types (cons type types))) - (save-match-data (funcall interblock start match-start)) - (when (setq func (cadr (assoc type org-export-blocks))) - (let ((replacement (save-match-data - (if (memq type org-export-blocks-witheld) "" - (apply func body headers))))) - ;; ;; un-comment this code after the org-element merge - ;; (save-match-data - ;; (when (and replacement (string= replacement "")) - ;; (delete-region - ;; (car (org-element-collect-affiliated-keyword)) - ;; match-start))) - (when replacement - (delete-region match-start match-end) - (goto-char match-start) (insert replacement) - (if preserve-indent - ;; indent only the code block markers - (save-excursion - (indent-line-to indentation) ; indent end_block - (goto-char match-start) - (indent-line-to indentation)) ; indent begin_block - ;; indent everything - (indent-code-rigidly match-start (point) indentation))))) - ;; cleanup markers - (set-marker match-start nil) - (set-marker body-start nil) - (set-marker match-end nil)) - (setq start (point)))) - (funcall interblock start (point-max)) - (run-hooks 'org-export-blocks-postblock-hook)))) - -;;================================================================================ -;; type specific functions - -;;-------------------------------------------------------------------------------- -;; ditaa: create images from ASCII art using the ditaa utility -(defcustom org-ditaa-jar-path (expand-file-name - "ditaa.jar" - (file-name-as-directory - (expand-file-name - "scripts" - (file-name-as-directory - (expand-file-name - "../contrib" - (file-name-directory (org-find-library-dir "org"))))))) - "Path to the ditaa jar executable." - :group 'org-babel - :type 'string) - -(defvar org-export-current-backend) ; dynamically bound in org-exp.el -(defun org-export-blocks-format-ditaa (body &rest headers) - "DEPRECATED: use begin_src ditaa code blocks - -Pass block BODY to the ditaa utility creating an image. -Specify the path at which the image should be saved as the first -element of headers, any additional elements of headers will be -passed to the ditaa utility as command line arguments." - (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks") - (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) - (data-file (make-temp-file "org-ditaa")) - (hash (progn - (set-text-properties 0 (length body) nil body) - (sha1 (prin1-to-string (list body args))))) - (raw-out-file (if headers (car headers))) - (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) - (cons (match-string 1 raw-out-file) - (match-string 2 raw-out-file)) - (cons raw-out-file "png"))) - (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) - (unless (file-exists-p org-ditaa-jar-path) - (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path))) - (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body) - body - (mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1))) - (org-split-string body "\n") - "\n"))) - (prog1 - (cond - ((member org-export-current-backend '(html latex docbook)) - (unless (file-exists-p out-file) - (mapc ;; remove old hashed versions of this file - (lambda (file) - (when (and (string-match (concat (regexp-quote (car out-file-parts)) - "_\\([[:alnum:]]+\\)\\." - (regexp-quote (cdr out-file-parts))) - file) - (= (length (match-string 1 out-file)) 40)) - (delete-file (expand-file-name file - (file-name-directory out-file))))) - (directory-files (or (file-name-directory out-file) - default-directory))) - (with-temp-file data-file (insert body)) - (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) - (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))) - (format "\n[[file:%s]]\n" out-file)) - (t (concat - "\n#+BEGIN_EXAMPLE\n" - body (if (string-match "\n$" body) "" "\n") - "#+END_EXAMPLE\n"))) - (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")))) - -;;-------------------------------------------------------------------------------- -;; dot: create graphs using the dot graphing language -;; (require the dot executable to be in your path) -(defun org-export-blocks-format-dot (body &rest headers) - "DEPRECATED: use \"#+begin_src dot\" code blocks - -Pass block BODY to the dot graphing utility creating an image. -Specify the path at which the image should be saved as the first -element of headers, any additional elements of headers will be -passed to the dot utility as command line arguments. Don't -forget to specify the output type for the dot command, so if you -are exporting to a file with a name like 'image.png' you should -include a '-Tpng' argument, and your block should look like the -following. - -#+begin_dot models.png -Tpng -digraph data_relationships { - \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"] - \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"] - \"data_requirement\" -> \"data_product\" -} -#+end_dot" - (message "begin_dot blocks are DEPRECATED, use begin_src blocks") - (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) - (data-file (make-temp-file "org-ditaa")) - (hash (progn - (set-text-properties 0 (length body) nil body) - (sha1 (prin1-to-string (list body args))))) - (raw-out-file (if headers (car headers))) - (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) - (cons (match-string 1 raw-out-file) - (match-string 2 raw-out-file)) - (cons raw-out-file "png"))) - (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) - (prog1 - (cond - ((member org-export-current-backend '(html latex docbook)) - (unless (file-exists-p out-file) - (mapc ;; remove old hashed versions of this file - (lambda (file) - (when (and (string-match (concat (regexp-quote (car out-file-parts)) - "_\\([[:alnum:]]+\\)\\." - (regexp-quote (cdr out-file-parts))) - file) - (= (length (match-string 1 out-file)) 40)) - (delete-file (expand-file-name file - (file-name-directory out-file))))) - (directory-files (or (file-name-directory out-file) - default-directory))) - (with-temp-file data-file (insert body)) - (message (concat "dot " data-file " " args " -o " out-file)) - (shell-command (concat "dot " data-file " " args " -o " out-file))) - (format "\n[[file:%s]]\n" out-file)) - (t (concat - "\n#+BEGIN_EXAMPLE\n" - body (if (string-match "\n$" body) "" "\n") - "#+END_EXAMPLE\n"))) - (message "begin_dot blocks are DEPRECATED, use begin_src blocks")))) - -;;-------------------------------------------------------------------------------- -;; comment: export comments in author-specific css-stylable divs -(defun org-export-blocks-format-comment (body &rest headers) - "Format comment BODY by OWNER and return it formatted for export. -Currently, this only does something for HTML export, for all -other backends, it converts the comment into an EXAMPLE segment." - (let ((owner (if headers (car headers))) - (title (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))) - (cond - ((eq org-export-current-backend 'html) ;; We are exporting to HTML - (concat "#+BEGIN_HTML\n" - "
    \n" - (if owner (concat "" owner " ") "") - (if (and title (> (length title) 0)) (concat " -- " title "
    \n") "
    \n") - "

    \n" - "#+END_HTML\n" - body - "\n#+BEGIN_HTML\n" - "

    \n" - "
    \n" - "#+END_HTML\n")) - (t ;; This is not HTML, so just make it an example. - (concat "#+BEGIN_EXAMPLE\n" - (if title (concat "Title:" title "\n") "") - (if owner (concat "By:" owner "\n") "") - body - (if (string-match "\n\\'" body) "" "\n") - "#+END_EXAMPLE\n"))))) - -(provide 'org-exp-blocks) - -;;; org-exp-blocks.el ends here diff --git a/lisp/org-exp.el b/lisp/org-exp.el deleted file mode 100644 index 63a06592d..000000000 --- a/lisp/org-exp.el +++ /dev/null @@ -1,3351 +0,0 @@ -;;; org-exp.el --- Export internals for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;;; Code: - -(require 'org) -(require 'org-macs) -(require 'org-agenda) -(require 'org-exp-blocks) -(require 'ob-exp) -(require 'org-src) - -(eval-when-compile - (require 'cl)) - -(declare-function org-export-latex-preprocess "org-latex" (parameters)) -(declare-function org-export-ascii-preprocess "org-ascii" (parameters)) -(declare-function org-export-html-preprocess "org-html" (parameters)) -(declare-function org-export-docbook-preprocess "org-docbook" (parameters)) -(declare-function org-infojs-options-inbuffer-template "org-jsinfo" ()) -(declare-function org-export-htmlize-region-for-paste "org-html" (beg end)) -(declare-function htmlize-buffer "ext:htmlize" (&optional buffer)) -(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) -(declare-function org-table-cookie-line-p "org-table" (line)) -(declare-function org-table-colgroup-line-p "org-table" (line)) -(declare-function org-pop-to-buffer-same-window "org-compat" - (&optional buffer-or-name norecord label)) -(declare-function org-unescape-code-in-region "org-src" (beg end)) - -(org-autoload "org-odt" '(org-export-generic - org-export-as-odt - org-export-as-odt-and-open)) - -(defgroup org-export nil - "Options for exporting org-listings." - :tag "Org Export" - :group 'org) - -(defgroup org-export-general nil - "General options for exporting Org-mode files." - :tag "Org Export General" - :group 'org-export) - -(defcustom org-export-allow-BIND 'confirm - "Non-nil means allow #+BIND to define local variable values for export. -This is a potential security risk, which is why the user must confirm the -use of these lines." - :group 'org-export-general - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "Make the user confirm for each file" confirm))) - -;; FIXME -(defvar org-export-publishing-directory nil) - -(defcustom org-export-show-temporary-export-buffer t - "Non-nil means show buffer after exporting to temp buffer. -When Org exports to a file, the buffer visiting that file is ever -shown, but remains buried. However, when exporting to a temporary -buffer, that buffer is popped up in a second window. When this variable -is nil, the buffer remains buried also in these cases." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-copy-to-kill-ring t - "Non-nil means exported stuff will also be pushed onto the kill ring." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-kill-product-buffer-when-displayed nil - "Non-nil means kill the product buffer if it is displayed immediately. -This applied to the commands `org-export-as-html-and-open' and -`org-export-as-pdf-and-open'." - :group 'org-export-general - :version "24.1" - :type 'boolean) - -(defcustom org-export-run-in-background nil - "Non-nil means export and publishing commands will run in background. -This works by starting up a separate Emacs process visiting the same file -and doing the export from there. -Not all export commands are affected by this - only the ones which -actually write to a file, and that do not depend on the buffer state. -\\ -If this option is nil, you can still get background export by calling -`org-export' with a double prefix arg: \ -\\[universal-argument] \\[universal-argument] \\[org-export]. - -If this option is t, the double prefix can be used to exceptionally -force an export command into the current process." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-initial-scope 'buffer - "The initial scope when exporting with `org-export'. -This variable can be either set to 'buffer or 'subtree." - :group 'org-export-general - :version "24.1" - :type '(choice - (const :tag "Export current buffer" 'buffer) - (const :tag "Export current subtree" 'subtree))) - -(defcustom org-export-select-tags '("export") - "Tags that select a tree for export. -If any such tag is found in a buffer, all trees that do not carry one -of these tags will be deleted before export. -Inside trees that are selected like this, you can still deselect a -subtree by tagging it with one of the `org-export-exclude-tags'." - :group 'org-export-general - :type '(repeat (string :tag "Tag"))) - -(defcustom org-export-exclude-tags '("noexport") - "Tags that exclude a tree from export. -All trees carrying any of these tags will be excluded from export. -This is without condition, so even subtrees inside that carry one of the -`org-export-select-tags' will be removed." - :group 'org-export-general - :type '(repeat (string :tag "Tag"))) - -;; FIXME: rename, this is a general variable -(defcustom org-export-html-expand t - "Non-nil means for HTML export, treat @<...> as HTML tag. -When nil, these tags will be exported as plain text and therefore -not be interpreted by a browser. - -This option can also be set with the +OPTIONS line, e.g. \"@:nil\"." - :group 'org-export-html - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-special-strings t - "Non-nil means interpret \"\-\", \"--\" and \"---\" for export. -When this option is turned on, these strings will be exported as: - - Org HTML LaTeX - -----+----------+-------- - \\- ­ \\- - -- – -- - --- — --- - ... … \ldots - -This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-html-link-up "" - "Where should the \"UP\" link of exported HTML pages lead?" - :group 'org-export-html - :group 'org-export-general - :type '(string :tag "File or URL")) - -(defcustom org-export-html-link-home "" - "Where should the \"HOME\" link of exported HTML pages lead?" - :group 'org-export-html - :group 'org-export-general - :type '(string :tag "File or URL")) - -(defcustom org-export-language-setup - '(("en" "Author" "Date" "Table of Contents" "Footnotes") - ("ca" "Autor" "Data" "Índex" "Peus de pàgina") - ("cs" "Autor" "Datum" "Obsah" "Pozn\xe1mky pod carou") - ("da" "Ophavsmand" "Dato" "Indhold" "Fodnoter") - ("de" "Autor" "Datum" "Inhaltsverzeichnis" "Fußnoten") - ("eo" "Aŭtoro" "Dato" "Enhavo" "Piednotoj") - ("es" "Autor" "Fecha" "Índice" "Pies de página") - ("fi" "Tekijä" "Päivämäärä" "Sisällysluettelo" "Alaviitteet") - ("fr" "Auteur" "Date" "Sommaire" "Notes de bas de page") - ("hu" "Szerzõ" "Dátum" "Tartalomjegyzék" "Lábjegyzet") - ("is" "Höfundur" "Dagsetning" "Efnisyfirlit" "Aftanmálsgreinar") - ("it" "Autore" "Data" "Indice" "Note a piè di pagina") - ;; Use numeric character entities for proper rendering of non-UTF8 documents - ;; ("ja" "著者" "日付" "目次" "脚注") - ("ja" "著者" "日付" "目次" "脚注") - ("nl" "Auteur" "Datum" "Inhoudsopgave" "Voetnoten") - ("no" "Forfatter" "Dato" "Innhold" "Fotnoter") - ("nb" "Forfatter" "Dato" "Innhold" "Fotnoter") ;; nb = Norsk (bokm.l) - ("nn" "Forfattar" "Dato" "Innhald" "Fotnotar") ;; nn = Norsk (nynorsk) - ("pl" "Autor" "Data" "Spis treści" "Przypis") - ;; Use numeric character entities for proper rendering of non-UTF8 documents - ;; ("ru" "Автор" "Дата" "Содержание" "Сноски") - ("ru" "Автор" "Дата" "Содержание" "Сноски") - ("sv" "Författare" "Datum" "Innehåll" "Fotnoter") - ;; Use numeric character entities for proper rendering of non-UTF8 documents - ;; ("uk" "Автор" "Дата" "Зміст" "Примітки") - ("uk" "Автор" "Дата" "Зміст" "Примітки") - ;; Use numeric character entities for proper rendering of non-UTF8 documents - ;; ("zh-CN" "作者" "日期" "目录" "脚注") - ("zh-CN" "作者" "日期" "目录" "脚注") - ;; Use numeric character entities for proper rendering of non-UTF8 documents - ;; ("zh-TW" "作者" "日期" "目錄" "腳註") - ("zh-TW" "作者" "日期" "目錄" "腳註")) - "Terms used in export text, translated to different languages. -Use the variable `org-export-default-language' to set the language, -or use the +OPTION lines for a per-file setting." - :group 'org-export-general - :type '(repeat - (list - (string :tag "HTML language tag") - (string :tag "Author") - (string :tag "Date") - (string :tag "Table of Contents") - (string :tag "Footnotes")))) - -(defcustom org-export-default-language "en" - "The default language for export and clocktable translations, as a string. -This should have an association in `org-export-language-setup' -and in `org-clock-clocktable-language-setup'." - :group 'org-export-general - :type 'string) - -(defcustom org-export-date-timestamp-format "%Y-%m-%d" - "Time string format for Org timestamps in the #+DATE option." - :group 'org-export-general - :version "24.1" - :type 'string) - -(defvar org-export-page-description "" - "The page description, for the XHTML meta tag. -This is best set with the #+DESCRIPTION line in a file, it does not make -sense to set this globally.") - -(defvar org-export-page-keywords "" - "The page description, for the XHTML meta tag. -This is best set with the #+KEYWORDS line in a file, it does not make -sense to set this globally.") - -(defcustom org-export-skip-text-before-1st-heading nil - "Non-nil means skip all text before the first headline when exporting. -When nil, that text is exported as well." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-headline-levels 3 - "The last level which is still exported as a headline. -Inferior levels will produce itemize lists when exported. -Note that a numeric prefix argument to an exporter function overrides -this setting. - -This option can also be set with the +OPTIONS line, e.g. \"H:2\"." - :group 'org-export-general - :type 'integer) - -(defcustom org-export-with-section-numbers t - "Non-nil means add section numbers to headlines when exporting. - -This option can also be set with the +OPTIONS line, e.g. \"num:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-section-number-format '((("1" ".")) . "") - "Format of section numbers for export. -The variable has two components. -1. A list of lists, each indicating a counter type and a separator. - The counter type can be any of \"1\", \"A\", \"a\", \"I\", or \"i\". - It causes causes numeric, alphabetic, or roman counters, respectively. - The separator is only used if another counter for a subsection is being - added. - If there are more numbered section levels than entries in this lists, - then the last entry will be reused. -2. A terminator string that will be added after the entire - section number." - :group 'org-export-general - :type '(cons - (repeat - (list - (string :tag "Counter Type") - (string :tag "Separator "))) - (string :tag "Terminator"))) - -(defcustom org-export-with-toc t - "Non-nil means create a table of contents in exported files. -The TOC contains headlines with levels up to`org-export-headline-levels'. -When an integer, include levels up to N in the toc, this may then be -different from `org-export-headline-levels', but it will not be allowed -to be larger than the number of headline levels. -When nil, no table of contents is made. - -Headlines which contain any TODO items will be marked with \"(*)\" in -ASCII export, and with red color in HTML output, if the option -`org-export-mark-todo-in-toc' is set. - -In HTML output, the TOC will be clickable. - -This option can also be set with the +OPTIONS line, e.g. \"toc:nil\" -or \"toc:3\"." - :group 'org-export-general - :type '(choice - (const :tag "No Table of Contents" nil) - (const :tag "Full Table of Contents" t) - (integer :tag "TOC to level"))) - -(defcustom org-export-mark-todo-in-toc nil - "Non-nil means mark TOC lines that contain any open TODO items." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-todo-keywords t - "Non-nil means include TODO keywords in export. -When nil, remove all these keywords from the export." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-tasks t - "Non-nil means include TODO items for export. -This may have the following values: -t include tasks independent of state. -todo include only tasks that are not yet done. -done include only tasks that are already done. -nil remove all tasks before export -list of TODO kwds keep only tasks with these keywords" - :group 'org-export-general - :version "24.1" - :type '(choice - (const :tag "All tasks" t) - (const :tag "No tasks" nil) - (const :tag "Not-done tasks" todo) - (const :tag "Only done tasks" done) - (repeat :tag "Specific TODO keywords" - (string :tag "Keyword")))) - -(defcustom org-export-with-priority nil - "Non-nil means include priority cookies in export. -When nil, remove priority cookies for export." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-preserve-breaks nil - "Non-nil means preserve all line breaks when exporting. -Normally, in HTML output paragraphs will be reformatted. In ASCII -export, line breaks will always be preserved, regardless of this variable. - -This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-archived-trees 'headline - "Whether subtrees with the ARCHIVE tag should be exported. -This can have three different values -nil Do not export, pretend this tree is not present -t Do export the entire tree -headline Only export the headline, but skip the tree below it." - :group 'org-export-general - :group 'org-archive - :type '(choice - (const :tag "not at all" nil) - (const :tag "headline only" 'headline) - (const :tag "entirely" t))) - -(defcustom org-export-author-info t - "Non-nil means insert author name and email into the exported file. - -This option can also be set with the +OPTIONS line, -e.g. \"author:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-email-info nil - "Non-nil means insert author name and email into the exported file. - -This option can also be set with the +OPTIONS line, -e.g. \"email:t\"." - :group 'org-export-general - :version "24.1" - :type 'boolean) - -(defcustom org-export-creator-info t - "Non-nil means the postamble should contain a creator sentence. -This sentence is \"HTML generated by org-mode XX in emacs XXX\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-time-stamp-file t - "Non-nil means insert a time stamp into the exported file. -The time stamp shows when the file was created. - -This option can also be set with the +OPTIONS line, -e.g. \"timestamp:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-timestamps t - "If nil, do not export time stamps and associated keywords." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-remove-timestamps-from-toc t - "If t, remove timestamps from the table of contents entries." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-tags 'not-in-toc - "If nil, do not export tags, just remove them from headlines. -If this is the symbol `not-in-toc', tags will be removed from table of -contents entries, but still be shown in the headlines of the document. - -This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"." - :group 'org-export-general - :type '(choice - (const :tag "Off" nil) - (const :tag "Not in TOC" not-in-toc) - (const :tag "On" t))) - -(defcustom org-export-with-drawers nil - "Non-nil means export with drawers like the property drawer. -When t, all drawers are exported. This may also be a list of -drawer names to export." - :group 'org-export-general - :type '(choice - (const :tag "All drawers" t) - (const :tag "None" nil) - (repeat :tag "Selected drawers" - (string :tag "Drawer name")))) - -(defvar org-export-first-hook nil - "Hook called as the first thing in each exporter. -Point will be still in the original buffer. -Good for general initialization") - -(defvar org-export-preprocess-hook nil - "Hook for preprocessing an export buffer. -Pretty much the first thing when exporting is running this hook. -Point will be in a temporary buffer that contains a copy of -the original buffer, or of the section that is being exported. -All the other hooks in the org-export-preprocess... category -also work in that temporary buffer, already modified by various -stages of the processing.") - -(defvar org-export-preprocess-after-include-files-hook nil - "Hook for preprocessing an export buffer. -This is run after the contents of included files have been inserted.") - -(defvar org-export-preprocess-after-tree-selection-hook nil - "Hook for preprocessing an export buffer. -This is run after selection of trees to be exported has happened. -This selection includes tags-based selection, as well as removal -of commented and archived trees.") - -(defvar org-export-preprocess-after-headline-targets-hook nil - "Hook for preprocessing export buffer. -This is run just after the headline targets have been defined and -the target-alist has been set up.") - -(defvar org-export-preprocess-before-selecting-backend-code-hook nil - "Hook for preprocessing an export buffer. -This is run just before backend-specific blocks get selected.") - -(defvar org-export-preprocess-after-blockquote-hook nil - "Hook for preprocessing an export buffer. -This is run after blockquote/quote/verse/center have been marked -with cookies.") - -(defvar org-export-preprocess-after-radio-targets-hook nil - "Hook for preprocessing an export buffer. -This is run after radio target processing.") - -(defvar org-export-preprocess-before-normalizing-links-hook nil - "Hook for preprocessing an export buffer. -This hook is run before links are normalized.") - -(defvar org-export-preprocess-before-backend-specifics-hook nil - "Hook run before backend-specific functions are called during preprocessing.") - -(defvar org-export-preprocess-final-hook nil - "Hook for preprocessing an export buffer. -This is run as the last thing in the preprocessing buffer, just before -returning the buffer string to the backend.") - -(defgroup org-export-translation nil - "Options for translating special ascii sequences for the export backends." - :tag "Org Export Translation" - :group 'org-export) - -(defcustom org-export-with-emphasize t - "Non-nil means interpret *word*, /word/, and _word_ as emphasized text. -If the export target supports emphasizing text, the word will be -typeset in bold, italic, or underlined, respectively. Works only for -single words, but you can say: I *really* *mean* *this*. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"*:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-footnotes t - "If nil, export [1] as a footnote marker. -Lines starting with [1] will be formatted as footnotes. - -This option can also be set with the +OPTIONS line, e.g. \"f:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-TeX-macros t - "Non-nil means interpret simple TeX-like macros when exporting. -For example, HTML export converts \\alpha to α and \\AA to Å. -Not only real TeX macros will work here, but the standard HTML entities -for math can be used as macro names as well. For a list of supported -names in HTML export, see the constant `org-entities' and the user option -`org-entities-user'. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." - :group 'org-export-translation - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-with-LaTeX-fragments t - "Non-nil means process LaTeX math fragments for HTML display. -When set, the exporter will find and process LaTeX environments if the -\\begin line is the first non-white thing on a line. It will also find -and process the math delimiters like $a=b$ and \\( a=b \\) for inline math, -$$a=b$$ and \\=\\[ a=b \\] for display math. - -This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\". - -Allowed values are: - -nil Don't do anything. -verbatim Keep everything in verbatim -dvipng Process the LaTeX fragments to images. - This will also include processing of non-math environments. -imagemagick Convert the LaTeX fragments to pdf files and use imagemagick - to convert pdf files to png files. -t Do MathJax preprocessing if there is at least on math snippet, - and arrange for MathJax.js to be loaded. - -The default is nil, because this option needs the `dvipng' program which -is not available on all systems." - :group 'org-export-translation - :group 'org-export-latex - :type '(choice - (const :tag "Do not process math in any way" nil) - (const :tag "Obsolete, use dvipng setting" t) - (const :tag "Use dvipng to make images" dvipng) - (const :tag "Use imagemagick to make images" imagemagick) - (const :tag "Use MathJax to display math" mathjax) - (const :tag "Leave math verbatim" verbatim))) - -(defcustom org-export-with-fixed-width t - "Non-nil means lines starting with \":\" will be in fixed width font. -This can be used to have pre-formatted text, fragments of code etc. For -example: - : ;; Some Lisp examples - : (while (defc cnt) - : (ding)) -will be looking just like this in also HTML. See also the QUOTE keyword. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"::nil\"." - :group 'org-export-translation - :type 'boolean) - -(defgroup org-export-tables nil - "Options for exporting tables in Org-mode." - :tag "Org Export Tables" - :group 'org-export) - -(defcustom org-export-with-tables t - "If non-nil, lines starting with \"|\" define a table. -For example: - - | Name | Address | Birthday | - |-------------+----------+-----------| - | Arthur Dent | England | 29.2.2100 | - -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"|:nil\"." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-highlight-first-table-line t - "Non-nil means highlight the first table line. -In HTML export, this means use instead of . -In tables created with table.el, this applies to the first table line. -In Org-mode tables, all lines before the first horizontal separator -line will be formatted with tags." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-table-remove-special-lines t - "Remove special lines and marking characters in calculating tables. -This removes the special marking character column from tables that are set -up for spreadsheet calculations. It also removes the entire lines -marked with `!', `_', or `^'. The lines with `$' are kept, because -the values of constants may be useful to have." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-table-remove-empty-lines t - "Remove empty lines when exporting tables. -This is the global equivalent of the :remove-nil-lines option -when locally sending a table with #+ORGTBL." - :group 'org-export-tables - :version "24.1" - :type 'boolean) - -(defcustom org-export-prefer-native-exporter-for-tables nil - "Non-nil means always export tables created with table.el natively. -Natively means use the HTML code generator in table.el. -When nil, Org-mode's own HTML generator is used when possible (i.e. if -the table does not use row- or column-spanning). This has the -advantage, that the automatic HTML conversions for math symbols and -sub/superscripts can be applied. Org-mode's HTML generator is also -much faster. The LaTeX exporter always use the native exporter for -table.el tables." - :group 'org-export-tables - :type 'boolean) - -;;;; Exporting - -;;; Variables, constants, and parameter plists - -(defconst org-level-max 20) - -(defvar org-export-current-backend nil - "During export, this will be bound to a symbol such as 'html, - 'latex, 'docbook, 'ascii, etc, indicating which of the export - backends is in use. Otherwise it has the value nil. Users - should not attempt to change the value of this variable - directly, but it can be used in code to test whether export is - in progress, and if so, what the backend is.") - -(defvar org-current-export-file nil) ; dynamically scoped parameter -(defvar org-current-export-dir nil) ; dynamically scoped parameter -(defvar org-export-opt-plist nil - "Contains the current option plist.") -(defvar org-last-level nil) ; dynamically scoped variable -(defvar org-min-level nil) ; dynamically scoped variable -(defvar org-levels-open nil) ; dynamically scoped parameter -(defvar org-export-footnotes-data nil - "Alist of labels used in buffers, along with their definition.") -(defvar org-export-footnotes-seen nil - "Alist of labels encountered so far by the exporter, along with their definition.") - - -(defconst org-export-plist-vars - '((:link-up nil org-export-html-link-up) - (:link-home nil org-export-html-link-home) - (:language nil org-export-default-language) - (:keywords nil org-export-page-keywords) - (:description nil org-export-page-description) - (:customtime nil org-display-custom-times) - (:headline-levels "H" org-export-headline-levels) - (:section-numbers "num" org-export-with-section-numbers) - (:section-number-format nil org-export-section-number-format) - (:table-of-contents "toc" org-export-with-toc) - (:preserve-breaks "\\n" org-export-preserve-breaks) - (:archived-trees nil org-export-with-archived-trees) - (:emphasize "*" org-export-with-emphasize) - (:sub-superscript "^" org-export-with-sub-superscripts) - (:special-strings "-" org-export-with-special-strings) - (:footnotes "f" org-export-with-footnotes) - (:drawers "d" org-export-with-drawers) - (:tags "tags" org-export-with-tags) - (:todo-keywords "todo" org-export-with-todo-keywords) - (:tasks "tasks" org-export-with-tasks) - (:priority "pri" org-export-with-priority) - (:TeX-macros "TeX" org-export-with-TeX-macros) - (:LaTeX-fragments "LaTeX" org-export-with-LaTeX-fragments) - (:latex-listings nil org-export-latex-listings) - (:skip-before-1st-heading "skip" org-export-skip-text-before-1st-heading) - (:fixed-width ":" org-export-with-fixed-width) - (:timestamps "<" org-export-with-timestamps) - (:author nil user-full-name) - (:email nil user-mail-address) - (:author-info "author" org-export-author-info) - (:email-info "email" org-export-email-info) - (:creator-info "creator" org-export-creator-info) - (:time-stamp-file "timestamp" org-export-time-stamp-file) - (:tables "|" org-export-with-tables) - (:table-auto-headline nil org-export-highlight-first-table-line) - (:style-include-default nil org-export-html-style-include-default) - (:style-include-scripts nil org-export-html-style-include-scripts) - (:style nil org-export-html-style) - (:style-extra nil org-export-html-style-extra) - (:agenda-style nil org-agenda-export-html-style) - (:convert-org-links nil org-export-html-link-org-files-as-html) - (:inline-images nil org-export-html-inline-images) - (:html-extension nil org-export-html-extension) - (:html-preamble nil org-export-html-preamble) - (:html-postamble nil org-export-html-postamble) - (:xml-declaration nil org-export-html-xml-declaration) - (:html-table-tag nil org-export-html-table-tag) - (:expand-quoted-html "@" org-export-html-expand) - (:timestamp nil org-export-html-with-timestamp) - (:publishing-directory nil org-export-publishing-directory) - (:select-tags nil org-export-select-tags) - (:exclude-tags nil org-export-exclude-tags) - - (:latex-image-options nil org-export-latex-image-default-option)) - "List of properties that represent export/publishing variables. -Each element is a list of 3 items: -1. The property that is used internally, and also for org-publish-project-alist -2. The string that can be used in the OPTION lines to set this option, - or nil if this option cannot be changed in this way -3. The customization variable that sets the default for this option." - ) - -(defun org-default-export-plist () - "Return the property list with default settings for the export variables." - (let* ((infile (org-infile-export-plist)) - (letbind (plist-get infile :let-bind)) - (l org-export-plist-vars) rtn e s v) - (while (setq e (pop l)) - (setq s (nth 2 e) - v (cond - ((assq s letbind) (nth 1 (assq s letbind))) - ((boundp s) (symbol-value s))) - rtn (cons (car e) (cons v rtn)))) - rtn)) - -(defvar org-export-inbuffer-options-extra nil - "List of additional in-buffer options that should be detected. -Just before export, the buffer is scanned for options like #+TITLE, #+EMAIL, -etc. Extensions can add to this list to get their options detected, and they -can then add a function to `org-export-options-filters' to process these -options. -Each element in this list must be a list, with the in-buffer keyword as car, -and a property (a symbol) as the next element. All occurrences of the -keyword will be found, the values concatenated with a space character -in between, and the result stored in the export options property list.") - -(defvar org-export-options-filters nil - "Functions to be called to finalize the export/publishing options. -All these options are stored in a property list, and each of the functions -in this hook gets a chance to modify this property list. Each function -must accept the property list as an argument, and must return the (possibly -modified) list.") - -;; FIXME: should we fold case here? - -(defun org-infile-export-plist () - "Return the property list with file-local settings for export." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (let ((re (org-make-options-regexp - (append - '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE" - "MATHJAX" - "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE" - "LATEX_HEADER" "LATEX_CLASS" "LATEX_CLASS_OPTIONS" - "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS" - "KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT") - (mapcar 'car org-export-inbuffer-options-extra)))) - (case-fold-search t) - p key val text options mathjax a pr style - latex-header latex-class latex-class-options macros letbind - ext-setup-or-nil setup-file setup-dir setup-contents (start 0)) - (while (or (and ext-setup-or-nil - (string-match re ext-setup-or-nil start) - (setq start (match-end 0))) - (and (setq ext-setup-or-nil nil start 0) - (re-search-forward re nil t))) - (setq key (upcase (org-match-string-no-properties 1 ext-setup-or-nil)) - val (org-match-string-no-properties 2 ext-setup-or-nil)) - (cond - ((setq a (assoc key org-export-inbuffer-options-extra)) - (setq pr (nth 1 a)) - (setq p (plist-put p pr (concat (plist-get p pr) " " val)))) - ((string-equal key "TITLE") (setq p (plist-put p :title val))) - ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) - ((string-equal key "EMAIL") (setq p (plist-put p :email val))) - ((string-equal key "DATE") - ;; If date is an Org timestamp, convert it to a time - ;; string using `org-export-date-timestamp-format' - (when (string-match org-ts-regexp3 val) - (setq val (format-time-string - org-export-date-timestamp-format - (apply 'encode-time (org-parse-time-string - (match-string 0 val)))))) - (setq p (plist-put p :date val))) - ((string-equal key "KEYWORDS") (setq p (plist-put p :keywords val))) - ((string-equal key "DESCRIPTION") - (setq p (plist-put p :description val))) - ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) - ((string-equal key "STYLE") - (setq style (concat style "\n" val))) - ((string-equal key "LATEX_HEADER") - (setq latex-header (concat latex-header "\n" val))) - ((string-equal key "LATEX_CLASS") - (setq latex-class val)) - ((string-equal key "LATEX_CLASS_OPTIONS") - (setq latex-class-options val)) - ((string-equal key "TEXT") - (setq text (if text (concat text "\n" val) val))) - ((string-equal key "OPTIONS") - (setq options (concat val " " options))) - ((string-equal key "MATHJAX") - (setq mathjax (concat val " " mathjax))) - ((string-equal key "BIND") - (push (read (concat "(" val ")")) letbind)) - ((string-equal key "XSLT") - (setq p (plist-put p :xslt val))) - ((string-equal key "LINK_UP") - (setq p (plist-put p :link-up val))) - ((string-equal key "LINK_HOME") - (setq p (plist-put p :link-home val))) - ((string-equal key "EXPORT_SELECT_TAGS") - (setq p (plist-put p :select-tags (org-split-string val)))) - ((string-equal key "EXPORT_EXCLUDE_TAGS") - (setq p (plist-put p :exclude-tags (org-split-string val)))) - ((string-equal key "MACRO") - (push val macros)) - ((equal key "SETUPFILE") - (setq setup-file (org-remove-double-quotes (org-trim val)) - ;; take care of recursive inclusion of setupfiles - setup-file (if (or (file-name-absolute-p val) (not setup-dir)) - (expand-file-name setup-file) - (let ((default-directory setup-dir)) - (expand-file-name setup-file)))) - (setq setup-dir (file-name-directory setup-file)) - (setq setup-contents (org-file-contents setup-file 'noerror)) - (if (not ext-setup-or-nil) - (setq ext-setup-or-nil setup-contents start 0) - (setq ext-setup-or-nil - (concat (substring ext-setup-or-nil 0 start) - "\n" setup-contents "\n" - (substring ext-setup-or-nil start))))))) - (setq p (plist-put p :text text)) - (when (and letbind (org-export-confirm-letbind)) - (setq p (plist-put p :let-bind letbind))) - (when style (setq p (plist-put p :style-extra style))) - (when latex-header - (setq p (plist-put p :latex-header-extra (substring latex-header 1)))) - (when latex-class - (setq p (plist-put p :latex-class latex-class))) - (when latex-class-options - (setq p (plist-put p :latex-class-options latex-class-options))) - (when options - (setq p (org-export-add-options-to-plist p options))) - (when mathjax - (setq p (plist-put p :mathjax mathjax))) - ;; Add macro definitions - (setq p (plist-put p :macro-date "(eval (format-time-string \"$1\"))")) - (setq p (plist-put p :macro-time "(eval (format-time-string \"$1\"))")) - (setq p (plist-put p :macro-property "(eval (org-entry-get nil \"$1\" 'selective))")) - (setq p (plist-put - p :macro-modification-time - (and (buffer-file-name) - (file-exists-p (buffer-file-name)) - (concat - "(eval (format-time-string \"$1\" '" - (prin1-to-string (nth 5 (file-attributes - (buffer-file-name)))) - "))")))) - (setq p (plist-put p :macro-input-file (and (buffer-file-name) - (file-name-nondirectory - (buffer-file-name))))) - (while (setq val (pop macros)) - (when (string-match "^\\([-a-zA-Z0-9_]+\\)[ \t]+\\(.*?[ \t]*$\\)" val) - (setq p (plist-put - p (intern - (concat ":macro-" (downcase (match-string 1 val)))) - (org-export-interpolate-newlines (match-string 2 val)))))) - p)))) - -(defun org-export-interpolate-newlines (s) - (while (string-match "\\\\n" s) - (setq s (replace-match "\n" t t s))) - s) - -(defvar org-export-allow-BIND-local nil) -(defun org-export-confirm-letbind () - "Can we use #+BIND values during export? -By default this will ask for confirmation by the user, to divert possible -security risks." - (cond - ((not org-export-allow-BIND) nil) - ((eq org-export-allow-BIND t) t) - ((local-variable-p 'org-export-allow-BIND-local (current-buffer)) - org-export-allow-BIND-local) - (t (org-set-local 'org-export-allow-BIND-local - (yes-or-no-p "Allow BIND values in this buffer? "))))) - -(defun org-install-letbind () - "Install the values from #+BIND lines as local variables." - (let ((letbind (plist-get org-export-opt-plist :let-bind)) - pair) - (while (setq pair (pop letbind)) - (org-set-local (car pair) (nth 1 pair))))) - -(defun org-export-add-options-to-plist (p options) - "Parse an OPTIONS line and set values in the property list P." - (let (o) - (when options - (let ((op org-export-plist-vars)) - (while (setq o (pop op)) - (if (and (nth 1 o) - (string-match (concat "\\(\\`\\|[ \t]\\)" - (regexp-quote (nth 1 o)) - ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)") - options)) - (setq p (plist-put p (car o) - (car (read-from-string - (match-string 2 options)))))))))) - p) - -(defun org-export-add-subtree-options (p pos) - "Add options in subtree at position POS to property list P." - (save-excursion - (goto-char pos) - (when (org-at-heading-p) - (let (a) - ;; This is actually read in `org-export-get-title-from-subtree' - ;; (when (setq a (org-entry-get pos "EXPORT_TITLE")) - ;; (setq p (plist-put p :title a))) - (when (setq a (org-entry-get pos "EXPORT_TEXT")) - (setq p (plist-put p :text a))) - (when (setq a (org-entry-get pos "EXPORT_AUTHOR")) - (setq p (plist-put p :author a))) - (when (setq a (org-entry-get pos "EXPORT_DATE")) - (setq p (plist-put p :date a))) - (when (setq a (org-entry-get pos "EXPORT_OPTIONS")) - (setq p (org-export-add-options-to-plist p a))))) - p)) - -(defun org-export-directory (type plist) - (let* ((val (plist-get plist :publishing-directory)) - (dir (if (listp val) - (or (cdr (assoc type val)) ".") - val))) - dir)) - -(defun org-export-process-option-filters (plist) - (let ((functions org-export-options-filters) f) - (while (setq f (pop functions)) - (setq plist (funcall f plist)))) - plist) - -;;;###autoload -(defun org-export (&optional arg) - "Export dispatcher for Org-mode. -When `org-export-run-in-background' is non-nil, try to run the command -in the background. This will be done only for commands that write -to a file. For details see the docstring of `org-export-run-in-background'. - -The prefix argument ARG will be passed to the exporter. However, if -ARG is a double universal prefix \\[universal-argument] \\[universal-argument], \ -that means to inverse the -value of `org-export-run-in-background'. - -If `org-export-initial-scope' is set to 'subtree, try to export -the current subtree, otherwise try to export the whole buffer. -Pressing `1' will switch between these two options." - (interactive "P") - (let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background)) - (subtree-p (or (org-region-active-p) - (eq org-export-initial-scope 'subtree))) - (regb (and (org-region-active-p) (region-beginning))) - (rege (and (org-region-active-p) (region-end))) - (help "[t] insert the export option template -\[v] limit export to visible part of outline tree -\[1] switch buffer/subtree export -\[SPC] publish enclosing subtree (with LaTeX_CLASS or EXPORT_FILE_NAME prop) - -\[a/n/u] export as ASCII/Latin-1/UTF-8 [A/N/U] to temporary buffer - -\[h] export as HTML [H] to temporary buffer [R] export region -\[b] export as HTML and open in browser - -\[l] export as LaTeX [L] to temporary buffer -\[p] export as LaTeX and process to PDF [d] ... and open PDF file - -\[D] export as DocBook [V] export as DocBook, process to PDF, and open - -\[o] export as OpenDocument Text [O] ... and open - -\[j] export as TaskJuggler [J] ... and open - -\[m] export as Freemind mind map -\[x] export as XOXO -\[g] export using Wes Hardaker's generic exporter - -\[i] export current file as iCalendar file -\[I] export all agenda files as iCalendar files [c] ...as one combined file - -\[F] publish current file [P] publish current project -\[X] publish a project... [E] publish every projects") - (cmds - '((?t org-insert-export-options-template nil) - (?v org-export-visible nil) - (?a org-export-as-ascii t) - (?A org-export-as-ascii-to-buffer t) - (?n org-export-as-latin1 t) - (?N org-export-as-latin1-to-buffer t) - (?u org-export-as-utf8 t) - (?U org-export-as-utf8-to-buffer t) - (?h org-export-as-html t) - (?b org-export-as-html-and-open t) - (?H org-export-as-html-to-buffer nil) - (?R org-export-region-as-html nil) - (?x org-export-as-xoxo t) - (?g org-export-generic t) - (?D org-export-as-docbook t) - (?V org-export-as-docbook-pdf-and-open t) - (?o org-export-as-odt t) - (?O org-export-as-odt-and-open t) - (?j org-export-as-taskjuggler t) - (?J org-export-as-taskjuggler-and-open t) - (?m org-export-as-freemind t) - (?l org-export-as-latex t) - (?p org-export-as-pdf t) - (?d org-export-as-pdf-and-open t) - (?L org-export-as-latex-to-buffer nil) - (?i org-export-icalendar-this-file t) - (?I org-export-icalendar-all-agenda-files t) - (?c org-export-icalendar-combine-agenda-files t) - (?F org-publish-current-file t) - (?P org-publish-current-project t) - (?X org-publish t) - (?E org-publish-all t))) - r1 r2 ass - (cpos (point)) (cbuf (current-buffer)) bpos) - (save-excursion - (save-window-excursion - (if subtree-p - (message "Export subtree: ") - (message "Export buffer: ")) - (delete-other-windows) - (with-output-to-temp-buffer "*Org Export/Publishing Help*" - (princ help)) - (org-fit-window-to-buffer (get-buffer-window - "*Org Export/Publishing Help*")) - (while (eq (setq r1 (read-char-exclusive)) ?1) - (cond (subtree-p - (setq subtree-p nil) - (message "Export buffer: ")) - ((not subtree-p) - (setq subtree-p t) - (setq bpos (point)) - (org-mark-subtree) - (org-activate-mark) - (setq regb (and (org-region-active-p) (region-beginning))) - (setq rege (and (org-region-active-p) (region-end))) - (message "Export subtree: ")))) - (when (eq r1 ?\ ) - (let ((case-fold-search t) - (end (save-excursion (while (org-up-heading-safe)) (point)))) - (outline-next-heading) - (if (re-search-backward - "^[ \t]+\\(:latex_class:\\|:export_title:\\|:export_file_name:\\)[ \t]+\\S-" - end t) - (progn - (org-back-to-heading t) - (setq subtree-p t) - (setq bpos (point)) - (message "Select command (for subtree): ") - (setq r1 (read-char-exclusive))) - (error "No enclosing node with LaTeX_CLASS or EXPORT_TITLE or EXPORT_FILE_NAME") - ))))) - (if (fboundp 'redisplay) (redisplay)) ;; XEmacs does not have/need (redisplay) - (and bpos (goto-char bpos)) - (setq r2 (if (< r1 27) (+ r1 96) r1)) - (unless (setq ass (assq r2 cmds)) - (error "No command associated with key %c" r1)) - (if (and bg (nth 2 ass) - (not (buffer-base-buffer)) - (not (org-region-active-p))) - ;; execute in background - (let ((p (start-process - (concat "Exporting " (file-name-nondirectory (buffer-file-name))) - "*Org Processes*" - (expand-file-name invocation-name invocation-directory) - "-batch" - "-l" user-init-file - "--eval" "(require 'org-exp)" - "--eval" "(setq org-wait .2)" - (buffer-file-name) - "-f" (symbol-name (nth 1 ass))))) - (set-process-sentinel p 'org-export-process-sentinel) - (message "Background process \"%s\": started" p)) - ;; set the mark correctly when exporting a subtree - (if subtree-p (let (deactivate-mark) (push-mark rege t t) (goto-char regb))) - - (call-interactively (nth 1 ass)) - (when (and bpos (get-buffer-window cbuf)) - (let ((cw (selected-window))) - (select-window (get-buffer-window cbuf)) - (goto-char cpos) - (deactivate-mark) - (select-window cw)))))) - -(defun org-export-process-sentinel (process status) - (if (string-match "\n+\\'" status) - (setq status (substring status 0 -1))) - (message "Background process \"%s\": %s" process status)) - -;;; General functions for all backends - -(defvar org-export-target-aliases nil - "Alist of targets with invisible aliases.") -(defvar org-export-preferred-target-alist nil - "Alist of section id's with preferred aliases.") -(defvar org-export-id-target-alist nil - "Alist of section id's with preferred aliases.") -(defvar org-export-code-refs nil - "Alist of code references and line numbers.") - -(defun org-export-preprocess-string (string &rest parameters) - "Cleanup STRING so that the true exported has a more consistent source. -This function takes STRING, which should be a buffer-string of an org-file -to export. It then creates a temporary buffer where it does its job. -The result is then again returned as a string, and the exporter works -on this string to produce the exported version." - (interactive) - (let* ((org-export-current-backend (or (plist-get parameters :for-backend) - org-export-current-backend)) - (archived-trees (plist-get parameters :archived-trees)) - (inhibit-read-only t) - (drawers org-drawers) - (source-buffer (current-buffer)) - target-alist rtn) - - (setq org-export-target-aliases nil - org-export-preferred-target-alist nil - org-export-id-target-alist nil - org-export-code-refs nil) - - (with-temp-buffer - (erase-buffer) - (insert string) - (setq case-fold-search t) - - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) - '(read-only t))) - - ;; Remove license-to-kill stuff - ;; The caller marks some stuff for killing, stuff that has been - ;; used to create the page title, for example. - (org-export-kill-licensed-text) - - (let ((org-inhibit-startup t)) (org-mode)) - (setq case-fold-search t) - (org-clone-local-variables source-buffer "^\\(org-\\|orgtbl-\\)") - (org-install-letbind) - - ;; Call the hook - (run-hooks 'org-export-preprocess-hook) - - (untabify (point-min) (point-max)) - - ;; Handle include files, and call a hook - (org-export-handle-include-files-recurse) - (run-hooks 'org-export-preprocess-after-include-files-hook) - - ;; Get rid of archived trees - (org-export-remove-archived-trees archived-trees) - - ;; Remove comment environment and comment subtrees - (org-export-remove-comment-blocks-and-subtrees) - - ;; Get rid of excluded trees, and call a hook - (org-export-handle-export-tags (plist-get parameters :select-tags) - (plist-get parameters :exclude-tags)) - (run-hooks 'org-export-preprocess-after-tree-selection-hook) - - ;; Get rid of tasks, depending on configuration - (org-export-remove-tasks (plist-get parameters :tasks)) - - ;; Prepare footnotes for export. During that process, footnotes - ;; actually included in the exported part of the buffer go - ;; though some transformations: - - ;; 1. They have their label normalized (like "[N]"); - - ;; 2. They get moved at the same place in the buffer (usually at - ;; its end, but backends may define another place via - ;; `org-footnote-insert-pos-for-preprocessor'); - - ;; 3. The are stored in `org-export-footnotes-seen', while - ;; `org-export-preprocess-string' is applied to their - ;; definition. - - ;; Line-wise exporters ignore `org-export-footnotes-seen', as - ;; they interpret footnotes at the moment they see them in the - ;; buffer. Context-wise exporters grab all the info needed in - ;; that variable and delete moved definitions (as described in - ;; 2nd step). - (when (plist-get parameters :footnotes) - (org-footnote-normalize nil parameters)) - - ;; Change lists ending. Other parts of export may insert blank - ;; lines and lists' structure could be altered. - (org-export-mark-list-end) - - ;; Process the macros - (org-export-preprocess-apply-macros) - (run-hooks 'org-export-preprocess-after-macros-hook) - - ;; Export code blocks - (org-export-blocks-preprocess) - - ;; Mark lists with properties - (org-export-mark-list-properties) - - ;; Handle source code snippets - (org-export-replace-src-segments-and-examples) - - ;; Protect short examples marked by a leading colon - (org-export-protect-colon-examples) - - ;; Protected spaces - (org-export-convert-protected-spaces) - - ;; Find all headings and compute the targets for them - (setq target-alist (org-export-define-heading-targets target-alist)) - - (run-hooks 'org-export-preprocess-after-headline-targets-hook) - - ;; Find HTML special classes for headlines - (org-export-remember-html-container-classes) - - ;; Get rid of drawers - (org-export-remove-or-extract-drawers - drawers (plist-get parameters :drawers)) - - ;; Get the correct stuff before the first headline - (when (plist-get parameters :skip-before-1st-heading) - (goto-char (point-min)) - (when (re-search-forward "^\\(#.*\n\\)?\\*+[ \t]" nil t) - (delete-region (point-min) (match-beginning 0)) - (goto-char (point-min)) - (insert "\n"))) - (when (plist-get parameters :add-text) - (goto-char (point-min)) - (insert (plist-get parameters :add-text) "\n")) - - ;; Remove todo-keywords before exporting, if the user has requested so - (org-export-remove-headline-metadata parameters) - - ;; Find targets in comments and move them out of comments, - ;; but mark them as targets that should be invisible - (setq target-alist (org-export-handle-invisible-targets target-alist)) - - ;; Select and protect backend specific stuff, throw away stuff - ;; that is specific for other backends - (run-hooks 'org-export-preprocess-before-selecting-backend-code-hook) - (org-export-select-backend-specific-text) - - ;; Protect quoted subtrees - (org-export-protect-quoted-subtrees) - - ;; Remove clock lines - (org-export-remove-clock-lines) - - ;; Protect verbatim elements - (org-export-protect-verbatim) - - ;; Blockquotes, verse, and center - (org-export-mark-blockquote-verse-center) - (run-hooks 'org-export-preprocess-after-blockquote-hook) - - ;; Remove timestamps, if the user has requested so - (unless (plist-get parameters :timestamps) - (org-export-remove-timestamps)) - - ;; Attach captions to the correct object - (setq target-alist (org-export-attach-captions-and-attributes target-alist)) - - ;; Find matches for radio targets and turn them into internal links - (org-export-mark-radio-links) - (run-hooks 'org-export-preprocess-after-radio-targets-hook) - - ;; Find all links that contain a newline and put them into a single line - (org-export-concatenate-multiline-links) - - ;; Normalize links: Convert angle and plain links into bracket links - ;; and expand link abbreviations - (run-hooks 'org-export-preprocess-before-normalizing-links-hook) - (org-export-normalize-links) - - ;; Find all internal links. If they have a fuzzy match (i.e. not - ;; a *dedicated* target match, let the link point to the - ;; corresponding section. - (org-export-target-internal-links target-alist) - - ;; Find multiline emphasis and put them into single line - (when (plist-get parameters :emph-multiline) - (org-export-concatenate-multiline-emphasis)) - - ;; Remove special table lines, and store alignment information - (org-store-forced-table-alignment) - (when org-export-table-remove-special-lines - (org-export-remove-special-table-lines)) - - ;; Another hook - (run-hooks 'org-export-preprocess-before-backend-specifics-hook) - - ;; Backend-specific preprocessing - (let* ((backend-name (symbol-name org-export-current-backend)) - (f (intern (format "org-export-%s-preprocess" backend-name)))) - (require (intern (concat "org-" backend-name)) nil) - (funcall f parameters)) - - ;; Remove or replace comments - (org-export-handle-comments (plist-get parameters :comments)) - - ;; Remove #+TBLFM #+TBLNAME #+NAME #+RESULTS lines - (org-export-handle-metalines) - - ;; Run the final hook - (run-hooks 'org-export-preprocess-final-hook) - - (setq rtn (buffer-string))) - rtn)) - -(defun org-export-kill-licensed-text () - "Remove all text that is marked with a :org-license-to-kill property." - (let (p) - (while (setq p (text-property-any (point-min) (point-max) - :org-license-to-kill t)) - (delete-region - p (or (next-single-property-change p :org-license-to-kill) - (point-max)))))) - -(defvar org-export-define-heading-targets-headline-hook nil - "Hook that is run when a headline was matched during target search. -This is part of the preprocessing for export.") - -(defun org-export-define-heading-targets (target-alist) - "Find all headings and define the targets for them. -The new targets are added to TARGET-ALIST, which is also returned. -Also find all ID and CUSTOM_ID properties and store them." - (goto-char (point-min)) - (org-init-section-numbers) - (let ((re (concat "^" org-outline-regexp - "\\|" - "^[ \t]*:\\(ID\\|CUSTOM_ID\\):[ \t]*\\([^ \t\r\n]+\\)")) - level target last-section-target a id) - (while (re-search-forward re nil t) - (org-if-unprotected-at (match-beginning 0) - (if (match-end 2) - (progn - (setq id (org-match-string-no-properties 2)) - (push (cons id target) target-alist) - (setq a (or (assoc last-section-target org-export-target-aliases) - (progn - (push (list last-section-target) - org-export-target-aliases) - (car org-export-target-aliases)))) - (push (caar target-alist) (cdr a)) - (when (equal (match-string 1) "CUSTOM_ID") - (if (not (assoc last-section-target - org-export-preferred-target-alist)) - (push (cons last-section-target id) - org-export-preferred-target-alist))) - (when (equal (match-string 1) "ID") - (if (not (assoc last-section-target - org-export-id-target-alist)) - (push (cons last-section-target (concat "ID-" id)) - org-export-id-target-alist)))) - (setq level (org-reduced-level - (save-excursion (goto-char (point-at-bol)) - (org-outline-level)))) - (setq target (org-solidify-link-text - (format "sec-%s" (replace-regexp-in-string - "\\." "-" - (org-section-number level))))) - (setq last-section-target target) - (push (cons target target) target-alist) - (add-text-properties - (point-at-bol) (point-at-eol) - (list 'target target)) - (run-hooks 'org-export-define-heading-targets-headline-hook))))) - target-alist) - -(defun org-export-handle-invisible-targets (target-alist) - "Find targets in comments and move them out of comments. -Mark them as invisible targets." - (let (target tmp a) - (goto-char (point-min)) - (while (re-search-forward "^#.*?\\(<<\r\n]+\\)>>>?\\).*" nil t) - ;; Check if the line before or after is a headline with a target - (if (setq target (or (get-text-property (point-at-bol 0) 'target) - (get-text-property (point-at-bol 2) 'target))) - (progn - ;; use the existing target in a neighboring line - (setq tmp (match-string 2)) - (replace-match "") - (and (looking-at "\n") (delete-char 1)) - (push (cons (setq tmp (org-solidify-link-text tmp)) target) - target-alist) - (setq a (or (assoc target org-export-target-aliases) - (progn - (push (list target) org-export-target-aliases) - (car org-export-target-aliases)))) - (push tmp (cdr a))) - ;; Make an invisible target - (replace-match "\\1(INVISIBLE)")))) - target-alist) - -(defun org-export-target-internal-links (target-alist) - "Find all internal links and assign targets to them. -If a link has a fuzzy match (i.e. not a *dedicated* target match), -let the link point to the corresponding section. -This function also handles the id links, if they have a match in -the current file." - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-regexp nil t) - (org-if-unprotected-at (1+ (match-beginning 0)) - (let* ((org-link-search-must-match-exact-headline t) - (md (match-data)) - (desc (match-end 2)) - (link (org-link-unescape (match-string 1))) - (slink (org-solidify-link-text link)) - found props pos cref - (target - (cond - ((= (string-to-char link) ?#) - ;; user wants exactly this link - link) - ((cdr (assoc slink target-alist)) - (or (cdr (assoc (assoc slink target-alist) - org-export-preferred-target-alist)) - (cdr (assoc slink target-alist)))) - ((and (string-match "^id:" link) - (cdr (assoc (substring link 3) target-alist)))) - ((string-match "^(\\(.*\\))$" link) - (setq cref (match-string 1 link)) - (concat "coderef:" cref)) - ((string-match org-link-types-re link) nil) - ((or (file-name-absolute-p link) - (string-match "^\\." link)) - nil) - (t - (let ((org-link-search-inhibit-query t)) - (save-excursion - (setq found (condition-case nil (org-link-search link) - (error nil))) - (when (and found - (or (org-at-heading-p) - (not (eq found 'dedicated)))) - (or (get-text-property (point) 'target) - (get-text-property - (max (point-min) - (1- (or (previous-single-property-change - (point) 'target) 0))) - 'target))))))))) - (when target - (set-match-data md) - (goto-char (match-beginning 1)) - (setq props (text-properties-at (point))) - (delete-region (match-beginning 1) (match-end 1)) - (setq pos (point)) - (insert target) - (unless desc (insert "][" link)) - (add-text-properties pos (point) props)))))) - -(defun org-export-remember-html-container-classes () - "Store the HTML_CONTAINER_CLASS properties in a text property." - (goto-char (point-min)) - (let (class) - (while (re-search-forward - "^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(.+\\)$" nil t) - (setq class (match-string 1)) - (save-excursion - (when (re-search-backward "^\\*" (point-min) t) - (org-back-to-heading t) - (put-text-property (point-at-bol) (point-at-eol) - 'html-container-class class)))))) - -(defvar org-export-format-drawer-function nil - "Function to be called to format the contents of a drawer. -The function must accept two parameters: - NAME the drawer name, like \"PROPERTIES\" - CONTENT the content of the drawer. -You can check the export backend through `org-export-current-backend'. -The function should return the text to be inserted into the buffer. -If this is nil, `org-export-format-drawer' is used as a default.") - -(defun org-export-remove-or-extract-drawers (all-drawers exp-drawers) - "Remove drawers, or extract and format the content. -ALL-DRAWERS is a list of all drawer names valid in the current buffer. -EXP-DRAWERS can be t to keep all drawer contents, or a list of drawers -whose content to keep. Any drawers that are in ALL-DRAWERS but not in -EXP-DRAWERS will be removed." - (goto-char (point-min)) - (let ((re (concat "^[ \t]*:\\(" - (mapconcat 'identity all-drawers "\\|") - "\\):[ \t]*$")) - name beg beg-content eol content) - (while (re-search-forward re nil t) - (org-if-unprotected - (setq name (match-string 1)) - (setq beg (match-beginning 0) - beg-content (1+ (point-at-eol)) - eol (point-at-eol)) - (if (not (and (re-search-forward - "^\\([ \t]*:END:[ \t]*\n?\\)\\|^\\*+[ \t]" nil t) - (match-end 1))) - (goto-char eol) - (goto-char (match-beginning 0)) - (and (looking-at ".*\n?") (replace-match "")) - (setq content (buffer-substring beg-content (point))) - (delete-region beg (point)) - (when (or (eq exp-drawers t) - (member name exp-drawers)) - (setq content (funcall (or org-export-format-drawer-function - 'org-export-format-drawer) - name content)) - (insert content))))))) - -(defun org-export-format-drawer (name content) - "Format the content of a drawer as a colon example." - (if (string-match "[ \t]+\\'" content) - (setq content (substring content (match-beginning 0)))) - (while (string-match "\\`[ \t]*\n" content) - (setq content (substring content (match-end 0)))) - (setq content (org-remove-indentation content)) - (setq content (concat ": " (mapconcat 'identity - (org-split-string content "\n") - "\n: ") - "\n")) - (setq content (concat " : " (upcase name) "\n" content)) - (org-add-props content nil 'org-protected t)) - -(defun org-export-handle-export-tags (select-tags exclude-tags) - "Modify the buffer, honoring SELECT-TAGS and EXCLUDE-TAGS. -Both arguments are lists of tags. -If any of SELECT-TAGS is found, all trees not marked by a SELECT-TAG -will be removed. -After that, all subtrees that are marked by EXCLUDE-TAGS will be -removed as well." - (remove-text-properties (point-min) (point-max) '(:org-delete t)) - (let* ((re-sel (concat ":\\(" (mapconcat 'regexp-quote - select-tags "\\|") - "\\):")) - (re-excl (concat ":\\(" (mapconcat 'regexp-quote - exclude-tags "\\|") - "\\):")) - beg end cont) - (goto-char (point-min)) - (when (and select-tags - (re-search-forward - (concat "^\\*+[ \t].*" re-sel "[^ \t\n]*[ \t]*$") nil t)) - ;; At least one tree is marked for export, this means - ;; all the unmarked stuff needs to go. - ;; Dig out the trees that should be exported - (goto-char (point-min)) - (outline-next-heading) - (setq beg (point)) - (put-text-property beg (point-max) :org-delete t) - (while (re-search-forward re-sel nil t) - (when (org-at-heading-p) - (org-back-to-heading) - (remove-text-properties - (max (1- (point)) (point-min)) - (setq cont (save-excursion (org-end-of-subtree t t))) - '(:org-delete t)) - (while (and (org-up-heading-safe) - (get-text-property (point) :org-delete)) - (remove-text-properties (max (1- (point)) (point-min)) - (point-at-eol) '(:org-delete t))) - (goto-char cont)))) - ;; Remove the trees explicitly marked for noexport - (when exclude-tags - (goto-char (point-min)) - (while (re-search-forward re-excl nil t) - (when (org-at-heading-p) - (org-back-to-heading t) - (setq beg (point)) - (org-end-of-subtree t t) - (delete-region beg (point)) - (when (featurep 'org-inlinetask) - (org-inlinetask-remove-END-maybe))))) - ;; Remove everything that is now still marked for deletion - (goto-char (point-min)) - (while (setq beg (text-property-any (point-min) (point-max) :org-delete t)) - (setq end (or (next-single-property-change beg :org-delete) - (point-max))) - (delete-region beg end)))) - -(defun org-export-remove-tasks (keep) - "Remove tasks depending on configuration. -When KEEP is nil, remove all tasks. -When KEEP is `todo', remove the tasks that are DONE. -When KEEP is `done', remove the tasks that are not yet done. -When it is a list of strings, keep only tasks with these TODO keywords." - (when (or (listp keep) (memq keep '(todo done nil))) - (let ((re (concat "^\\*+[ \t]+\\(" - (mapconcat - 'regexp-quote - (cond ((not keep) org-todo-keywords-1) - ((eq keep 'todo) org-done-keywords) - ((eq keep 'done) org-not-done-keywords) - ((listp keep) - (org-delete-all keep (copy-sequence - org-todo-keywords-1)))) - "\\|") - "\\)\\($\\|[ \t]\\)")) - (case-fold-search nil) - beg) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (org-if-unprotected - (setq beg (match-beginning 0)) - (org-end-of-subtree t t) - (if (looking-at "^\\*+[ \t]+END[ \t]*$") - ;; Kill the END line of the inline task - (goto-char (min (point-max) (1+ (match-end 0))))) - (delete-region beg (point))))))) - -(defun org-export-remove-archived-trees (export-archived-trees) - "Remove archived trees. -When EXPORT-ARCHIVED-TREES is `headline;, only the headline will be exported. -When it is t, the entire archived tree will be exported. -When it is nil the entire tree including the headline will be removed -from the buffer." - (let ((re-archive (concat ":" org-archive-tag ":")) - a b) - (when (not (eq export-archived-trees t)) - (goto-char (point-min)) - (while (re-search-forward re-archive nil t) - (if (not (org-at-heading-p t)) - (goto-char (point-at-eol)) - (beginning-of-line 1) - (setq a (if export-archived-trees - (1+ (point-at-eol)) (point)) - b (org-end-of-subtree t)) - (if (> b a) (delete-region a b))))))) - -(defun org-export-remove-headline-metadata (opts) - "Remove meta data from the headline, according to user options." - (let ((re org-complex-heading-regexp) - (todo (plist-get opts :todo-keywords)) - (tags (plist-get opts :tags)) - (pri (plist-get opts :priority)) - (elts '(1 2 3 4 5)) - (case-fold-search nil) - rpl) - (setq elts (delq nil (list 1 (if todo 2) (if pri 3) 4 (if tags 5)))) - (when (or (not todo) (not tags) (not pri)) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (org-if-unprotected - (setq rpl (mapconcat (lambda (i) (if (match-end i) (match-string i) "")) - elts " ")) - (replace-match rpl t t)))))) - -(defun org-export-remove-timestamps () - "Remove timestamps and keywords for export." - (goto-char (point-min)) - (while (re-search-forward org-maybe-keyword-time-regexp nil t) - (backward-char 1) - (org-if-unprotected - (unless (save-match-data (org-at-table-p)) - (replace-match "") - (beginning-of-line 1) - (if (looking-at "[- \t]*\\(=>[- \t0-9:]*\\)?[ \t]*\n") - (replace-match "")))))) - -(defun org-export-remove-clock-lines () - "Remove clock lines for export." - (goto-char (point-min)) - (let ((re (concat "^[ \t]*" org-clock-string ".*\n?"))) - (while (re-search-forward re nil t) - (org-if-unprotected - (replace-match ""))))) - -(defvar org-heading-keyword-regexp-format) ; defined in org.el -(defun org-export-protect-quoted-subtrees () - "Mark quoted subtrees with the protection property." - (let ((org-re-quote (format org-heading-keyword-regexp-format - org-quote-string))) - (goto-char (point-min)) - (while (re-search-forward org-re-quote nil t) - (goto-char (match-beginning 0)) - (end-of-line 1) - (add-text-properties (point) (org-end-of-subtree t) - '(org-protected t))))) - -(defun org-export-convert-protected-spaces () - "Convert strings like \\____ to protected spaces in all backends." - (goto-char (point-min)) - (while (re-search-forward "\\\\__+" nil t) - (org-if-unprotected-1 - (replace-match - (org-add-props - (cond - ((eq org-export-current-backend 'latex) - (format "\\hspace{%dex}" (- (match-end 0) (match-beginning 0)))) - ((eq org-export-current-backend 'html) - (org-add-props (match-string 0) nil - 'org-whitespace (- (match-end 0) (match-beginning 0)))) - ;; ((eq org-export-current-backend 'docbook)) - ((eq org-export-current-backend 'ascii) - (org-add-props (match-string 0) '(org-whitespace t))) - (t (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) - '(org-protected t)) - t t)))) - -(defun org-export-protect-verbatim () - "Mark verbatim snippets with the protection property." - (goto-char (point-min)) - (while (re-search-forward org-verbatim-re nil t) - (org-if-unprotected - (add-text-properties (match-beginning 4) (match-end 4) - '(org-protected t org-verbatim-emph t)) - (goto-char (1+ (match-end 4)))))) - -(defun org-export-protect-colon-examples () - "Protect lines starting with a colon." - (goto-char (point-min)) - (let ((re "^[ \t]*:\\([ \t]\\|$\\)") beg) - (while (re-search-forward re nil t) - (beginning-of-line 1) - (setq beg (point)) - (while (looking-at re) - (end-of-line 1) - (or (eobp) (forward-char 1))) - (add-text-properties beg (if (bolp) (1- (point)) (point)) - '(org-protected t))))) - -(defvar org-export-backends - '(docbook html beamer ascii latex) - "List of Org supported export backends.") - -(defun org-export-select-backend-specific-text () - (let ((formatters org-export-backends) - (case-fold-search t) - backend backend-name beg beg-content end end-content ind) - - (while formatters - (setq backend (pop formatters) - backend-name (symbol-name backend)) - - ;; Handle #+BACKEND: stuff - (goto-char (point-min)) - (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" backend-name - ":[ \t]*\\(.*\\)") nil t) - (if (not (eq backend org-export-current-backend)) - (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) - (let ((ind (get-text-property (point-at-bol) 'original-indentation))) - (replace-match "\\1\\2" t) - (add-text-properties - (point-at-bol) (min (1+ (point-at-eol)) (point-max)) - `(org-protected t original-indentation ,ind org-native-text t))))) - ;; Delete #+ATTR_BACKEND: stuff of another backend. Those - ;; matching the current backend will be taken care of by - ;; `org-export-attach-captions-and-attributes' - (goto-char (point-min)) - (while (re-search-forward (concat "^\\([ \t]*\\)#\\+ATTR_" backend-name - ":[ \t]*\\(.*\\)") nil t) - (setq ind (org-get-indentation)) - (when (not (eq backend org-export-current-backend)) - (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) - ;; Handle #+BEGIN_BACKEND and #+END_BACKEND stuff - (goto-char (point-min)) - (while (re-search-forward (concat "^[ \t]*#\\+BEGIN_" backend-name "\\>.*\n?") - nil t) - (setq beg (match-beginning 0) beg-content (match-end 0)) - (setq ind (or (get-text-property beg 'original-indentation) - (save-excursion (goto-char beg) (org-get-indentation)))) - (when (re-search-forward (concat "^[ \t]*#\\+END_" backend-name "\\>.*\n?") - nil t) - (setq end (match-end 0) end-content (match-beginning 0)) - (if (eq backend org-export-current-backend) - ;; yes, keep this - (progn - (add-text-properties - beg-content end-content - `(org-protected t original-indentation ,ind org-native-text t)) - ;; strip protective commas - (org-unescape-code-in-region beg-content end-content) - (delete-region (match-beginning 0) (match-end 0)) - (save-excursion - (goto-char beg) - (delete-region (point) (1+ (point-at-eol))))) - ;; No, this is for a different backend, kill it - (delete-region beg end))))))) - -(defun org-export-mark-blockquote-verse-center () - "Mark block quote and verse environments with special cookies. -These special cookies will later be interpreted by the backend." - ;; Blockquotes - (let (type t1 ind beg end beg1 end1 content) - (goto-char (point-min)) - (while (re-search-forward - "^\\([ \t]*\\)#\\+\\(begin_\\(\\(block\\)?quote\\|verse\\|center\\)\\>.*\\)" - nil t) - (setq ind (length (match-string 1)) - type (downcase (match-string 3)) - t1 (if (equal type "quote") "blockquote" type)) - (setq beg (match-beginning 0) - beg1 (1+ (match-end 0))) - (when (re-search-forward (concat "^[ \t]*#\\+end_" type "\\>.*") nil t) - (setq end1 (1- (match-beginning 0)) - end (+ (point-at-eol) (if (looking-at "\n$") 1 0))) - (setq content (org-remove-indentation (buffer-substring beg1 end1))) - (setq content (concat "ORG-" (upcase t1) "-START\n" - content "\n" - "ORG-" (upcase t1) "-END\n")) - (delete-region beg end) - (insert (org-add-props content nil 'original-indentation ind)))))) - -(defun org-export-mark-list-end () - "Mark all list endings with a special string." - (unless (eq org-export-current-backend 'ascii) - (mapc - (lambda (e) - ;; For each type allowing list export, find every list, remove - ;; ending regexp if needed, and insert org-list-end. - (goto-char (point-min)) - (while (re-search-forward (org-item-beginning-re) nil t) - (when (eq (nth 2 (org-list-context)) e) - (let* ((struct (org-list-struct)) - (bottom (org-list-get-bottom-point struct)) - (top (point-at-bol)) - (top-ind (org-list-get-ind top struct))) - (goto-char bottom) - (when (and (not (looking-at "[ \t]*$")) - (looking-at org-list-end-re)) - (replace-match "")) - (unless (bolp) (insert "\n")) - ;; As org-list-end is inserted at column 0, it would end - ;; by indentation any list. It can be problematic when - ;; there are lists within lists: the inner list end would - ;; also become the outer list end. To avoid this, text - ;; property `original-indentation' is added, as - ;; `org-list-struct' pays attention to it when reading a - ;; list. - (insert (org-add-props - "ORG-LIST-END-MARKER\n" - (list 'original-indentation top-ind))))))) - (cons nil org-list-export-context)))) - -(defun org-export-mark-list-properties () - "Mark list with special properties. -These special properties will later be interpreted by the backend." - (let ((mark-list - (function - ;; Mark a list with 3 properties: `list-item' which is - ;; position at beginning of line, `list-struct' which is - ;; list structure, and `list-prevs' which is the alist of - ;; item and its predecessor. Leave point at list ending. - (lambda (ctxt) - (let* ((struct (org-list-struct)) - (top (org-list-get-top-point struct)) - (bottom (org-list-get-bottom-point struct)) - (prevs (org-list-prevs-alist struct)) - poi) - ;; Get every item and ending position, without dups and - ;; without bottom point of list. - (mapc (lambda (e) - (let ((pos (car e)) - (end (nth 6 e))) - (unless (memq pos poi) - (push pos poi)) - (unless (or (= end bottom) (memq end poi)) - (push end poi)))) - struct) - (setq poi (sort poi '<)) - ;; For every point of interest, mark the whole line with - ;; its position in list. - (mapc - (lambda (e) - (goto-char e) - (add-text-properties (point-at-bol) (point-at-eol) - (list 'list-item (point-at-bol) - 'list-struct struct - 'list-prevs prevs))) - poi) - ;; Take care of bottom point. As babel may have inserted - ;; a new list in buffer, list ending isn't always - ;; marked. Now mark every list ending and add properties - ;; useful to line processing exporters. - (goto-char bottom) - (when (or (looking-at "^ORG-LIST-END-MARKER\n") - (and (not (looking-at "[ \t]*$")) - (looking-at org-list-end-re))) - (replace-match "")) - (unless (bolp) (insert "\n")) - (insert - (org-add-props "ORG-LIST-END-MARKER\n" (list 'list-item bottom - 'list-struct struct - 'list-prevs prevs))) - ;; Following property is used by LaTeX exporter. - (add-text-properties top (point) (list 'list-context ctxt))))))) - ;; Mark lists except for backends not interpreting them. - (unless (eq org-export-current-backend 'ascii) - (let ((org-list-end-re "^ORG-LIST-END-MARKER\n")) - (mapc - (lambda (e) - (goto-char (point-min)) - (while (re-search-forward (org-item-beginning-re) nil t) - (let ((context (nth 2 (org-list-context)))) - (if (eq context e) - (funcall mark-list e) - (put-text-property (point-at-bol) (point-at-eol) - 'list-context context))))) - (cons nil org-list-export-context)))))) - -(defun org-export-attach-captions-and-attributes (target-alist) - "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties. -If the next thing following is a table, add the text properties to the first -table line. If it is a link, add it to the line containing the link." - (goto-char (point-min)) - (remove-text-properties (point-min) (point-max) - '(org-caption nil org-attributes nil)) - (let ((case-fold-search t) - (re (concat "^[ \t]*#\\+caption:[ \t]+\\(.*\\)" - "\\|" - "^[ \t]*#\\+attr_" (symbol-name org-export-current-backend) ":[ \t]+\\(.*\\)" - "\\|" - "^[ \t]*#\\+label:[ \t]+\\(.*\\)" - "\\|" - "^[ \t]*\\(|[^-]\\)" - "\\|" - "^[ \t]*\\[\\[.*\\]\\][ \t]*$")) - cap shortn attr label end) - (while (re-search-forward re nil t) - (cond - ;; there is a caption - ((match-end 1) - (progn - (setq cap (concat cap (if cap " " "") (org-trim (match-string 1)))) - (when (string-match "\\[\\(.*\\)\\]{\\(.*\\)}" cap) - (setq shortn (match-string 1 cap) - cap (match-string 2 cap))) - (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) - ;; there is an attribute - ((match-end 2) - (progn - (setq attr (concat attr (if attr " " "") (org-trim (match-string 2)))) - (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) - ;; there is a label - ((match-end 3) - (progn - (setq label (org-trim (match-string 3))) - (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) - (t - (setq end (if (match-end 4) - (let ((ee (org-table-end))) - (prog1 (1- (marker-position ee)) (move-marker ee nil))) - (point-at-eol))) - (add-text-properties (point-at-bol) end - (list 'org-caption cap - 'org-caption-shortn shortn - 'org-attributes attr - 'org-label label)) - (if label (push (cons label label) target-alist)) - (goto-char end) - (setq cap nil shortn nil attr nil label nil))))) - target-alist) - -(defun org-export-remove-comment-blocks-and-subtrees () - "Remove the comment environment, and also commented subtrees." - (let ((re-commented (format org-heading-keyword-regexp-format - org-comment-string)) - case-fold-search) - ;; Remove comment environment - (goto-char (point-min)) - (setq case-fold-search t) - (while (re-search-forward - "^#\\+begin_comment[ \t]*\n[^\000]*?\n#\\+end_comment\\>.*" nil t) - (replace-match "" t t)) - ;; Remove subtrees that are commented - (goto-char (point-min)) - (setq case-fold-search nil) - (while (re-search-forward re-commented nil t) - (goto-char (match-beginning 0)) - (delete-region (point) (org-end-of-subtree t))))) - -(defun org-export-handle-comments (org-commentsp) - "Remove comments, or convert to backend-specific format. -ORG-COMMENTSP can be a format string for publishing comments. -When it is nil, all comments will be removed." - (let ((re "^[ \t]*#\\( \\|$\\)")) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (let ((pos (match-beginning 0)) - (end (progn (forward-line) (point)))) - (if (get-text-property pos 'org-protected) - (forward-line) - (if (not org-commentsp) (delete-region pos end) - (add-text-properties pos end '(org-protected t)) - (replace-match - (org-add-props - (format org-commentsp (buffer-substring (match-end 0) end)) - nil 'org-protected t) - t t))))) - ;; Hack attack: previous implementation also removed keywords at - ;; column 0. Brainlessly do it again. - (goto-char (point-min)) - (while (re-search-forward "^#\\+" nil t) - (unless (get-text-property (point-at-bol) 'org-protected) - (delete-region (point-at-bol) (progn (forward-line) (point))))))) - -(defun org-export-handle-metalines () - "Remove tables and source blocks metalines. -This function should only be called after all block processing -has taken place." - (let ((re "^[ \t]*#\\+\\(tbl\\(?:name\\|fm\\)\\|results\\(?:\\[[a-z0-9]+\\]\\)?\\|name\\):\\(.*\n?\\)") - (case-fold-search t) - pos) - (goto-char (point-min)) - (while (or (looking-at re) - (re-search-forward re nil t)) - (setq pos (match-beginning 0)) - (if (get-text-property (match-beginning 1) 'org-protected) - (goto-char (1+ pos)) - (goto-char (1+ pos)) - (replace-match "") - (goto-char (max (point-min) (1- pos))))))) - -(defun org-export-mark-radio-links () - "Find all matches for radio targets and turn them into internal links." - (let ((re-radio (and org-target-link-regexp - (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)")))) - (goto-char (point-min)) - (when re-radio - (while (re-search-forward re-radio nil t) - (unless - (save-match-data - (or (org-in-regexp org-bracket-link-regexp) - (org-in-regexp org-plain-link-re) - (org-in-regexp "<<[^<>]+>>"))) - (org-if-unprotected - (replace-match "\\1[[\\2]]"))))))) - -(defun org-store-forced-table-alignment () - "Find table lines which force alignment, store the results in properties." - (let (line cnt cookies) - (goto-char (point-min)) - (while (re-search-forward "|[ \t]*<\\([lrc]?[0-9]+\\|[lrc]\\)>[ \t]*|" - nil t) - ;; OK, this looks like a table line with an alignment cookie - (org-if-unprotected - (setq line (buffer-substring (point-at-bol) (point-at-eol))) - (when (and (org-at-table-p) - (org-table-cookie-line-p line)) - (setq cnt 0 cookies nil) - (mapc - (lambda (x) - (setq cnt (1+ cnt)) - (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" x) - (let ((align (and (match-end 1) - (downcase (match-string 1 x)))) - (width (and (match-end 2) - (string-to-number (match-string 2 x))))) - (push (cons cnt (list align width)) cookies)))) - (org-split-string line "[ \t]*|[ \t]*")) - (add-text-properties (org-table-begin) (org-table-end) - (list 'org-col-cookies cookies)))) - (goto-char (point-at-eol))))) - -(defun org-export-remove-special-table-lines () - "Remove tables lines that are used for internal purposes. -Also, store forced alignment information found in such lines." - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*|" nil t) - (org-if-unprotected-at (1- (point)) - (beginning-of-line 1) - (if (or (looking-at "[ \t]*| *[!_^] *|") - (not - (memq - nil - (mapcar - (lambda (f) - (or (and org-export-table-remove-empty-lines (= (length f) 0)) - (string-match - "\\`<\\([0-9]\\|[lrc]\\|[lrc][0-9]+\\)>\\'" f))) - (org-split-string ;; FIXME, can't we do without splitting??? - (buffer-substring (point-at-bol) (point-at-eol)) - "[ \t]*|[ \t]*"))))) - (delete-region (max (point-min) (1- (point-at-bol))) - (point-at-eol)) - (end-of-line 1))))) - -(defun org-export-protect-sub-super (s) - (save-match-data - (while (string-match "\\([^\\\\]\\)\\([_^]\\)" s) - (setq s (replace-match "\\1\\\\\\2" nil nil s))) - s)) - -(defun org-export-normalize-links () - "Convert all links to bracket links, and expand link abbreviations." - (let ((re-plain-link (concat "\\([^[<]\\)" org-plain-link-re)) - (re-angle-link (concat "\\([^[]\\)" org-angle-link-re)) - nodesc) - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-regexp nil t) - (put-text-property (match-beginning 0) (match-end 0) 'org-normalized-link t)) - (goto-char (point-min)) - (while (re-search-forward re-plain-link nil t) - (unless (get-text-property (match-beginning 0) 'org-normalized-link) - (goto-char (1- (match-end 0))) - (org-if-unprotected-at (1+ (match-beginning 0)) - (let* ((s (concat (match-string 1) - "[[" (match-string 2) ":" (match-string 3) - "][" (match-string 2) ":" (org-export-protect-sub-super - (match-string 3)) - "]]"))) - ;; added 'org-link face to links - (put-text-property 0 (length s) 'face 'org-link s) - (replace-match s t t))))) - (goto-char (point-min)) - (while (re-search-forward re-angle-link nil t) - (goto-char (1- (match-end 0))) - (org-if-unprotected - (let* ((s (concat (match-string 1) - "[[" (match-string 2) ":" (match-string 3) - "][" (match-string 2) ":" (org-export-protect-sub-super - (match-string 3)) - "]]"))) - (put-text-property 0 (length s) 'face 'org-link s) - (replace-match s t t)))) - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-regexp nil t) - (goto-char (1- (match-end 0))) - (setq nodesc (not (match-end 3))) - (org-if-unprotected - (let* ((xx (save-match-data - (org-translate-link - (org-link-expand-abbrev (match-string 1))))) - (s (concat - "[[" (org-add-props (copy-sequence xx) - nil 'org-protected t 'org-no-description nodesc) - "]" - (if (match-end 3) - (match-string 2) - (concat "[" (copy-sequence xx) - "]")) - "]"))) - (put-text-property 0 (length s) 'face 'org-link s) - (replace-match s t t)))))) - -(defun org-export-concatenate-multiline-links () - "Find multi-line links and put it all into a single line. -This is to make sure that the line-processing export backends -can work correctly." - (goto-char (point-min)) - (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t) - (org-if-unprotected-at (match-beginning 1) - (replace-match "\\1 \\3") - (goto-char (match-beginning 0))))) - -(defun org-export-concatenate-multiline-emphasis () - "Find multi-line emphasis and put it all into a single line. -This is to make sure that the line-processing export backends -can work correctly." - (goto-char (point-min)) - (while (re-search-forward org-emph-re nil t) - (if (and (not (= (char-after (match-beginning 3)) - (char-after (match-beginning 4)))) - (save-excursion (goto-char (match-beginning 0)) - (save-match-data - (and (not (org-at-table-p)) - (not (org-at-heading-p)))))) - (org-if-unprotected - (subst-char-in-region (match-beginning 0) (match-end 0) - ?\n ?\ t) - (goto-char (1- (match-end 0)))) - (goto-char (1+ (match-beginning 0)))))) - -(defun org-export-grab-title-from-buffer () - "Get a title for the current document, from looking at the buffer." - (let ((inhibit-read-only t)) - (save-excursion - (goto-char (point-min)) - (let ((end (if (looking-at org-outline-regexp) - (point) - (save-excursion (outline-next-heading) (point))))) - (when (re-search-forward "^[ \t]*[^|# \t\r\n].*\n" end t) - ;; Mark the line so that it will not be exported as normal text. - (unless (org-in-block-p org-list-forbidden-blocks) - (org-unmodified - (add-text-properties (match-beginning 0) (match-end 0) - (list :org-license-to-kill t)))) - ;; Return the title string - (org-trim (match-string 0))))))) - -(defun org-export-get-title-from-subtree () - "Return subtree title and exclude it from export." - (let ((rbeg (region-beginning)) (rend (region-end)) - (inhibit-read-only t) - (tags (plist-get (org-infile-export-plist) :tags)) - title) - (save-excursion - (goto-char rbeg) - (when (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)) - (when (plist-member org-export-opt-plist :tags) - (setq tags (or (plist-get org-export-opt-plist :tags) tags))) - ;; This is a subtree, we take the title from the first heading - (goto-char rbeg) - (looking-at org-todo-line-tags-regexp) - (setq title (if (and (eq tags t) (match-string 4)) - (format "%s\t%s" (match-string 3) (match-string 4)) - (match-string 3))) - (org-unmodified - (add-text-properties (point) (1+ (point-at-eol)) - (list :org-license-to-kill t))) - (setq title (or (org-entry-get nil "EXPORT_TITLE") title)))) - title)) - -(defun org-solidify-link-text (s &optional alist) - "Take link text and make a safe target out of it." - (save-match-data - (let* ((rtn - (mapconcat - 'identity - (org-split-string s "[^a-zA-Z0-9_\\.-]+") "-")) - (a (assoc rtn alist))) - (or (cdr a) rtn)))) - -(defun org-get-min-level (lines &optional offset) - "Get the minimum level in LINES." - (let ((re "^\\(\\*+\\) ") l) - (catch 'exit - (while (setq l (pop lines)) - (if (string-match re l) - (throw 'exit (org-tr-level (- (length (match-string 1 l)) - (or offset 0)))))) - 1))) - -;; Variable holding the vector with section numbers -(defvar org-section-numbers (make-vector org-level-max 0)) - -(defun org-init-section-numbers () - "Initialize the vector for the section numbers." - (let* ((level -1) - (numbers (nreverse (org-split-string "" "\\."))) - (depth (1- (length org-section-numbers))) - (i depth) number-string) - (while (>= i 0) - (if (> i level) - (aset org-section-numbers i 0) - (setq number-string (or (car numbers) "0")) - (if (string-match "\\`[A-Z]\\'" number-string) - (aset org-section-numbers i - (- (string-to-char number-string) ?A -1)) - (aset org-section-numbers i (string-to-number number-string))) - (pop numbers)) - (setq i (1- i))))) - -(defun org-section-number (&optional level) - "Return a string with the current section number. -When LEVEL is non-nil, increase section numbers on that level." - (let* ((depth (1- (length org-section-numbers))) - (string "") - (fmts (car org-export-section-number-format)) - (term (cdr org-export-section-number-format)) - (sep "") - ctype fmt idx n) - (when level - (when (> level -1) - (aset org-section-numbers - level (1+ (aref org-section-numbers level)))) - (setq idx (1+ level)) - (while (<= idx depth) - (if (not (= idx 1)) - (aset org-section-numbers idx 0)) - (setq idx (1+ idx)))) - (setq idx 0) - (while (<= idx depth) - (when (> (aref org-section-numbers idx) 0) - (setq fmt (or (pop fmts) fmt) - ctype (car fmt) - n (aref org-section-numbers idx) - string (if (> n 0) - (concat string sep (org-number-to-counter n ctype)) - (concat string ".0")) - sep (nth 1 fmt))) - (setq idx (1+ idx))) - (save-match-data - (if (string-match "\\`\\([@0]\\.\\)+" string) - (setq string (replace-match "" t nil string))) - (if (string-match "\\(\\.0\\)+\\'" string) - (setq string (replace-match "" t nil string)))) - (concat string term))) - -(defun org-number-to-counter (n type) - "Concert number N to a string counter, according to TYPE. -TYPE must be a string, any of: - 1 number - A A,B,.... - a a,b,.... - I upper case roman numeral - i lower case roman numeral" - (cond - ((equal type "1") (number-to-string n)) - ((equal type "A") (char-to-string (+ ?A n -1))) - ((equal type "a") (char-to-string (+ ?a n -1))) - ((equal type "I") (org-number-to-roman n)) - ((equal type "i") (downcase (org-number-to-roman n))) - (t (error "Invalid counter type `%s'" type)))) - -(defun org-number-to-roman (n) - "Convert integer N into a roman numeral." - (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD") - ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL") - ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV") - ( 1 . "I"))) - (res "")) - (if (<= n 0) - (number-to-string n) - (while roman - (if (>= n (caar roman)) - (setq n (- n (caar roman)) - res (concat res (cdar roman))) - (pop roman))) - res))) - -;;; Macros - -(defun org-export-preprocess-apply-macros () - "Replace macro references." - (goto-char (point-min)) - (let (sy val key args args2 ind-str s n) - (while (re-search-forward - "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}" - nil t) - (unless (save-match-data (save-excursion - (goto-char (point-at-bol)) - (looking-at "[ \t]*#\\+macro"))) - ;; Get macro name (KEY), arguments (ARGS), and indentation of - ;; current line (IND-STR) as strings. - (setq key (downcase (match-string 1)) - args (match-string 3) - ind-str (save-match-data (save-excursion - (beginning-of-line) - (looking-at "^\\([ \t]*\\).*") - (match-string 1)))) - ;; When macro is defined, retrieve replacement text in VAL, - ;; and proceed with expansion. - (when (setq val (or (plist-get org-export-opt-plist - (intern (concat ":macro-" key))) - (plist-get org-export-opt-plist - (intern (concat ":" key))))) - (save-match-data - ;; If arguments are provided, first retrieve them properly - ;; (in ARGS, as a list), then replace them in VAL. - (when args - (setq args (org-split-string args ",") args2 nil) - (while args - (while (string-match "\\\\\\'" (car args)) - ;; Repair bad splits. - (setcar (cdr args) (concat (substring (car args) 0 -1) - "," (nth 1 args))) - (pop args)) - (push (pop args) args2)) - (setq args (mapcar 'org-trim (nreverse args2))) - (setq s 0) - (while (string-match "\\$\\([0-9]+\\)" val s) - (setq s (1+ (match-beginning 0)) - n (string-to-number (match-string 1 val))) - (and (>= (length args) n) - (setq val (replace-match (nth (1- n) args) t t val))))) - ;; VAL starts with "(eval": it is a sexp, `eval' it. - (when (string-match "\\`(eval\\>" val) - (setq val (eval (read val)))) - ;; Ensure VAL is a string (or nil) and that each new line - ;; is indented as the first one. - (setq val (and val - (mapconcat 'identity - (org-split-string - (if (stringp val) val (format "%s" val)) - "\n") - (concat "\n" ind-str))))) - ;; Eventually do the replacement, if VAL isn't nil. Move - ;; point at beginning of macro for recursive expansions. - (when val - (replace-match val t t) - (goto-char (match-beginning 0)))))))) - -(defun org-export-apply-macros-in-string (s) - "Apply the macros in string S." - (when s - (with-temp-buffer - (insert s) - (org-export-preprocess-apply-macros) - (buffer-string)))) - -;;; Include files - -(defun org-export-handle-include-files () - "Include the contents of include files, with proper formatting." - (let ((case-fold-search t) - params file markup lang start end prefix prefix1 switches all minlevel currentlevel addlevel lines) - (goto-char (point-min)) - (while (re-search-forward "^#\\+include:[ \t]+\\(.*\\)" nil t) - (setq params (read (concat "(" (match-string 1) ")")) - prefix (org-get-and-remove-property 'params :prefix) - prefix1 (org-get-and-remove-property 'params :prefix1) - minlevel (org-get-and-remove-property 'params :minlevel) - addlevel (org-get-and-remove-property 'params :addlevel) - lines (org-get-and-remove-property 'params :lines) - file (org-symname-or-string (pop params)) - markup (org-symname-or-string (pop params)) - lang (and (member markup '("src" "SRC")) - (org-symname-or-string (pop params))) - switches (mapconcat #'(lambda (x) (format "%s" x)) params " ") - start nil end nil) - (delete-region (match-beginning 0) (match-end 0)) - (setq currentlevel (or (org-current-level) 0)) - (if (or (not file) - (not (file-exists-p file)) - (not (file-readable-p file))) - (insert (format "CANNOT INCLUDE FILE %s" file)) - (setq all (cons file all)) - (when markup - (if (equal (downcase markup) "src") - (setq start (format "#+begin_src %s %s\n" - (or lang "fundamental") - (or switches "")) - end "#+end_src") - (setq start (format "#+begin_%s %s\n" markup switches) - end (format "#+end_%s" markup)))) - (insert (or start "")) - (insert (org-get-file-contents (expand-file-name file) - prefix prefix1 markup currentlevel minlevel addlevel lines)) - (or (bolp) (newline)) - (insert (or end "")))) - all)) - -(defun org-export-handle-include-files-recurse () - "Recursively include files aborting on circular inclusion." - (let ((now (list org-current-export-file)) all) - (while now - (setq all (append now all)) - (setq now (org-export-handle-include-files)) - (let ((intersection - (delq nil - (mapcar (lambda (el) (when (member el all) el)) now)))) - (when intersection - (error "Recursive #+INCLUDE: %S" intersection)))))) - -(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel parentlevel addlevel lines) - "Get the contents of FILE and return them as a string. -If PREFIX is a string, prepend it to each line. If PREFIX1 -is a string, prepend it to the first line instead of PREFIX. -If MARKUP, don't protect org-like lines, the exporter will -take care of the block they are in. If ADDLEVEL is a number, -demote included file to current heading level+ADDLEVEL. -If LINES is a string specifying a range of lines, -include only those lines." - (if (stringp markup) (setq markup (downcase markup))) - (with-temp-buffer - (insert-file-contents file) - (when lines - (let* ((lines (split-string lines "-")) - (lbeg (string-to-number (car lines))) - (lend (string-to-number (cadr lines))) - (beg (if (zerop lbeg) (point-min) - (goto-char (point-min)) - (forward-line (1- lbeg)) - (point))) - (end (if (zerop lend) (point-max) - (goto-char (point-min)) - (forward-line (1- lend)) - (point)))) - (narrow-to-region beg end))) - (when (or prefix prefix1) - (goto-char (point-min)) - (while (not (eobp)) - (insert (or prefix1 prefix)) - (setq prefix1 "") - (beginning-of-line 2))) - (buffer-string) - (when (member markup '("src" "example")) - (goto-char (point-min)) - (while (re-search-forward "^\\([*#]\\|[ \t]*#\\+\\)" nil t) - (goto-char (match-beginning 0)) - (insert ",") - (end-of-line 1))) - (when minlevel - (dotimes (lvl minlevel) - (org-map-region 'org-demote (point-min) (point-max)))) - (when addlevel - (let ((inclevel (or (if (org-before-first-heading-p) - (1- (and (outline-next-heading) - (org-current-level))) - (1- (org-current-level))) - 0))) - (dotimes (level (- (+ parentlevel addlevel) inclevel)) - (org-map-region 'org-demote (point-min) (point-max))))) - (buffer-string))) - -(defun org-get-and-remove-property (listvar prop) - "Check if the value of LISTVAR contains PROP as a property. -If yes, return the value of that property (i.e. the element following -in the list) and remove property and value from the list in LISTVAR." - (let ((list (symbol-value listvar)) m v) - (when (setq m (member prop list)) - (setq v (nth 1 m)) - (if (equal (car list) prop) - (set listvar (cddr list)) - (setcdr (nthcdr (- (length list) (length m) 1) list) - (cddr m)) - (set listvar list))) - v)) - -(defun org-symname-or-string (s) - (if (symbolp s) - (if s (symbol-name s) s) - s)) - -;;; Fontification and line numbers for code examples - -(defvar org-export-last-code-line-counter-value 0) - -(defun org-export-replace-src-segments-and-examples () - "Replace source code segments with special code for export." - (setq org-export-last-code-line-counter-value 0) - (let ((case-fold-search t) - lang code trans opts indent caption) - (goto-char (point-min)) - (while (re-search-forward - "\\(^\\([ \t]*\\)#\\+BEGIN_SRC:?\\([ \t]+\\([^ \t\n]+\\)\\)?\\(.*\\)\n\\([^\000]+?\n\\)[ \t]*#\\+END_SRC.*\n?\\)\\|\\(^\\([ \t]*\\)#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)[ \t]*#\\+END_EXAMPLE.*\n?\\)" - nil t) - (if (match-end 1) - (if (not (match-string 4)) - (error "Source block missing language specification: %s" - (let* ((body (match-string 6)) - (nothing (message "body:%s" body)) - (preview (or (and (string-match - "^[ \t]*\\([^\n\r]*\\)" body) - (match-string 1 body)) body))) - (if (> (length preview) 35) - (concat (substring preview 0 32) "...") - preview))) - ;; src segments - (setq lang (match-string 4) - opts (match-string 5) - code (match-string 6) - indent (length (match-string 2)) - caption (get-text-property 0 'org-caption (match-string 0)))) - (setq lang nil - opts (match-string 9) - code (match-string 10) - indent (length (match-string 8)) - caption (get-text-property 0 'org-caption (match-string 0)))) - - (setq trans (org-export-format-source-code-or-example - lang code opts indent caption)) - (replace-match trans t t)))) - -(defvar org-export-latex-verbatim-wrap) ;; defined in org-latex.el -(defvar org-export-latex-listings) ;; defined in org-latex.el -(defvar org-export-latex-listings-langs) ;; defined in org-latex.el -(defvar org-export-latex-listings-w-names) ;; defined in org-latex.el -(defvar org-export-latex-minted-langs) ;; defined in org-latex.el -(defvar org-export-latex-custom-lang-environments) ;; defined in org-latex.el -(defvar org-export-latex-listings-options) ;; defined in org-latex.el -(defvar org-export-latex-minted-options) ;; defined in org-latex.el - -(defun org-remove-formatting-on-newlines-in-region (beg end) - "Remove formatting on newline characters." - (interactive "r") - (save-excursion - (goto-char beg) - (while (progn (end-of-line) (< (point) end)) - (put-text-property (point) (1+ (point)) 'face nil) - (forward-char 1)))) - -(defun org-export-format-source-code-or-example - (lang code &optional opts indent caption) - "Format CODE from language LANG and return it formatted for export. -The CODE is marked up in `org-export-current-backend' format. - -Check if a function by name -\"org--format-source-code-or-example\" is bound. If yes, -use it as the custom formatter. Otherwise, use the default -formatter. Default formatters are provided for docbook, html, -latex and ascii backends. For example, use -`org-html-format-source-code-or-example' to provide a custom -formatter for export to \"html\". - -If LANG is nil, do not add any fontification. -OPTS contains formatting options, like `-n' for triggering numbering lines, -and `+n' for continuing previous numbering. -Code formatting according to language currently only works for HTML. -Numbering lines works for all three major backends (html, latex, and ascii). -INDENT was the original indentation of the block." - (save-match-data - (let* ((backend-name (symbol-name org-export-current-backend)) - (backend-formatter - (intern (format "org-%s-format-source-code-or-example" - backend-name))) - (backend-feature (intern (concat "org-" backend-name))) - (backend-formatter - (and (require (intern (concat "org-" backend-name)) nil) - (fboundp backend-formatter) backend-formatter)) - num cont rtn rpllbl keepp textareap preserve-indentp cols rows fmt) - (setq opts (or opts "") - num (string-match "[-+]n\\>" opts) - cont (string-match "\\+n\\>" opts) - rpllbl (string-match "-r\\>" opts) - keepp (string-match "-k\\>" opts) - textareap (string-match "-t\\>" opts) - preserve-indentp (or org-src-preserve-indentation - (string-match "-i\\>" opts)) - cols (if (string-match "-w[ \t]+\\([0-9]+\\)" opts) - (string-to-number (match-string 1 opts)) - 80) - rows (if (string-match "-h[ \t]+\\([0-9]+\\)" opts) - (string-to-number (match-string 1 opts)) - (org-count-lines code)) - fmt (if (string-match "-l[ \t]+\"\\([^\"\n]+\\)\"" opts) - (match-string 1 opts))) - (when (and textareap (eq org-export-current-backend 'html)) - ;; we cannot use numbering or highlighting. - (setq num nil cont nil lang nil)) - (if keepp (setq rpllbl 'keep)) - (setq rtn (if preserve-indentp code (org-remove-indentation code))) - (when (string-match "^," rtn) - (setq rtn (with-temp-buffer - (insert rtn) - ;; Free up the protected lines - (goto-char (point-min)) - (while (re-search-forward "^," nil t) - (if (or (equal lang "org") - (save-match-data - (looking-at "\\([*#]\\|[ \t]*#\\+\\)"))) - (replace-match "")) - (end-of-line 1)) - (buffer-string)))) - ;; Now backend-specific coding - (setq rtn - (cond - (backend-formatter - (funcall backend-formatter rtn lang caption textareap cols rows num - cont rpllbl fmt)) - ((eq org-export-current-backend 'docbook) - (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) - (concat "\n")) - ((eq org-export-current-backend 'html) - ;; We are exporting to HTML - (when lang - (if (featurep 'xemacs) - (require 'htmlize) - (require 'htmlize nil t)) - (when (not (fboundp 'htmlize-region-for-paste)) - ;; we do not have htmlize.el, or an old version of it - (setq lang nil) - (message - "htmlize.el 1.34 or later is needed for source code formatting"))) - - (if lang - (let* ((lang-m (when lang - (or (cdr (assoc lang org-src-lang-modes)) - lang))) - (mode (and lang-m (intern - (concat - (if (symbolp lang-m) - (symbol-name lang-m) - lang-m) - "-mode")))) - (org-inhibit-startup t) - (org-startup-folded nil)) - (setq rtn - (with-temp-buffer - (insert rtn) - (if (functionp mode) - (funcall mode) - (fundamental-mode)) - (font-lock-fontify-buffer) - ;; markup each line separately - (org-remove-formatting-on-newlines-in-region (point-min) (point-max)) - (org-src-mode) - (set-buffer-modified-p nil) - (org-export-htmlize-region-for-paste - (point-min) (point-max)))) - (if (string-match "]*\\)>\n*" rtn) - (setq rtn - (concat - (if caption - (concat - "
    " - (format - "" - caption)) - "") - (replace-match - (format "
    \n" lang)
    -                                t t rtn)
    -                               (if caption "
    " ""))))) - (if textareap - (setq rtn (concat - (format "

    \n\n

    \n")) - (with-temp-buffer - (insert rtn) - (goto-char (point-min)) - (while (re-search-forward "[<>&]" nil t) - (replace-match (cdr (assq (char-before) - '((?&."&")(?<."<")(?>.">")))) - t t)) - (setq rtn (buffer-string))) - (setq rtn (concat "
    \n" rtn "
    \n")))) - (unless textareap - (setq rtn (org-export-number-lines rtn 1 1 num cont rpllbl fmt))) - (if (string-match "\\(\\`<[^>]*>\\)\n" rtn) - (setq rtn (replace-match "\\1" t nil rtn))) - rtn) - ((eq org-export-current-backend 'latex) - (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) - (cond - ((and lang org-export-latex-listings) - (let* ((make-option-string - (lambda (pair) - (concat (first pair) - (if (> (length (second pair)) 0) - (concat "=" (second pair)))))) - (lang-sym (intern lang)) - (minted-p (eq org-export-latex-listings 'minted)) - (listings-p (not minted-p)) - (backend-lang - (or (cadr - (assq - lang-sym - (cond - (minted-p org-export-latex-minted-langs) - (listings-p org-export-latex-listings-langs)))) - lang)) - (custom-environment - (cadr - (assq - lang-sym - org-export-latex-custom-lang-environments)))) - (concat - (when (and listings-p (not custom-environment)) - (format - "\\lstset{%s}\n" - (mapconcat - make-option-string - (append org-export-latex-listings-options - `(("language" ,backend-lang))) ","))) - (when (and caption org-export-latex-listings-w-names) - (format - "\n%s $\\equiv$ \n" - (replace-regexp-in-string "_" "\\\\_" caption))) - (cond - (custom-environment - (format "\\begin{%s}\n%s\\end{%s}\n" - custom-environment rtn custom-environment)) - (listings-p - (format "\\begin{%s}\n%s\\end{%s}" - "lstlisting" rtn "lstlisting")) - (minted-p - (format - "\\begin{minted}[%s]{%s}\n%s\\end{minted}" - (mapconcat make-option-string - org-export-latex-minted-options ",") - backend-lang rtn)))))) - (t (concat (car org-export-latex-verbatim-wrap) - rtn (cdr org-export-latex-verbatim-wrap))))) - ((eq org-export-current-backend 'ascii) - ;; This is not HTML or LaTeX, so just make it an example. - (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) - (concat caption "\n" - (concat - (mapconcat - (lambda (l) (concat " " l)) - (org-split-string rtn "\n") - "\n") - "\n"))) - (t - (error "Don't know how to markup source or example block in %s" - (upcase backend-name))))) - (setq rtn - (concat - "\n#+BEGIN_" backend-name "\n" - (org-add-props rtn - '(org-protected t org-example t org-native-text t)) - "\n#+END_" backend-name "\n")) - (org-add-props rtn nil 'original-indentation indent)))) - -(defun org-export-number-lines (text &optional skip1 skip2 number cont - replace-labels label-format preprocess) - "Apply line numbers to literal examples and handle code references. -Handle user-specified options under info node `(org)Literal -examples' and return the modified source block. - -TEXT contains the source or example block. - -SKIP1 and SKIP2 are the number of lines that are to be skipped at -the beginning and end of TEXT. Use these to skip over -backend-specific lines pre-pended or appended to the original -source block. - -NUMBER is non-nil if the literal example specifies \"+n\" or -\"-n\" switch. If NUMBER is non-nil add line numbers. - -CONT is non-nil if the literal example specifies \"+n\" switch. -If CONT is nil, start numbering this block from 1. Otherwise -continue numbering from the last numbered block. - -REPLACE-LABELS is dual-purpose. -1. It controls the retention of labels in the exported block. -2. It specifies in what manner the links (or references) to a - labeled line be formatted. - -REPLACE-LABELS is the symbol `keep' if the literal example -specifies \"-k\" option, is numeric if the literal example -specifies \"-r\" option and is nil otherwise. - -Handle REPLACE-LABELS as below: -- If nil, retain labels in the exported block and use - user-provided labels for referencing the labeled lines. -- If it is a number, remove labels in the exported block and use - one of line numbers or labels for referencing labeled lines based - on NUMBER option. -- If it is a keep, retain labels in the exported block and use - one of line numbers or labels for referencing labeled lines - based on NUMBER option. - -LABEL-FORMAT is the value of \"-l\" switch associated with -literal example. See `org-coderef-label-format'. - -PREPROCESS is intended for backend-agnostic handling of source -block numbering. When non-nil do the following: -- do not number the lines -- always strip the labels from exported block -- do not make the labeled line a target of an incoming link. - Instead mark the labeled line with `org-coderef' property and - store the label in it." - (setq skip1 (or skip1 0) skip2 (or skip2 0)) - (if (and number (not cont)) (setq org-export-last-code-line-counter-value 0)) - (with-temp-buffer - (insert text) - (goto-char (point-max)) - (skip-chars-backward " \t\n\r") - (delete-region (point) (point-max)) - (beginning-of-line (- 1 skip2)) - (let* ((last (org-current-line)) - (n org-export-last-code-line-counter-value) - (nmax (+ n (- last skip1))) - (fmt (format "%%%dd: " (length (number-to-string nmax)))) - (fm - (cond - ((eq org-export-current-backend 'html) (format "%s" - fmt)) - ((eq org-export-current-backend 'ascii) fmt) - ((eq org-export-current-backend 'latex) fmt) - ((eq org-export-current-backend 'docbook) fmt) - (t ""))) - (label-format (or label-format org-coderef-label-format)) - (label-pre (if (string-match "%s" label-format) - (substring label-format 0 (match-beginning 0)) - label-format)) - (label-post (if (string-match "%s" label-format) - (substring label-format (match-end 0)) - "")) - (lbl-re - (concat - ".*?\\S-.*?\\([ \t]*\\(" - (regexp-quote label-pre) - "\\([-a-zA-Z0-9_ ]+\\)" - (regexp-quote label-post) - "\\)\\)")) - ref) - - (org-goto-line (1+ skip1)) - (while (and (re-search-forward "^" nil t) (not (eobp)) (< n nmax)) - (when number (incf n)) - (if (or preprocess (not number)) - (forward-char 1) - (insert (format fm n))) - (when (looking-at lbl-re) - (setq ref (match-string 3)) - (cond ((numberp replace-labels) - ;; remove labels; use numbers for references when lines - ;; are numbered, use labels otherwise - (delete-region (match-beginning 1) (match-end 1)) - (push (cons ref (if (> n 0) n ref)) org-export-code-refs)) - ((eq replace-labels 'keep) - ;; don't remove labels; use numbers for references when - ;; lines are numbered, use labels otherwise - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 2)) - (unless preprocess - (insert "(" ref ")")) - (push (cons ref (if (> n 0) n (concat "(" ref ")"))) - org-export-code-refs)) - (t - ;; don't remove labels and don't use numbers for - ;; references - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 2)) - (unless preprocess - (insert "(" ref ")")) - (push (cons ref (concat "(" ref ")")) org-export-code-refs))) - (when (and (eq org-export-current-backend 'html) (not preprocess)) - (save-excursion - (beginning-of-line 1) - (insert (format "" - ref)) - (end-of-line 1) - (insert ""))) - (when preprocess - (add-text-properties - (point-at-bol) (point-at-eol) (list 'org-coderef ref))))) - (setq org-export-last-code-line-counter-value n) - (goto-char (point-max)) - (newline) - (buffer-string)))) - -(defun org-search-todo-below (line lines level) - "Search the subtree below LINE for any TODO entries." - (let ((rest (cdr (memq line lines))) - (re org-todo-line-regexp) - line lv todo) - (catch 'exit - (while (setq line (pop rest)) - (if (string-match re line) - (progn - (setq lv (- (match-end 1) (match-beginning 1)) - todo (and (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords)))) - ; TODO, not DONE - (if (<= lv level) (throw 'exit nil)) - (if todo (throw 'exit t)))))))) - -;;;###autoload -(defun org-export-visible (type arg) - "Create a copy of the visible part of the current buffer, and export it. -The copy is created in a temporary buffer and removed after use. -TYPE is the final key (as a string) that also selects the export command in -the \\\\[org-export] export dispatcher. -As a special case, if the you type SPC at the prompt, the temporary -org-mode file will not be removed but presented to you so that you can -continue to use it. The prefix arg ARG is passed through to the exporting -command." - (interactive - (list (progn - (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]buffer with HTML [D]ocBook [l]atex [p]df [d]view pdf [L]atex buffer [x]OXO [ ]keep buffer") - (read-char-exclusive)) - current-prefix-arg)) - (if (not (member type '(?a ?n ?u ?\C-a ?b ?\C-b ?h ?D ?x ?\ ?l ?p ?d ?L ?H ?R))) - (error "Invalid export key")) - (let* ((binding (cdr (assoc type - '( - (?a . org-export-as-ascii) - (?A . org-export-as-ascii-to-buffer) - (?n . org-export-as-latin1) - (?N . org-export-as-latin1-to-buffer) - (?u . org-export-as-utf8) - (?U . org-export-as-utf8-to-buffer) - (?\C-a . org-export-as-ascii) - (?b . org-export-as-html-and-open) - (?\C-b . org-export-as-html-and-open) - (?h . org-export-as-html) - (?H . org-export-as-html-to-buffer) - (?R . org-export-region-as-html) - (?D . org-export-as-docbook) - - (?l . org-export-as-latex) - (?p . org-export-as-pdf) - (?d . org-export-as-pdf-and-open) - (?L . org-export-as-latex-to-buffer) - - (?x . org-export-as-xoxo))))) - (keepp (equal type ?\ )) - (file buffer-file-name) - (buffer (get-buffer-create "*Org Export Visible*")) - s e) - ;; Need to hack the drawers here. - (save-excursion - (goto-char (point-min)) - (while (re-search-forward org-drawer-regexp nil t) - (goto-char (match-beginning 1)) - (or (outline-invisible-p) (org-flag-drawer nil)))) - (with-current-buffer buffer (erase-buffer)) - (save-excursion - (setq s (goto-char (point-min))) - (while (not (= (point) (point-max))) - (goto-char (org-find-invisible)) - (append-to-buffer buffer s (point)) - (setq s (goto-char (org-find-visible)))) - (org-cycle-hide-drawers 'all) - (goto-char (point-min)) - (unless keepp - ;; Copy all comment lines to the end, to make sure #+ settings are - ;; still available for the second export step. Kind of a hack, but - ;; does do the trick. - (if (looking-at "#[^\r\n]*") - (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0)))) - (when (re-search-forward "^\\*+[ \t]+" nil t) - (while (re-search-backward "[\n\r]#[^\n\r]*" nil t) - (append-to-buffer buffer (1+ (match-beginning 0)) - (min (point-max) (1+ (match-end 0))))))) - (set-buffer buffer) - (let ((buffer-file-name file) - (org-inhibit-startup t)) - (org-mode) - (show-all) - (unless keepp (funcall binding arg)))) - (if (not keepp) - (kill-buffer buffer) - (switch-to-buffer-other-window buffer) - (goto-char (point-min))))) - -(defvar org-export-htmlized-org-css-url) ;; defined in org-html.el - -(defun org-export-string (string fmt &optional dir) - "Export STRING to FMT using existing export facilities. -During export STRING is saved to a temporary file whose location -could vary. Optional argument DIR can be used to force the -directory in which the temporary file is created during export -which can be useful for resolving relative paths. Dir defaults -to the value of `temporary-file-directory'." - (let ((temporary-file-directory (or dir temporary-file-directory)) - (tmp-file (make-temp-file "org-"))) - (unwind-protect - (with-temp-buffer - (insert string) - (write-file tmp-file) - (org-load-modules-maybe) - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - (eval ;; convert to fmt -- mimicking `org-run-like-in-org-mode' - (list 'let org-local-vars - (list (intern (format "org-export-as-%s" fmt)) - nil nil ''string t dir)))) - (delete-file tmp-file)))) - -;;;###autoload -(defun org-export-as-org (arg &optional ext-plist to-buffer body-only pub-dir) - "Make a copy with not-exporting stuff removed. -The purpose of this function is to provide a way to export the source -Org file of a webpage in Org format, but with sensitive and/or irrelevant -stuff removed. This command will remove the following: - -- archived trees (if the variable `org-export-with-archived-trees' is nil) -- comment blocks and trees starting with the COMMENT keyword -- only trees that are consistent with `org-export-select-tags' - and `org-export-exclude-tags'. - -The only arguments that will be used are EXT-PLIST and PUB-DIR, -all the others will be ignored (but are present so that the general -mechanism to call publishing functions will work). - -EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local -settings. When PUB-DIR is set, use this as the publishing -directory." - (interactive "P") - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist))) - (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) - (filename (concat (file-name-as-directory - (or pub-dir - (org-export-directory :org opt-plist))) - (file-name-sans-extension - (file-name-nondirectory bfname)) - ".org")) - (filename (and filename - (if (equal (file-truename filename) - (file-truename bfname)) - (concat (file-name-sans-extension filename) - "-source." - (file-name-extension filename)) - filename))) - (backup-inhibited t) - (buffer (find-file-noselect filename)) - (region (buffer-string)) - str-ret) - (save-excursion - (org-pop-to-buffer-same-window buffer) - (erase-buffer) - (insert region) - (let ((org-inhibit-startup t)) (org-mode)) - (org-install-letbind) - - ;; Get rid of archived trees - (org-export-remove-archived-trees (plist-get opt-plist :archived-trees)) - - ;; Remove comment environment and comment subtrees - (org-export-remove-comment-blocks-and-subtrees) - - ;; Get rid of excluded trees - (org-export-handle-export-tags (plist-get opt-plist :select-tags) - (plist-get opt-plist :exclude-tags)) - - (when (or (plist-get opt-plist :plain-source) - (not (or (plist-get opt-plist :plain-source) - (plist-get opt-plist :htmlized-source)))) - ;; Either nothing special is requested (default call) - ;; or the plain source is explicitly requested - ;; so: save it - (save-buffer)) - (when (plist-get opt-plist :htmlized-source) - ;; Make the htmlized version - (require 'htmlize) - (require 'org-html) - (font-lock-fontify-buffer) - (let* ((htmlize-output-type 'css) - (newbuf (htmlize-buffer))) - (with-current-buffer newbuf - (when org-export-htmlized-org-css-url - (goto-char (point-min)) - (and (re-search-forward - ".*" - nil t) - (replace-match - (format - "" - org-export-htmlized-org-css-url) - t t))) - (write-file (concat filename ".html"))) - (kill-buffer newbuf))) - (set-buffer-modified-p nil) - (if (equal to-buffer 'string) - (progn (setq str-ret (buffer-string)) - (kill-buffer (current-buffer)) - str-ret) - (kill-buffer (current-buffer)))))) - -(defvar org-archive-location) ;; gets loaded with the org-archive require. -(defun org-get-current-options () - "Return a string with current options as keyword options. -Does include HTML export options as well as TODO and CATEGORY stuff." - (require 'org-archive) - (format - "#+TITLE: %s -#+AUTHOR: %s -#+EMAIL: %s -#+DATE: %s -#+DESCRIPTION: -#+KEYWORDS: -#+LANGUAGE: %s -#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s <:%s -#+OPTIONS: TeX:%s LaTeX:%s skip:%s d:%s todo:%s pri:%s tags:%s -%s -#+EXPORT_SELECT_TAGS: %s -#+EXPORT_EXCLUDE_TAGS: %s -#+LINK_UP: %s -#+LINK_HOME: %s -#+XSLT: -#+CATEGORY: %s -#+SEQ_TODO: %s -#+TYP_TODO: %s -#+PRIORITIES: %c %c %c -#+DRAWERS: %s -#+STARTUP: %s %s %s %s %s -#+TAGS: %s -#+FILETAGS: %s -#+ARCHIVE: %s -#+LINK: %s -" - (buffer-name) (user-full-name) user-mail-address - (format-time-string (substring (car org-time-stamp-formats) 1 -1)) - org-export-default-language - org-export-headline-levels - org-export-with-section-numbers - org-export-with-toc - org-export-preserve-breaks - org-export-html-expand - org-export-with-fixed-width - org-export-with-tables - org-export-with-sub-superscripts - org-export-with-special-strings - org-export-with-footnotes - org-export-with-emphasize - org-export-with-timestamps - org-export-with-TeX-macros - org-export-with-LaTeX-fragments - org-export-skip-text-before-1st-heading - org-export-with-drawers - org-export-with-todo-keywords - org-export-with-priority - org-export-with-tags - (if (featurep 'org-jsinfo) (org-infojs-options-inbuffer-template) "") - (mapconcat 'identity org-export-select-tags " ") - (mapconcat 'identity org-export-exclude-tags " ") - org-export-html-link-up - org-export-html-link-home - (or (ignore-errors - (file-name-sans-extension - (file-name-nondirectory (buffer-file-name (buffer-base-buffer))))) - "NOFILENAME") - "TODO FEEDBACK VERIFY DONE" - "Me Jason Marie DONE" - org-highest-priority org-lowest-priority org-default-priority - (mapconcat 'identity org-drawers " ") - (cdr (assoc org-startup-folded - '((nil . "showall") (t . "overview") (content . "content")))) - (if org-odd-levels-only "odd" "oddeven") - (if org-hide-leading-stars "hidestars" "showstars") - (if org-startup-align-all-tables "align" "noalign") - (cond ((eq org-log-done t) "logdone") - ((equal org-log-done 'note) "lognotedone") - ((not org-log-done) "nologdone")) - (or (mapconcat (lambda (x) - (cond - ((equal :startgroup (car x)) "{") - ((equal :endgroup (car x)) "}") - ((equal :newline (car x)) "") - ((cdr x) (format "%s(%c)" (car x) (cdr x))) - (t (car x)))) - (or org-tag-alist (org-get-buffer-tags)) " ") "") - (mapconcat 'identity org-file-tags " ") - org-archive-location - "org file:~/org/%s.org")) - -(defun org-insert-export-options-template () - "Insert into the buffer a template with information for exporting." - (interactive) - (if (not (bolp)) (newline)) - (let ((s (org-get-current-options))) - (and (string-match "#\\+CATEGORY" s) - (setq s (substring s 0 (match-beginning 0)))) - (insert s))) - -(defvar org-table-colgroup-info nil) - -(defun org-table-clean-before-export (lines &optional maybe-quoted) - "Check if the table has a marking column. -If yes remove the column and the special lines." - (setq org-table-colgroup-info nil) - (if (memq nil - (mapcar - (lambda (x) (or (string-match "^[ \t]*|-" x) - (string-match - (if maybe-quoted - "^[ \t]*| *\\\\?\\([\#!$*_^ /]\\) *|" - "^[ \t]*| *\\([\#!$*_^ /]\\) *|") - x))) - lines)) - ;; No special marking column - (progn - (setq org-table-clean-did-remove-column nil) - (delq nil - (mapcar - (lambda (x) - (cond - ((org-table-colgroup-line-p x) - ;; This line contains colgroup info, extract it - ;; and then discard the line - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend))) - (org-split-string x "[ \t]*|[ \t]*"))) - nil) - ((org-table-cookie-line-p x) - ;; This line contains formatting cookies, discard it - nil) - (t x))) - lines))) - ;; there is a special marking column - (setq org-table-clean-did-remove-column t) - (delq nil - (mapcar - (lambda (x) - (cond - ((org-table-colgroup-line-p x) - ;; This line contains colgroup info, extract it - ;; and then discard the line - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend))) - (cdr (org-split-string x "[ \t]*|[ \t]*")))) - nil) - ((org-table-cookie-line-p x) - ;; This line contains formatting cookies, discard it - nil) - ((string-match "^[ \t]*| *\\([!_^/$]\\|\\\\\\$\\) *|" x) - ;; ignore this line - nil) - ((or (string-match "^\\([ \t]*\\)|-+\\+" x) - (string-match "^\\([ \t]*\\)|[^|]*|" x)) - ;; remove the first column - (replace-match "\\1|" t nil x)))) - lines)))) - -(defun org-export-cleanup-toc-line (s) - "Remove tags and timestamps from lines going into the toc." - (if (not s) - "" ; Return a string when argument is nil - (when (memq org-export-with-tags '(not-in-toc nil)) - (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s) - (setq s (replace-match "" t t s)))) - (when org-export-remove-timestamps-from-toc - (while (string-match org-maybe-keyword-time-regexp s) - (setq s (replace-match "" t t s)))) - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match (match-string (if (match-end 3) 3 1) s) - t t s))) - (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s) - (setq s (replace-match "" t t s))) - s)) - - -(defun org-get-text-property-any (pos prop &optional object) - (or (get-text-property pos prop object) - (and (setq pos (next-single-property-change pos prop object)) - (get-text-property pos prop object)))) - -(defun org-export-get-coderef-format (path desc) - (save-match-data - (if (and desc (string-match - (regexp-quote (concat "(" path ")")) - desc)) - (replace-match "%s" t t desc) - (or desc "%s")))) - -(defun org-export-push-to-kill-ring (format) - "Push buffer content to kill ring. -The depends on the variable `org-export-copy-to-kill-ring'." - (when org-export-copy-to-kill-ring - (org-kill-new (buffer-string)) - (when (fboundp 'x-set-selection) - (ignore-errors (x-set-selection 'PRIMARY (buffer-string))) - (ignore-errors (x-set-selection 'CLIPBOARD (buffer-string)))) - (message "%s export done, pushed to kill ring and clipboard" format))) - -(provide 'org-exp) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-exp.el ends here diff --git a/lisp/org-faces.el b/lisp/org-faces.el index 606db0814..54729649d 100644 --- a/lisp/org-faces.el +++ b/lisp/org-faces.el @@ -202,7 +202,7 @@ set the properties in the `org-column' face. For example, set Under XEmacs, the rules are simpler, because the XEmacs version of column view defines special faces for each outline level. See the file -`org-colview-xemacs.el' for details." +`org-colview-xemacs.el' in Org's contrib/ directory for details." :group 'org-faces) (defface org-column-title @@ -394,6 +394,14 @@ determines if it is a foreground or a background color." (string :tag "Color") (sexp :tag "Face"))))) +(defface org-priority ;; originally copied from font-lock-string-face + (org-compatible-face 'font-lock-keyword-face + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (t (:italic t)))) + "Face used for priority cookies." + :group 'org-faces) + (defcustom org-priority-faces nil "Faces for specific Priorities. This is a list of cons cells, with priority character in the car @@ -685,25 +693,28 @@ month and 365.24 days for a year)." (defface org-agenda-restriction-lock (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:background "yellow1")) - (((class color) (min-colors 88) (background dark)) (:background "skyblue4")) - (((class color) (min-colors 16) (background light)) (:background "yellow1")) - (((class color) (min-colors 16) (background dark)) (:background "skyblue4")) + '((((class color) (min-colors 88) (background light)) (:background "#eeeeee")) + (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C")) + (((class color) (min-colors 16) (background light)) (:background "#eeeeee")) + (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C")) (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) (t (:inverse-video t)))) "Face for showing the agenda restriction lock." :group 'org-faces) (defface org-agenda-filter-tags - (org-compatible-face 'mode-line - nil) + (org-compatible-face 'mode-line nil) "Face for tag(s) in the mode-line when filtering the agenda." :group 'org-faces) +(defface org-agenda-filter-regexp + (org-compatible-face 'mode-line nil) + "Face for regexp(s) in the mode-line when filtering the agenda." + :group 'org-faces) + (defface org-agenda-filter-category - (org-compatible-face 'mode-line - nil) - "Face for tag(s) in the mode-line when filtering the agenda." + (org-compatible-face 'mode-line nil) + "Face for categories(s) in the mode-line when filtering the agenda." :group 'org-faces) (defface org-time-grid ;; originally copied from font-lock-variable-name-face @@ -718,20 +729,17 @@ month and 365.24 days for a year)." "Face used to show the current time in the time grid.") (defface org-agenda-diary - (org-compatible-face 'default - nil) + (org-compatible-face 'default nil) "Face used for agenda entries that come from the Emacs diary." :group 'org-faces) (defface org-agenda-calendar-event - (org-compatible-face 'default - nil) + (org-compatible-face 'default nil) "Face used to show events and appointments in the agenda." :group 'org-faces) (defface org-agenda-calendar-sexp - (org-compatible-face 'default - nil) + (org-compatible-face 'default nil) "Face used to show events computed from a S-expression." :group 'org-faces) @@ -757,7 +765,7 @@ level org-n-level-faces" :version "24.1" :type 'boolean) -(defface org-latex-and-export-specials +(defface org-latex-and-related (let ((font (cond ((assq :inherit custom-face-attributes) '(:inherit underline)) (t '(:underline t))))) @@ -770,8 +778,24 @@ level org-n-level-faces" (((class color) (background dark)) (:foreground "burlywood")) (t (,@font)))) - "Face used to highlight math latex and other special exporter stuff." - :group 'org-faces) + "Face used to highlight LaTeX data, entities and sub/superscript." + :group 'org-faces + :version "24.4" + :package-version '(Org . "8.0")) + +(defface org-macro + (org-compatible-face 'org-latex-and-related nil) + "Face for macros." + :group 'org-faces + :version "24.4" + :package-version '(Org . "8.0")) + +(defface org-tag-group + (org-compatible-face 'org-tag nil) + "Face for group tags." + :group 'org-faces + :version "24.4" + :package-version '(Org . "8.0")) (org-copy-face 'mode-line 'org-mode-line-clock "Face used for clock display in mode line.") diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index 4cde24bf5..b014cd89a 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -42,8 +42,6 @@ (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-combine-plists "org" (&rest plists)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) -(declare-function org-export-preprocess-string "org-exp" - (string &rest parameters)) (declare-function org-fill-paragraph "org" (&optional justify)) (declare-function org-icompleting-read "org" (&rest args)) (declare-function org-id-uuid "org-id" ()) @@ -87,7 +85,7 @@ "Regular expression matching the definition of a footnote.") (defconst org-footnote-forbidden-blocks - '("ascii" "beamer" "comment" "docbook" "example" "html" "latex" "odt" "src") + '("ascii" "beamer" "comment" "example" "html" "latex" "odt" "src") "Names of blocks where footnotes are not allowed.") (defgroup org-footnote nil @@ -96,15 +94,19 @@ :group 'org) (defcustom org-footnote-section "Footnotes" - "Outline heading containing footnote definitions before export. -This can be nil, to place footnotes locally at the end of the current -outline node. If can also be the name of a special outline heading -under which footnotes should be put. + "Outline heading containing footnote definitions. + +This can be nil, to place footnotes locally at the end of the +current outline node. If can also be the name of a special +outline heading under which footnotes should be put. + This variable defines the place where Org puts the definition -automatically, i.e. when creating the footnote, and when sorting the notes. -However, by hand you may place definitions *anywhere*. -If this is a string, during export, all subtrees starting with this -heading will be removed after extracting footnote definitions." +automatically, i.e. when creating the footnote, and when sorting +the notes. However, by hand you may place definitions +*anywhere*. + +If this is a string, during export, all subtrees starting with +this heading will be ignored." :group 'org-footnote :type '(choice (string :tag "Collect footnotes under heading") @@ -136,13 +138,13 @@ will be used to define the footnote at the reference position." "Non-nil means define automatically new labels for footnotes. Possible values are: -nil prompt the user for each label -t create unique labels of the form [fn:1], [fn:2], ... -confirm like t, but let the user edit the created value. In particular, - the label can be removed from the minibuffer, to create +nil Prompt the user for each label. +t Create unique labels of the form [fn:1], [fn:2], etc. +confirm Like t, but let the user edit the created value. + The label can be removed from the minibuffer to create an anonymous footnote. random Automatically generate a unique, random label. -plain Automatically create plain number labels like [1]" +plain Automatically create plain number labels like [1]." :group 'org-footnote :type '(choice (const :tag "Prompt for label" nil) @@ -182,8 +184,6 @@ extracted will be filled again." (not (or (org-in-commented-line) (org-in-indented-comment-line) (org-inside-LaTeX-fragment-p) - ;; Avoid protected environments (LaTeX export) - (get-text-property (point) 'org-protected) ;; Avoid literal example. (org-in-verbatim-emphasis) (save-excursion @@ -230,13 +230,7 @@ positions, and the definition, when inlined." (org-in-regexp org-bracket-link-regexp)))) (and linkp (< (point) (cdr linkp)))))) ;; Verify point doesn't belong to a LaTeX macro. - ;; Beware though, when two footnotes are side by - ;; side, once the first one is changed into LaTeX, - ;; the second one might then be considered as an - ;; optional argument of the command. Thus, check - ;; the `org-protected' property of that command. - (or (not (org-inside-latex-macro-p)) - (get-text-property (1- beg) 'org-protected))) + (not (org-inside-latex-macro-p))) (list label beg end ;; Definition: ensure this is an inline footnote first. (and (or (not label) (match-string 1)) @@ -257,11 +251,12 @@ otherwise." (when (save-excursion (beginning-of-line) (org-footnote-in-valid-context-p)) (save-excursion (end-of-line) - ;; Footnotes definitions are separated by new headlines or blank - ;; lines. - (let ((lim (save-excursion (re-search-backward - (concat org-outline-regexp-bol - "\\|^[ \t]*$") nil t)))) + ;; Footnotes definitions are separated by new headlines, another + ;; footnote definition or 2 blank lines. + (let ((lim (save-excursion + (re-search-backward + (concat org-outline-regexp-bol + "\\|^\\([ \t]*\n\\)\\{2,\\}") nil t)))) (when (re-search-backward org-footnote-definition-re lim t) (let ((label (org-match-string-no-properties 1)) (beg (match-beginning 0)) @@ -277,7 +272,7 @@ otherwise." (re-search-forward (concat org-outline-regexp-bol "\\|" org-footnote-definition-re "\\|" - "^[ \t]*$") bound 'move)) + "^\\([ \t]*\n\\)\\{2,\\}") bound 'move)) (match-beginning 0) (point))))) (list label beg end @@ -602,38 +597,15 @@ With prefix arg SPECIAL, offer additional commands in a menu." (org-footnote-goto-previous-reference (car tmp))) (t (org-footnote-new))))) -(defvar org-footnote-insert-pos-for-preprocessor 'point-max - "See `org-footnote-normalize'.") - -(defvar org-export-footnotes-seen) ; silence byte-compiler -(defvar org-export-footnotes-data) ; silence byte-compiler - ;;;###autoload -(defun org-footnote-normalize (&optional sort-only export-props) +(defun org-footnote-normalize (&optional sort-only) "Collect the footnotes in various formats and normalize them. This finds the different sorts of footnotes allowed in Org, and -normalizes them to the usual [N] format that is understood by the -Org-mode exporters. +normalizes them to the usual [N] format. When SORT-ONLY is set, only sort the footnote definitions into the -referenced sequence. - -If Org is amidst an export process, EXPORT-PROPS will hold the -export properties of the buffer. - -When EXPORT-PROPS is non-nil, the default action is to insert -normalized footnotes towards the end of the pre-processing -buffer. Some exporters (docbook, odt...) expect footnote -definitions to be available before any references to them. Such -exporters can let bind `org-footnote-insert-pos-for-preprocessor' -to symbol `point-min' to achieve the desired behaviour. - -Additional note on `org-footnote-insert-pos-for-preprocessor': -1. This variable has not effect when FOR-PREPROCESSOR is nil. -2. This variable (potentially) obviates the need for extra scan - of pre-processor buffer as witnessed in - `org-export-docbook-get-footnotes'." +referenced sequence." ;; This is based on Paul's function, but rewritten. ;; ;; Re-create `org-with-limited-levels', but not limited to Org @@ -643,17 +615,12 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': org-inlinetask-min-level (1- org-inlinetask-min-level))) (nstars (and limit-level - (if org-odd-levels-only - (and limit-level (1- (* limit-level 2))) + (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) (org-outline-regexp (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))) - ;; Determine the highest marker used so far. - (ref-table (when export-props org-export-footnotes-seen)) - (count (if (and export-props ref-table) - (apply 'max (mapcar (lambda (e) (nth 1 e)) ref-table)) - 0)) - ins-point ref) + (count 0) + ins-point ref ref-table) (save-excursion ;; 1. Find every footnote reference, extract the definition, and ;; collect that data in REF-TABLE. If SORT-ONLY is nil, also @@ -675,15 +642,10 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;; Replace footnote reference with [MARKER]. Maybe fill ;; paragraph once done. If SORT-ONLY is non-nil, only move ;; to the end of reference found to avoid matching it twice. - ;; If EXPORT-PROPS isn't nil, also add `org-footnote' - ;; property to it, so it can be easily recognized by - ;; exporters. (if sort-only (goto-char (nth 2 ref)) (delete-region (nth 1 ref) (nth 2 ref)) (goto-char (nth 1 ref)) - (let ((new-ref (format "[%d]" marker))) - (when export-props (org-add-props new-ref '(org-footnote t))) - (insert new-ref)) + (insert (format "[%d]" marker)) (and inlinep org-footnote-fill-after-inline-note-extraction (org-fill-paragraph))) @@ -691,22 +653,9 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;; type (INLINEP) and position (POS) to REF-TABLE if data ;; was unknown. (unless a - (let ((def (or (nth 3 ref) ; inline - (and export-props - (cdr (assoc lbl org-export-footnotes-data))) + (let ((def (or (nth 3 ref) ; Inline definition. (nth 3 (org-footnote-get-definition lbl))))) - (push (list lbl marker - ;; When exporting, each definition goes - ;; through `org-export-preprocess-string' so - ;; it is ready to insert in the - ;; backend-specific buffer. - (if (and export-props def) - (let ((parameters - (org-combine-plists - export-props - '(:todo-keywords t :tags t :priority t)))) - (apply #'org-export-preprocess-string def parameters)) - def) + (push (list lbl marker def ;; Reference beginning position is a marker ;; to preserve it during further buffer ;; modifications. @@ -728,14 +677,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': (unless (bolp) (newline))) ;; No footnote section set: Footnotes will be added at the end ;; of the section containing their first reference. - ;; Nevertheless, in an export situation, set insertion point to - ;; `point-max' by default. - ((derived-mode-p 'org-mode) - (when export-props - (goto-char (point-max)) - (skip-chars-backward " \r\t\n") - (forward-line) - (delete-region (point) (point-max)))) + ((derived-mode-p 'org-mode)) (t ;; Remove any left-over tag in the buffer, if one is set up. (when org-footnote-tag-for-non-org-mode-files @@ -753,14 +695,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': (re-search-backward message-signature-separator nil t)) (beginning-of-line) (goto-char (point-max))))) - ;; During export, `org-footnote-insert-pos-for-preprocessor' has - ;; precedence over previously found position. - (setq ins-point - (copy-marker - (if (and export-props - (eq org-footnote-insert-pos-for-preprocessor 'point-min)) - (point-min) - (point)))) + (setq ins-point (point-marker)) ;; 3. Clean-up REF-TABLE. (setq ref-table (delq nil @@ -791,26 +726,22 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': ;; No footnote: exit. ((not ref-table)) ;; Cases when footnotes should be inserted in one place. - ((or (not (derived-mode-p 'org-mode)) - org-footnote-section - export-props) + ((or (not (derived-mode-p 'org-mode)) org-footnote-section) ;; Insert again the section title, if any. Ensure that title, ;; or the subsequent footnotes, will be separated by a blank ;; lines from the rest of the document. In an Org buffer, ;; separate section with a blank line, unless explicitly ;; stated in `org-blank-before-new-entry'. - (cond - ((not (derived-mode-p 'org-mode)) - (skip-chars-backward " \t\n\r") - (delete-region (point) ins-point) - (unless (bolp) (newline)) - (when org-footnote-tag-for-non-org-mode-files - (insert "\n" org-footnote-tag-for-non-org-mode-files "\n"))) - ((and org-footnote-section (not export-props)) + (if (not (derived-mode-p 'org-mode)) + (progn (skip-chars-backward " \t\n\r") + (delete-region (point) ins-point) + (unless (bolp) (newline)) + (when org-footnote-tag-for-non-org-mode-files + (insert "\n" org-footnote-tag-for-non-org-mode-files "\n"))) (when (and (cdr (assq 'heading org-blank-before-new-entry)) (zerop (save-excursion (org-back-over-empty-lines)))) (insert "\n")) - (insert "* " org-footnote-section "\n"))) + (insert "* " org-footnote-section "\n")) (set-marker ins-point nil) ;; Insert the footnotes, separated by a blank line. (insert @@ -820,10 +751,7 @@ Additional note on `org-footnote-insert-pos-for-preprocessor': (set-marker (nth 4 x) nil) (format "\n[%s] %s" (nth (if sort-only 0 1) x) (nth 2 x))) ref-table "\n")) - (unless (eobp) (insert "\n\n")) - ;; When exporting, add newly inserted markers along with their - ;; associated definition to `org-export-footnotes-seen'. - (when export-props (setq org-export-footnotes-seen ref-table))) + (unless (eobp) (insert "\n\n"))) ;; Each footnote definition has to be inserted at the end of ;; the section where its first reference belongs. (t diff --git a/lisp/org-freemind.el b/lisp/org-freemind.el deleted file mode 100644 index 6de550201..000000000 --- a/lisp/org-freemind.el +++ /dev/null @@ -1,1220 +0,0 @@ -;;; org-freemind.el --- Export Org files to freemind - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Lennart Borgman (lennart O borgman A gmail O com) -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;; -------------------------------------------------------------------- -;; Features that might be required by this library: -;; -;; `backquote', `bytecomp', `cl', `easymenu', `font-lock', -;; `noutline', `org', `org-compat', `org-faces', `org-footnote', -;; `org-list', `org-macs', `org-src', `outline', `syntax', -;; `time-date', `xml'. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; This file tries to implement some functions useful for -;; transformation between org-mode and FreeMind files. -;; -;; Here are the commands you can use: -;; -;; M-x `org-freemind-from-org-mode' -;; M-x `org-freemind-from-org-mode-node' -;; M-x `org-freemind-from-org-sparse-tree' -;; -;; M-x `org-freemind-to-org-mode' -;; -;; M-x `org-freemind-show' -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Change log: -;; -;; 2009-02-15: Added check for next level=current+1 -;; 2009-02-21: Fixed bug in `org-freemind-to-org-mode'. -;; 2009-10-25: Added support for `org-odd-levels-only'. -;; Added y/n question before showing in FreeMind. -;; 2009-11-04: Added support for #+BEGIN_HTML. -;; -;;; Code: - -(require 'xml) -(require 'org) - ;(require 'rx) -(require 'org-exp) -(eval-when-compile (require 'cl)) - -(defgroup org-freemind nil - "Customization group for org-freemind export/import." - :group 'org) - -;; Fix-me: I am not sure these are useful: -;; -;; (defcustom org-freemind-main-fgcolor "black" -;; "Color of main node's text." -;; :type 'color -;; :group 'org-freemind) - -;; (defcustom org-freemind-main-color "black" -;; "Background color of main node." -;; :type 'color -;; :group 'org-freemind) - -;; (defcustom org-freemind-child-fgcolor "black" -;; "Color of child nodes' text." -;; :type 'color -;; :group 'org-freemind) - -;; (defcustom org-freemind-child-color "black" -;; "Background color of child nodes." -;; :type 'color -;; :group 'org-freemind) - -(defvar org-freemind-node-style nil "Internal use.") - -(defcustom org-freemind-node-styles nil - "Styles to apply to node. -NOT READY YET." - :type '(repeat - (list :tag "Node styles for file" - (regexp :tag "File name") - (repeat - (list :tag "Node" - (regexp :tag "Node name regexp") - (set :tag "Node properties" - (list :format "%v" (const :format "" node-style) - (choice :tag "Style" - :value bubble - (const bubble) - (const fork))) - (list :format "%v" (const :format "" color) - (color :tag "Color" :value "red")) - (list :format "%v" (const :format "" background-color) - (color :tag "Background color" :value "yellow")) - (list :format "%v" (const :format "" edge-color) - (color :tag "Edge color" :value "green")) - (list :format "%v" (const :format "" edge-style) - (choice :tag "Edge style" :value bezier - (const :tag "Linear" linear) - (const :tag "Bezier" bezier) - (const :tag "Sharp Linear" sharp-linear) - (const :tag "Sharp Bezier" sharp-bezier))) - (list :format "%v" (const :format "" edge-width) - (choice :tag "Edge width" :value thin - (const :tag "Parent" parent) - (const :tag "Thin" thin) - (const 1) - (const 2) - (const 4) - (const 8))) - (list :format "%v" (const :format "" italic) - (const :tag "Italic font" t)) - (list :format "%v" (const :format "" bold) - (const :tag "Bold font" t)) - (list :format "%v" (const :format "" font-name) - (string :tag "Font name" :value "SansSerif")) - (list :format "%v" (const :format "" font-size) - (integer :tag "Font size" :value 12))))))) - :group 'org-freemind) - -;;;###autoload -(defun org-export-as-freemind (&optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the current buffer as a Freemind file. -If there is an active region, export only the region. HIDDEN is -obsolete and does nothing. EXT-PLIST is a property list with -external parameters overriding org-mode's default settings, but -still inferior to file-local settings. When TO-BUFFER is -non-nil, create a buffer with that name and export to that -buffer. If TO-BUFFER is the symbol `string', don't leave any -buffer behind but just return the resulting HTML as a string. -When BODY-ONLY is set, don't produce the file header and footer, -simply return the content of the document (all top level -sections). When PUB-DIR is set, use this as the publishing -directory. - -See `org-freemind-from-org-mode' for more information." - (interactive "P") - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist))) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) - (filename (concat (file-name-as-directory - (or pub-dir - (org-export-directory :ascii opt-plist))) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory bfname))) - ".mm"))) - (when (file-exists-p filename) - (delete-file filename)) - (cond - (subtree-p - (org-freemind-from-org-mode-node (line-number-at-pos rbeg) - filename)) - (t (org-freemind-from-org-mode bfname filename))))) - -;;;###autoload -(defun org-freemind-show (mm-file) - "Show file MM-FILE in Freemind." - (interactive - (list - (save-match-data - (let ((name (read-file-name "FreeMind file: " - nil nil nil - (if (buffer-file-name) - (let* ((name-ext (file-name-nondirectory (buffer-file-name))) - (name (file-name-sans-extension name-ext)) - (ext (file-name-extension name-ext))) - (cond - ((string= "mm" ext) - name-ext) - ((string= "org" ext) - (let ((name-mm (concat name ".mm"))) - (if (file-exists-p name-mm) - name-mm - (message "Not exported to Freemind format yet") - ""))) - (t - ""))) - "") - ;; Fix-me: Is this an Emacs bug? - ;; This predicate function is never - ;; called. - (lambda (fn) - (string-match "^mm$" (file-name-extension fn)))))) - (setq name (expand-file-name name)) - name)))) - (org-open-file mm-file)) - -(defconst org-freemind-org-nfix "--org-mode: ") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format converters - -(defun org-freemind-escape-str-from-org (org-str) - "Do some html-escaping of ORG-STR and return the result. -The characters \"&<> will be escaped." - (let ((chars (append org-str nil)) - (fm-str "")) - (dolist (cc chars) - (setq fm-str - (concat fm-str - (if (< cc 160) - (cond - ((= cc ?\") """) - ((= cc ?\&) "&") - ((= cc ?\<) "<") - ((= cc ?\>) ">") - (t (char-to-string cc))) - ;; Formatting as &#number; is maybe needed - ;; according to a bug report from kazuo - ;; fujimoto, but I have now instead added a xml - ;; processing instruction saying that the mm - ;; file is utf-8: - ;; - ;; (format "&#x%x;" (- cc ;; ?\x800)) - (format "&#x%x;" (encode-char cc 'ucs)) - )))) - fm-str)) - -;;(org-freemind-unescape-str-to-org "mA≌B<C<=") -;;(org-freemind-unescape-str-to-org "<<") -(defun org-freemind-unescape-str-to-org (fm-str) - "Do some html-unescaping of FM-STR and return the result. -This is the opposite of `org-freemind-escape-str-from-org' but it -will also unescape &#nn;." - (let ((org-str fm-str)) - (setq org-str (replace-regexp-in-string """ "\"" org-str)) - (setq org-str (replace-regexp-in-string "&" "&" org-str)) - (setq org-str (replace-regexp-in-string "<" "<" org-str)) - (setq org-str (replace-regexp-in-string ">" ">" org-str)) - (setq org-str (replace-regexp-in-string - "&#x\\([a-f0-9]\\{2,4\\}\\);" - (lambda (m) - (char-to-string - (+ (string-to-number (match-string 1 m) 16) - 0 ;?\x800 ;; What is this for? Encoding? - ))) - org-str)))) - -(defun org-freemind-convert-links-helper (matched) - "Helper for `org-freemind-convert-links-from-org'. -MATCHED is the link just matched." - (let* ((link (match-string 1 matched)) - (text (match-string 2 matched)) - (ext (file-name-extension link)) - (col-pos (org-string-match-p ":" link)) - (is-img (and (image-type-from-file-name link) - (let ((url-type (substring link 0 col-pos))) - (member url-type '("file" "http" "https"))))) - ) - (if is-img - ;; Fix-me: I can't find a way to get the border to "shrink - ;; wrap" around the image using
    . - ;; - ;; (concat "
    " - ;; "\""" - ;; "
    " - ;; "" text "" - ;; "
    ") - (concat "
    " - "\""" - "
    " - "" text "" - "
    ") - (concat "" text "")))) - -(defun org-freemind-convert-links-from-org (org-str) - "Convert org links in ORG-STR to freemind links and return the result." - (let ((fm-str (replace-regexp-in-string - ;;(rx (not (any "[\"")) - ;; (submatch - ;; "http" - ;; (opt ?\s) - ;; "://" - ;; (1+ - ;; (any "-%.?@a-zA-Z0-9()_/:~=&#")))) - "[^\"[]\\(http ?://[--:#%&()=?-Z_a-z~]+\\)" - "[[\\1][\\1]]" - org-str - nil ;; fixedcase - nil ;; literal - 1 ;; subexp - ))) - (replace-regexp-in-string - ;;(rx "[[" - ;; (submatch (*? nonl)) - ;; "][" - ;; (submatch (*? nonl)) - ;; "]]") - "\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]" - ;;"\\2" - 'org-freemind-convert-links-helper - fm-str t t))) - -;;(org-freemind-convert-links-to-org "link-text") -(defun org-freemind-convert-links-to-org (fm-str) - "Convert freemind links in FM-STR to org links and return the result." - (let ((org-str (replace-regexp-in-string - ;;(rx ""))) - ;; space) - ;; "href=\"" - ;; (submatch (0+ (not (any "\"")))) - ;; "\"" - ;; (0+ (not (any ">"))) - ;; ">" - ;; (submatch (0+ (not (any "<")))) - ;; "") - "]*[[:space:]]\\)*href=\"\\([^\"]*\\)\"[^>]*>\\([^<]*\\)" - "[[\\1][\\2]]" - fm-str))) - org-str)) - -;; Fix-me: -;;(defun org-freemind-convert-drawers-from-org (text) -;; ) - -;; (let* ((str1 "[[http://www.somewhere/][link-text]") -;; (str2 (org-freemind-convert-links-from-org str1)) -;; (str3 (org-freemind-convert-links-to-org str2))) -;; (unless (string= str1 str3) -;; (error "Error str3=%s" str3))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Org => FreeMind - -(defvar org-freemind-bol-helper-base-indent nil) - -(defun org-freemind-bol-helper (matched) - "Helper for `org-freemind-convert-text-p'. -MATCHED is the link just matched." - (let ((res "") - (bi org-freemind-bol-helper-base-indent)) - (dolist (cc (append matched nil)) - (if (= 32 cc) - ;;(setq res (concat res " ")) - ;; We need to use the numerical version. Otherwise Freemind - ;; ver 0.9.0 RC9 can not export to html/javascript. - (progn - (if (< 0 bi) - (setq bi (1- bi)) - (setq res (concat res " ")))) - (setq res (concat res (char-to-string cc))))) - res)) -;; (setq x (replace-regexp-in-string "\n +" 'org-freemind-bol-nbsp-helper "\n ")) - -(defun org-freemind-convert-text-p (text) - "Convert TEXT to html with

    paragraphs." - ;; (string-match-p "[^ ]" " a") - (setq org-freemind-bol-helper-base-indent (org-string-match-p "[^ ]" text)) - (setq text (org-freemind-escape-str-from-org text)) - - (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1\\3\\5" text)) - (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(\*\\)\\([^*]+\\)\\(\*\\)\\([[:space:]]\\)" "\\1\\3\\5" text)) - - (setq text (concat "

    " text)) - (setq text (replace-regexp-in-string "\n[[:blank:]]*\n" "

    " text)) - (setq text (replace-regexp-in-string "\\(?:

    \\|\n\\) +" 'org-freemind-bol-helper text)) - (setq text (replace-regexp-in-string "\n" "
    " text)) - (setq text (concat text "

    ")) - - (org-freemind-convert-links-from-org text)) - -(defcustom org-freemind-node-css-style - "p { margin-top: 3px; margin-bottom: 3px; }" - "CSS style for Freemind nodes." - ;; Fix-me: I do not understand this. It worked to export from Freemind - ;; with this setting now, but not before??? Was this perhaps a java - ;; bug or is it a windows xp bug (some resource gets exhausted if you - ;; use sticky keys which I do). - :version "24.1" - :group 'org-freemind) - -(defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp) - "Convert text part of org node to freemind subnode or note. -Convert the text part of the org node named NODE-NAME. The text -is in the current buffer between START and END. Drawers matching -DRAWERS-REGEXP are converted to freemind notes." - ;; fix-me: doc - (let ((text (buffer-substring-no-properties start end)) - (node-res "") - (note-res "")) - (save-match-data - ;;(setq text (org-freemind-escape-str-from-org text)) - ;; First see if there is something that should be moved to the - ;; note part: - (let (drawers) - (while (string-match drawers-regexp text) - (setq drawers (cons (match-string 0 text) drawers)) - (setq text - (concat (substring text 0 (match-beginning 0)) - (substring text (match-end 0)))) - ) - (when drawers - (dolist (drawer drawers) - (let ((lines (split-string drawer "\n"))) - (dolist (line lines) - (setq note-res (concat - note-res - org-freemind-org-nfix line "
    \n"))) - )))) - - (when (> (length note-res) 0) - (setq note-res (concat - "\n" - "\n" - "\n" - "\n" - note-res - "\n" - "\n" - "\n"))) - - ;; There is always an LF char: - (when (> (length text) 1) - (setq node-res (concat - "\n" - "\n" - "\n" - (if (= 0 (length org-freemind-node-css-style)) - "" - (concat - "\n")) - "\n" - "\n")) - (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML")) - (end-html-mark (regexp-quote "#+END_HTML")) - head - end-pos - end-pos-match - ) - ;; Take care of #+BEGIN_HTML - #+END_HTML - (while (string-match begin-html-mark text) - (setq head (substring text 0 (match-beginning 0))) - (setq end-pos-match (match-end 0)) - (setq node-res (concat node-res - (org-freemind-convert-text-p head))) - (setq text (substring text end-pos-match)) - (setq end-pos (string-match end-html-mark text)) - (if end-pos - (setq end-pos-match (match-end 0)) - (message "org-freemind: Missing #+END_HTML") - (setq end-pos (length text)) - (setq end-pos-match end-pos)) - (setq node-res (concat node-res - (substring text 0 end-pos))) - (setq text (substring text end-pos-match))) - (setq node-res (concat node-res - (org-freemind-convert-text-p text)))) - (setq node-res (concat - node-res - "\n" - "\n" - "\n" - ;; Put a note that this is for the parent node - ;; "" - ;; "" - ;; "" - ;; "" - ;; "

    " - ;; "-- This is more about \"" node-name "\" --" - ;; "

    " - ;; "" - ;; "" - ;; "
    \n" - note-res - "
    \n" ;; ok - ))) - (list node-res note-res)))) - -(defun org-freemind-write-node (mm-buffer drawers-regexp - num-left-nodes base-level - current-level next-level this-m2 - this-node-end - this-children-visible - next-node-start - next-has-some-visible-child) - (let* (this-icons - this-bg-color - this-m2-link - this-m2-escaped - this-rich-node - this-rich-note - ) - (when (string-match "TODO" this-m2) - (setq this-m2 (replace-match "" nil nil this-m2)) - (add-to-list 'this-icons "button_cancel") - (setq this-bg-color "#ffff88") - (when (string-match "\\[#\\(.\\)\\]" this-m2) - (let ((prior (string-to-char (match-string 1 this-m2)))) - (setq this-m2 (replace-match "" nil nil this-m2)) - (cond - ((= prior ?A) - (add-to-list 'this-icons "full-1") - (setq this-bg-color "#ff0000")) - ((= prior ?B) - (add-to-list 'this-icons "full-2") - (setq this-bg-color "#ffaa00")) - ((= prior ?C) - (add-to-list 'this-icons "full-3") - (setq this-bg-color "#ffdd00")) - ((= prior ?D) - (add-to-list 'this-icons "full-4") - (setq this-bg-color "#ffff00")) - ((= prior ?E) - (add-to-list 'this-icons "full-5")) - ((= prior ?F) - (add-to-list 'this-icons "full-6")) - ((= prior ?G) - (add-to-list 'this-icons "full-7")) - )))) - (setq this-m2 (org-trim this-m2)) - (when (string-match org-bracket-link-analytic-regexp this-m2) - (setq this-m2-link (concat "link=\"" (match-string 1 this-m2) - (match-string 3 this-m2) "\" ") - this-m2 (replace-match "\\5" nil nil this-m2 0))) - (setq this-m2-escaped (org-freemind-escape-str-from-org this-m2)) - (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note - this-m2-escaped - this-node-end - (1- next-node-start) - drawers-regexp))) - (setq this-rich-node (nth 0 node-notes)) - (setq this-rich-note (nth 1 node-notes))) - (with-current-buffer mm-buffer - (insert " next-level current-level) - (unless (or this-children-visible - next-has-some-visible-child) - (insert " folded=\"true\""))) - (when (and (= current-level (1+ base-level)) - (> num-left-nodes 0)) - (setq num-left-nodes (1- num-left-nodes)) - (insert " position=\"left\"")) - (when this-bg-color - (insert " background_color=\"" this-bg-color "\"")) - (insert ">\n") - (when this-icons - (dolist (icon this-icons) - (insert "\n"))) - ) - (with-current-buffer mm-buffer - ;;(when this-rich-note (insert this-rich-note)) - (when this-rich-node (insert this-rich-node)))) - num-left-nodes) - -(defun org-freemind-check-overwrite (file interactively) - "Check if file FILE already exists. -If FILE does not exists return t. - -If INTERACTIVELY is non-nil ask if the file should be replaced -and return t/nil if it should/should not be replaced. - -Otherwise give an error say the file exists." - (if (file-exists-p file) - (if interactively - (y-or-n-p (format "File %s exists, replace it? " file)) - (error "File %s already exists" file)) - t)) - -(defvar org-freemind-node-pattern - ;;(rx bol - ;; (submatch (1+ "*")) - ;; (1+ space) - ;; (submatch (*? nonl)) - ;; eol) - "^\\(\\*+\\)[[:space:]]+\\(.*?\\)$") - -(defun org-freemind-look-for-visible-child (node-level) - (save-excursion - (save-match-data - (let ((found-visible-child nil)) - (while (and (not found-visible-child) - (re-search-forward org-freemind-node-pattern nil t)) - (let* ((m1 (match-string-no-properties 1)) - (level (length m1))) - (if (>= node-level level) - (setq found-visible-child 'none) - (unless (get-char-property (line-beginning-position) 'invisible) - (setq found-visible-child 'found))))) - (eq found-visible-child 'found) - )))) - -(defun org-freemind-goto-line (line) - "Go to line number LINE." - (save-restriction - (widen) - (goto-char (point-min)) - (forward-line (1- line)))) - -(defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line) - (with-current-buffer org-buffer - (dolist (node-style org-freemind-node-styles) - (when (org-string-match-p (car node-style) buffer-file-name) - (setq org-freemind-node-style (cadr node-style)))) - ;;(message "org-freemind-node-style =%s" org-freemind-node-style) - (save-match-data - (let* ((drawers (copy-sequence org-drawers)) - drawers-regexp - (num-top1-nodes 0) - (num-top2-nodes 0) - num-left-nodes - (unclosed-nodes 0) - (odd-only org-odd-levels-only) - (first-time t) - (current-level 1) - base-level - prev-node-end - rich-text - unfinished-tag - node-at-line-level - node-at-line-last) - (with-current-buffer mm-buffer - (erase-buffer) - (setq buffer-file-coding-system 'utf-8) - ;; Fix-me: Currently Freemind (ver 0.9.0 RC9) does not support this: - ;;(insert "\n") - (insert "\n") - (insert "\n")) - (save-excursion - ;; Get special buffer vars: - (goto-char (point-min)) - (message "Writing Freemind file...") - (while (re-search-forward "^#\\+DRAWERS:" nil t) - (let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position)))) - (setq drawers (append drawers (split-string dr-txt) nil)))) - (setq drawers-regexp - (concat "^[[:blank:]]*:" - (regexp-opt drawers) - ;;(rx ":" (0+ blank) - ;; "\n" - ;; (*? anything) - ;; "\n" - ;; (0+ blank) - ;; ":END:" - ;; (0+ blank) - ;; eol) - ":[[:blank:]]*\n\\(?:.\\|\n\\)*?\n[[:blank:]]*:END:[[:blank:]]*$" - )) - - (if node-at-line - ;; Get number of top nodes and last line for this node - (progn - (org-freemind-goto-line node-at-line) - (unless (looking-at org-freemind-node-pattern) - (error "No node at line %s" node-at-line)) - (setq node-at-line-level (length (match-string-no-properties 1))) - (forward-line) - (setq node-at-line-last - (catch 'last-line - (while (re-search-forward org-freemind-node-pattern nil t) - (let* ((m1 (match-string-no-properties 1)) - (level (length m1))) - (if (<= level node-at-line-level) - (progn - (beginning-of-line) - (throw 'last-line (1- (point)))) - (if (= level (1+ node-at-line-level)) - (setq num-top2-nodes (1+ num-top2-nodes)))))))) - (setq current-level node-at-line-level) - (setq num-top1-nodes 1) - (org-freemind-goto-line node-at-line)) - - ;; First get number of top nodes - (goto-char (point-min)) - (while (re-search-forward org-freemind-node-pattern nil t) - (let* ((m1 (match-string-no-properties 1)) - (level (length m1))) - (if (= level 1) - (setq num-top1-nodes (1+ num-top1-nodes)) - (if (= level 2) - (setq num-top2-nodes (1+ num-top2-nodes)))))) - ;; If there is more than one top node we need to insert a node - ;; to keep them together. - (goto-char (point-min)) - (when (> num-top1-nodes 1) - (setq num-top2-nodes num-top1-nodes) - (setq current-level 0) - (let ((orig-name (if buffer-file-name - (file-name-nondirectory (buffer-file-name)) - (buffer-name)))) - (with-current-buffer mm-buffer - (insert "\n" - ;; Put a note that this is for the parent node - "" - "" - "" - "" - "

    " - org-freemind-org-nfix "WHOLE FILE" - "

    " - "" - "" - "
    \n"))))) - - (setq num-left-nodes (floor num-top2-nodes 2)) - (setq base-level current-level) - (let (this-m2 - this-node-end - this-children-visible - next-m2 - next-node-start - next-level - next-has-some-visible-child - next-children-visible - ) - (while (and - (re-search-forward org-freemind-node-pattern nil t) - (if node-at-line-last (<= (point) node-at-line-last) t) - ) - (let* ((next-m1 (match-string-no-properties 1)) - (next-node-end (match-end 0)) - ) - (setq next-node-start (match-beginning 0)) - (setq next-m2 (match-string-no-properties 2)) - (setq next-level (length next-m1)) - (setq next-children-visible - (not (eq 'outline - (get-char-property (line-end-position) 'invisible)))) - (setq next-has-some-visible-child - (if next-children-visible t - (org-freemind-look-for-visible-child next-level))) - (when this-m2 - (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child))) - (when (if (= num-top1-nodes 1) (> current-level base-level) t) - (while (>= current-level next-level) - (with-current-buffer mm-buffer - (insert "
    \n") - (setq current-level - (- current-level (if odd-only 2 1)))))) - (setq this-node-end (1+ next-node-end)) - (setq this-m2 next-m2) - (setq current-level next-level) - (setq this-children-visible next-children-visible) - (forward-char) - )) -;;; (unless (if node-at-line-last -;;; (>= (point) node-at-line-last) -;;; nil) - ;; Write last node: - (setq this-m2 next-m2) - (setq current-level next-level) - (setq next-node-start (if node-at-line-last - (1+ node-at-line-last) - (point-max))) - (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child)) - (with-current-buffer mm-buffer (insert "
    \n")) - ;) - ) - (with-current-buffer mm-buffer - (while (> current-level base-level) - (insert "\n") - (setq current-level - (- current-level (if odd-only 2 1))) - )) - (with-current-buffer mm-buffer - (insert "") - (delete-trailing-whitespace) - (goto-char (point-min)) - )))))) - -(defun org-freemind-get-node-style (node-name) - "NOT READY YET." - ;; - ;; - (let (node-styles - node-style) - (dolist (style-list org-freemind-node-style) - (let ((node-regexp (car style-list))) - (message "node-regexp=%s node-name=%s" node-regexp node-name) - (when (org-string-match-p node-regexp node-name) - ;;(setq node-style (org-freemind-do-apply-node-style style-list)) - (setq node-style (cadr style-list)) - (when node-style - (message "node-style=%s" node-style) - (setq node-styles (append node-styles node-style))) - ))))) - -(defun org-freemind-do-apply-node-style (style-list) - (message "style-list=%S" style-list) - (let ((node-style 'fork) - (color "red") - (background-color "yellow") - (edge-color "green") - (edge-style 'bezier) - (edge-width 'thin) - (italic t) - (bold t) - (font-name "SansSerif") - (font-size 12)) - (dolist (style (cadr style-list)) - (message " style=%s" style) - (let ((what (car style))) - (cond - ((eq what 'node-style) - (setq node-style (cadr style))) - ((eq what 'color) - (setq color (cadr style))) - ((eq what 'background-color) - (setq background-color (cadr style))) - - ((eq what 'edge-color) - (setq edge-color (cadr style))) - - ((eq what 'edge-style) - (setq edge-style (cadr style))) - - ((eq what 'edge-width) - (setq edge-width (cadr style))) - - ((eq what 'italic) - (setq italic (cadr style))) - - ((eq what 'bold) - (setq bold (cadr style))) - - ((eq what 'font-name) - (setq font-name (cadr style))) - - ((eq what 'font-size) - (setq font-size (cadr style))) - ) - (insert (format " style=\"%s\"" node-style)) - (insert (format " color=\"%s\"" color)) - (insert (format " background_color=\"%s\"" background-color)) - (insert ">\n") - (insert "\n") - (insert " Org - -;; (sort '(b a c) 'org-freemind-lt-symbols) -(defun org-freemind-lt-symbols (sym-a sym-b) - (string< (symbol-name sym-a) (symbol-name sym-b))) -;; (sort '((b . 1) (a . 2) (c . 3)) 'org-freemind-lt-xml-attrs) -(defun org-freemind-lt-xml-attrs (attr-a attr-b) - (string< (symbol-name (car attr-a)) (symbol-name (car attr-b)))) - -;; xml-parse-region gives things like -;; ((p nil "\n" -;; (a -;; ((href . "link")) -;; "text") -;; "\n" -;; (b nil "hej") -;; "\n")) - -;; '(a . nil) - -;; (org-freemind-symbols= 'a (car '(A B))) -(defsubst org-freemind-symbols= (sym-a sym-b) - "Return t if downcased names of SYM-A and SYM-B are equal. -SYM-A and SYM-B should be symbols." - (or (eq sym-a sym-b) - (string= (downcase (symbol-name sym-a)) - (downcase (symbol-name sym-b))))) - -(defun org-freemind-get-children (parent path) - "Find children node to PARENT from PATH. -PATH should be a list of steps, where each step has the form - - '(NODE-NAME (ATTR-NAME . ATTR-VALUE))" - ;; Fix-me: maybe implement op? step: Name, number, attr, attr op val - ;; Fix-me: case insensitive version for children? - (let* ((children (if (not (listp (car parent))) - (cddr parent) - (let (cs) - (dolist (p parent) - (dolist (c (cddr p)) - (add-to-list 'cs c))) - cs) - )) - (step (car path)) - (step-node (if (listp step) (car step) step)) - (step-attr-list (when (listp step) (sort (cdr step) 'org-freemind-lt-xml-attrs))) - (path-tail (cdr path)) - path-children) - (dolist (child children) - ;; skip xml.el formatting nodes - (unless (stringp child) - ;; compare node name - (when (if (not step-node) - t ;; any node name - (org-freemind-symbols= step-node (car child))) - (if (not step-attr-list) - ;;(throw 'path-child child) ;; no attr to care about - (add-to-list 'path-children child) - (let* ((child-attr-list (cadr child)) - (step-attr-copy (copy-sequence step-attr-list))) - (dolist (child-attr child-attr-list) - ;; Compare attr names: - (when (org-freemind-symbols= (caar step-attr-copy) (car child-attr)) - ;; Compare values: - (let ((step-val (cdar step-attr-copy)) - (child-val (cdr child-attr))) - (when (if (not step-val) - t ;; any value - (string= step-val child-val)) - (setq step-attr-copy (cdr step-attr-copy)))))) - ;; Did we find all? - (unless step-attr-copy - ;;(throw 'path-child child) - (add-to-list 'path-children child) - )))))) - (if path-tail - (org-freemind-get-children path-children path-tail) - path-children))) - -(defun org-freemind-get-richcontent-node (node) - (let ((rc-nodes - (org-freemind-get-children node '((richcontent (type . "NODE")) html body)))) - (when (> (length rc-nodes) 1) - (lwarn t :warning "Unexpected structure: several ")) - (car rc-nodes))) - -(defun org-freemind-get-richcontent-note (node) - (let ((rc-notes - (org-freemind-get-children node '((richcontent (type . "NOTE")) html body)))) - (when (> (length rc-notes) 1) - (lwarn t :warning "Unexpected structure: several ")) - (car rc-notes))) - -(defun org-freemind-test-get-tree-text () - (let ((node '(p nil "\n" - (a - ((href . "link")) - "text") - "\n" - (b nil "hej") - "\n"))) - (org-freemind-get-tree-text node))) -;; (org-freemind-test-get-tree-text) - -(defun org-freemind-get-tree-text (node) - (when node - (let ((ntxt "") - (link nil) - (lf-after nil)) - (dolist (n node) - (case n - ;;(a (setq is-link t) ) - ((h1 h2 h3 h4 h5 h6 p) - ;;(setq ntxt (concat "\n" ntxt)) - (setq lf-after 2)) - (br - (setq lf-after 1)) - (t - (cond - ((stringp n) - (when (string= n "\n") (setq n "")) - (if link - (setq ntxt (concat ntxt - "[[" link "][" n "]]")) - (setq ntxt (concat ntxt n)))) - ((and n (listp n)) - (if (symbolp (car n)) - (setq ntxt (concat ntxt (org-freemind-get-tree-text n))) - ;; This should be the attributes: - (dolist (att-val n) - (let ((att (car att-val)) - (val (cdr att-val))) - (when (eq att 'href) - (setq link val)))))))))) - (if lf-after - (setq ntxt (concat ntxt (make-string lf-after ?\n))) - (setq ntxt (concat ntxt " "))) - ;;(setq ntxt (concat ntxt (format "{%s}" n))) - ntxt))) - -(defun org-freemind-get-richcontent-node-text (node) - "Get the node text as from the richcontent node NODE." - (save-match-data - (let* ((rc (org-freemind-get-richcontent-node node)) - (txt (org-freemind-get-tree-text rc))) - ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt))) - txt - ))) - -(defun org-freemind-get-richcontent-note-text (node) - "Get the node text as from the richcontent note NODE." - (save-match-data - (let* ((rc (org-freemind-get-richcontent-note node)) - (txt (when rc (org-freemind-get-tree-text rc)))) - ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt))) - txt - ))) - -(defun org-freemind-get-icon-names (node) - (let* ((icon-nodes (org-freemind-get-children node '((icon )))) - names) - (dolist (icn icon-nodes) - (setq names (cons (cdr (assq 'builtin (cadr icn))) names))) - ;; (icon (builtin . "full-1")) - names)) - -(defun org-freemind-node-to-org (node level skip-levels) - (let ((qname (car node)) - (attributes (cadr node)) - text - ;; Fix-me: note is never inserted - (note (org-freemind-get-richcontent-note-text node)) - (mark "-- This is more about ") - (icons (org-freemind-get-icon-names node)) - (children (cddr node))) - (when (< 0 (- level skip-levels)) - (dolist (attrib attributes) - (case (car attrib) - ('TEXT (setq text (cdr attrib))) - ('text (setq text (cdr attrib))))) - (unless text - ;; There should be a richcontent node holding the text: - (setq text (org-freemind-get-richcontent-node-text node))) - (when icons - (when (member "full-1" icons) (setq text (concat "[#A] " text))) - (when (member "full-2" icons) (setq text (concat "[#B] " text))) - (when (member "full-3" icons) (setq text (concat "[#C] " text))) - (when (member "full-4" icons) (setq text (concat "[#D] " text))) - (when (member "full-5" icons) (setq text (concat "[#E] " text))) - (when (member "full-6" icons) (setq text (concat "[#F] " text))) - (when (member "full-7" icons) (setq text (concat "[#G] " text))) - (when (member "button_cancel" icons) (setq text (concat "TODO " text))) - ) - (if (and note - (string= mark (substring note 0 (length mark)))) - (progn - (setq text (replace-regexp-in-string "\n $" "" text)) - (insert text)) - (case qname - ('node - (insert (make-string (- level skip-levels) ?*) " " text "\n") - (when note - (insert ":COMMENT:\n" note "\n:END:\n")) - )))) - (dolist (child children) - (unless (or (null child) - (stringp child)) - (org-freemind-node-to-org child (1+ level) skip-levels))))) - -;; Fix-me: put back special things, like drawers that are stored in -;; the notes. Should maybe all notes contents be put in drawers? -;;;###autoload -(defun org-freemind-to-org-mode (mm-file org-file) - "Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE." - (interactive - (save-match-data - (let* ((mm-file (buffer-file-name)) - (default-org-file (concat (file-name-nondirectory mm-file) ".org")) - (org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file))) - (list mm-file org-file)))) - (when (org-freemind-check-overwrite org-file (org-called-interactively-p 'any)) - (let ((mm-buffer (find-file-noselect mm-file)) - (org-buffer (find-file-noselect org-file))) - (with-current-buffer mm-buffer - (let* ((xml-list (xml-parse-file mm-file)) - (top-node (cadr (cddar xml-list))) - (note (org-freemind-get-richcontent-note-text top-node)) - (skip-levels - (if (and note - (string-match "^--org-mode: WHOLE FILE$" note)) - 1 - 0))) - (with-current-buffer org-buffer - (erase-buffer) - (org-freemind-node-to-org top-node 1 skip-levels) - (goto-char (point-min)) - (org-set-tags t t) ;; Align all tags - ) - (switch-to-buffer-other-window org-buffer) - ))))) - -(provide 'org-freemind) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-freemind.el ends here diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el index 4419fdbe8..e368a14e2 100644 --- a/lisp/org-gnus.el +++ b/lisp/org-gnus.el @@ -43,8 +43,7 @@ (declare-function gnus-summary-last-subject "gnus-sum" nil) ;; Customization variables -(when (fboundp 'defvaralias) - (defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)) +(org-defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links) (defcustom org-gnus-prefer-web-links nil "If non-nil, `org-store-link' creates web links to Google groups or Gmane. @@ -66,6 +65,12 @@ this variable to `t'." :version "24.1" :type 'boolean) +(defcustom org-gnus-no-server nil + "Should Gnus be started using `gnus-no-server'?" + :group 'org-gnus + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) ;; Install the link type (org-add-link-type "gnus" 'org-gnus-open) @@ -287,7 +292,7 @@ If `org-store-link' was called with a prefix arg the meaning of (defun org-gnus-no-new-news () "Like `M-x gnus' but doesn't check for new news." - (if (not (gnus-alive-p)) (gnus))) + (if (not (gnus-alive-p)) (if org-gnus-no-server (gnus-no-server) (gnus)))) (provide 'org-gnus) diff --git a/lisp/org-html.el b/lisp/org-html.el deleted file mode 100644 index ca90f855a..000000000 --- a/lisp/org-html.el +++ /dev/null @@ -1,2761 +0,0 @@ -;;; org-html.el --- HTML export for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;;; Code: - -(require 'org-exp) -(require 'format-spec) - -(eval-when-compile (require 'cl)) - -(declare-function org-id-find-id-file "org-id" (id)) -(declare-function htmlize-region "ext:htmlize" (beg end)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -(defgroup org-export-html nil - "Options specific for HTML export of Org-mode files." - :tag "Org Export HTML" - :group 'org-export) - -(defcustom org-export-html-footnotes-section "
    -

    %s:

    -
    -%s -
    -
    " - "Format for the footnotes section. -Should contain a two instances of %s. The first will be replaced with the -language-specific word for \"Footnotes\", the second one will be replaced -by the footnotes themselves." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-footnote-format "%s" - "The format for the footnote reference. -%s will be replaced by the footnote reference itself." - :group 'org-export-html - :type 'string) - - -(defcustom org-export-html-footnote-separator ", " - "Text used to separate footnotes." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-coding-system nil - "Coding system for HTML export, defaults to `buffer-file-coding-system'." - :group 'org-export-html - :type 'coding-system) - -(defcustom org-export-html-extension "html" - "The extension for exported HTML files." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-xml-declaration - '(("html" . "") - ("php" . "\"; ?>")) - "The extension for exported HTML files. -%s will be replaced with the charset of the exported file. -This may be a string, or an alist with export extensions -and corresponding declarations." - :group 'org-export-html - :type '(choice - (string :tag "Single declaration") - (repeat :tag "Dependent on extension" - (cons (string :tag "Extension") - (string :tag "Declaration"))))) - -(defcustom org-export-html-style-include-scripts t - "Non-nil means include the JavaScript snippets in exported HTML files. -The actual script is defined in `org-export-html-scripts' and should -not be modified." - :group 'org-export-html - :type 'boolean) - -(defvar org-export-html-scripts - "" - "Basic JavaScript that is needed by HTML files produced by Org-mode.") - -(defconst org-export-html-style-default - "" - "The default style specification for exported HTML files. -Please use the variables `org-export-html-style' and -`org-export-html-style-extra' to add to this style. If you wish to not -have the default style included, customize the variable -`org-export-html-style-include-default'.") - -(defcustom org-export-html-style-include-default t - "Non-nil means include the default style in exported HTML files. -The actual style is defined in `org-export-html-style-default' and should -not be modified. Use the variables `org-export-html-style' to add -your own style information." - :group 'org-export-html - :type 'boolean) - -;;;###autoload -(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp) - -(defcustom org-export-html-style "" - "Org-wide style definitions for exported HTML files. - -This variable needs to contain the full HTML structure to provide a style, -including the surrounding HTML tags. If you set the value of this variable, -you should consider to include definitions for the following classes: - title, todo, done, timestamp, timestamp-kwd, tag, target. - -For example, a valid value would be: - - - -If you'd like to refer to an external style file, use something like - - - -As the value of this option simply gets inserted into the HTML header, -you can \"misuse\" it to add arbitrary text to the header. -See also the variable `org-export-html-style-extra'." - :group 'org-export-html - :type 'string) -;;;###autoload -(put 'org-export-html-style 'safe-local-variable 'stringp) - -(defcustom org-export-html-style-extra "" - "Additional style information for HTML export. -The value of this variable is inserted into the HTML buffer right after -the value of `org-export-html-style'. Use this variable for per-file -settings of style information, and do not forget to surround the style -settings with tags." - :group 'org-export-html - :type 'string) -;;;###autoload -(put 'org-export-html-style-extra 'safe-local-variable 'stringp) - -(defcustom org-export-html-mathjax-options - '((path "http://orgmode.org/mathjax/MathJax.js") - (scale "100") - (align "center") - (indent "2em") - (mathml nil)) - "Options for MathJax setup. - -path The path where to find MathJax -scale Scaling for the HTML-CSS backend, usually between 100 and 133 -align How to align display math: left, center, or right -indent If align is not center, how far from the left/right side? -mathml Should a MathML player be used if available? - This is faster and reduces bandwidth use, but currently - sometimes has lower spacing quality. Therefore, the default is - nil. When browsers get better, this switch can be flipped. - -You can also customize this for each buffer, using something like - -#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\"" - :group 'org-export-html - :version "24.1" - :type '(list :greedy t - (list :tag "path (the path from where to load MathJax.js)" - (const :format " " path) (string)) - (list :tag "scale (scaling for the displayed math)" - (const :format " " scale) (string)) - (list :tag "align (alignment of displayed equations)" - (const :format " " align) (string)) - (list :tag "indent (indentation with left or right alignment)" - (const :format " " indent) (string)) - (list :tag "mathml (should MathML display be used is possible)" - (const :format " " mathml) (boolean)))) - -(defun org-export-html-mathjax-config (template options in-buffer) - "Insert the user setup into the matchjax template." - (let (name val (yes " ") (no "// ") x) - (mapc - (lambda (e) - (setq name (car e) val (nth 1 e)) - (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer) - (setq val (car (read-from-string - (substring in-buffer (match-end 0)))))) - (if (not (stringp val)) (setq val (format "%s" val))) - (setq template - (replace-regexp-in-string - (concat "%" (upcase (symbol-name name))) val template t t))) - options) - (setq val (nth 1 (assq 'mathml options))) - (if (string-match (concat "\\ -/** - * - * @source: %PATH - * - * @licstart The following is the entire license notice for the - * JavaScript code in %PATH. - * - * Copyright (C) 2012-2013 MathJax - * - * Licensed under the Apache License, Version 2.0 (the \"License\"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an \"AS IS\" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * @licend The above is the entire license notice - * for the JavaScript code in %PATH. - * - */ - -/* -@licstart The following is the entire license notice for the -JavaScript code below. - -Copyright (C) 2012-2013 Free Software Foundation, Inc. - -The JavaScript code below is free software: you can -redistribute it and/or modify it under the terms of the GNU -General Public License (GNU GPL) as published by the Free Software -Foundation, either version 3 of the License, or (at your option) -any later version. The code is distributed WITHOUT ANY WARRANTY; -without even the implied warranty of MERCHANTABILITY or FITNESS -FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. - -As additional permission under GNU GPL version 3 section 7, you -may distribute non-source (e.g., minimized or compacted) forms of -that code without the copy of the GNU GPL normally required by -section 4, provided you include this license notice and a URL -through which recipients can access the Corresponding Source. - - -@licend The above is the entire license notice -for the JavaScript code below. -*/ - -" - "The MathJax setup for XHTML files." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-tag-class-prefix "" - "Prefix to class names for TODO keywords. -Each tag gets a class given by the tag itself, with this prefix. -The default prefix is empty because it is nice to just use the keyword -as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefix can be very useful." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-todo-kwd-class-prefix "" - "Prefix to class names for TODO keywords. -Each TODO keyword gets a class given by the keyword itself, with this prefix. -The default prefix is empty because it is nice to just use the keyword -as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefix can be very useful." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-headline-anchor-format "" - "Format for anchors in HTML headlines. -It requires to %s: both will be replaced by the anchor referring -to the headline (e.g. \"sec-2\"). When set to `nil', don't insert -HTML anchors in headlines." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-preamble t - "Non-nil means insert a preamble in HTML export. - -When `t', insert a string as defined by one of the formatting -strings in `org-export-html-preamble-format'. When set to a -string, this string overrides `org-export-html-preamble-format'. -When set to a function, apply this function and insert the -returned string. The function takes no argument, but you can -use `opt-plist' to access the current export options. - -Setting :html-preamble in publishing projects will take -precedence over this variable." - :group 'org-export-html - :type '(choice (const :tag "No preamble" nil) - (const :tag "Default preamble" t) - (string :tag "Custom format string") - (function :tag "Function (must return a string)"))) - -(defcustom org-export-html-preamble-format '(("en" "")) - "Alist of languages and format strings for the HTML preamble. - -To enable the HTML exporter to use these formats, you need to set -`org-export-html-preamble' to `t'. - -The first element of each list is the language code, as used for -the #+LANGUAGE keyword. - -The second element of each list is a format string to format the -preamble itself. This format string can contain these elements: - -%t stands for the title. -%a stands for the author's name. -%e stands for the author's email. -%d stands for the date. - -If you need to use a \"%\" character, you need to escape it -like that: \"%%\"." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-postamble 'auto - "Non-nil means insert a postamble in HTML export. - -When `t', insert a string as defined by the format string in -`org-export-html-postamble-format'. When set to a string, this -string overrides `org-export-html-postamble-format'. When set to -'auto, discard `org-export-html-postamble-format' and honor -`org-export-author/email/creator-info' variables. When set to a -function, apply this function and insert the returned string. -The function takes no argument, but you can use `opt-plist' to -access the current export options. - -Setting :html-postamble in publishing projects will take -precedence over this variable." - :group 'org-export-html - :type '(choice (const :tag "No postamble" nil) - (const :tag "Auto preamble" 'auto) - (const :tag "Default format string" t) - (string :tag "Custom format string") - (function :tag "Function (must return a string)"))) - -(defcustom org-export-html-postamble-format - '(("en" "

    Author: %a (%e)

    -

    Date: %d

    -

    Generated by %c

    -

    %v

    -")) - "Alist of languages and format strings for the HTML postamble. - -To enable the HTML exporter to use these formats, you need to set -`org-export-html-postamble' to `t'. - -The first element of each list is the language code, as used for -the #+LANGUAGE keyword. - -The second element of each list is a format string to format the -postamble itself. This format string can contain these elements: - -%a stands for the author's name. -%e stands for the author's email. -%d stands for the date. -%c will be replaced by information about Org/Emacs versions. -%v will be replaced by `org-export-html-validation-link'. - -If you need to use a \"%\" character, you need to escape it -like that: \"%%\"." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-home/up-format - "
    - UP - | - HOME -
    " - "Snippet used to insert the HOME and UP links. -This is a format string, the first %s will receive the UP link, -the second the HOME link. If both `org-export-html-link-up' and -`org-export-html-link-home' are empty, the entire snippet will be -ignored." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-toplevel-hlevel 2 - "The level for level 1 headings in HTML export. -This is also important for the classes that will be wrapped around headlines -and outline structure. If this variable is 1, the top-level headlines will -be

    , and the corresponding classes will be outline-1, section-number-1, -and outline-text-1. If this is 2, all of these will get a 2 instead. -The default for this variable is 2, because we use

    for formatting the -document title." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-link-org-files-as-html t - "Non-nil means make file links to `file.org' point to `file.html'. -When org-mode is exporting an org-mode file to HTML, links to -non-html files are directly put into a href tag in HTML. -However, links to other Org-mode files (recognized by the -extension `.org.) should become links to the corresponding html -file, assuming that the linked org-mode file will also be -converted to HTML. -When nil, the links still point to the plain `.org' file." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-inline-images 'maybe - "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." - :group 'org-export-html - :type '(choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "When there is no description" maybe))) - -(defcustom org-export-html-inline-image-extensions - '("png" "jpeg" "jpg" "gif" "svg") - "Extensions of image files that can be inlined into HTML." - :group 'org-export-html - :type '(repeat (string :tag "Extension"))) - -(defcustom org-export-html-table-tag - "" - "The HTML tag that is used to start a table. -This must be a
    tag, but you may change the options like -borders and spacing." - :group 'org-export-html - :type 'string) - -(defcustom org-export-table-header-tags '("") - "The opening tag for table header fields. -This is customizable so that alignment options can be specified. -The first %s will be filled with the scope of the field, either row or col. -The second %s will be replaced by a style entry to align the field. -See also the variable `org-export-html-table-use-header-tags-for-first-column'. -See also the variable `org-export-html-table-align-individual-fields'." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-table-data-tags '("" . "") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified. -The first %s will be filled with the scope of the field, either row or col. -The second %s will be replaced by a style entry to align the field. -See also the variable `org-export-html-table-align-individual-fields'." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-table-row-tags '("" . "") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified. -Instead of strings, these can be Lisp forms that will be evaluated -for each row in order to construct the table row tags. During evaluation, -the variable `head' will be true when this is a header line, nil when this -is a body line. And the variable `nline' will contain the line number, -starting from 1 in the first header line. For example - - (setq org-export-table-row-tags - (cons '(if head - \"\" - (if (= (mod nline 2) 1) - \"\" - \"\")) - \"\")) - -will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"." - :group 'org-export-tables - :type '(cons - (choice :tag "Opening tag" - (string :tag "Specify") - (sexp)) - (choice :tag "Closing tag" - (string :tag "Specify") - (sexp)))) - -(defcustom org-export-html-table-align-individual-fields t - "Non-nil means attach style attributes for alignment to each table field. -When nil, alignment will only be specified in the column tags, but this -is ignored by some browsers (like Firefox, Safari). Opera does it right -though." - :group 'org-export-tables - :version "24.1" - :type 'boolean) - -(defcustom org-export-html-table-use-header-tags-for-first-column nil - "Non-nil means format column one in tables with header tags. -When nil, also column one will use data tags." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-html-validation-link - "Validate XHTML 1.0" - "Link to HTML validation service." - :group 'org-export-html - :type 'string) - -;; FIXME Obsolete since Org 7.7 -;; Use the :timestamp option or `org-export-time-stamp-file' instead -(defvar org-export-html-with-timestamp nil - "If non-nil, write container for HTML-helper-mode timestamp.") - -;; FIXME Obsolete since Org 7.7 -(defvar org-export-html-html-helper-timestamp - "\n



    \n

    \n" - "The HTML tag used as timestamp delimiter for HTML-helper-mode.") - -(defcustom org-export-html-protect-char-alist - '(("&" . "&") - ("<" . "<") - (">" . ">")) - "Alist of characters to be converted by `org-html-protect'." - :group 'org-export-html - :version "24.1" - :type '(repeat (cons (string :tag "Character") - (string :tag "HTML equivalent")))) - -(defgroup org-export-htmlize nil - "Options for processing examples with htmlize.el." - :tag "Org Export Htmlize" - :group 'org-export-html) - -(defcustom org-export-htmlize-output-type 'inline-css - "Output type to be used by htmlize when formatting code snippets. -Choices are `css', to export the CSS selectors only, or `inline-css', to -export the CSS attribute values inline in the HTML. We use as default -`inline-css', in order to make the resulting HTML self-containing. - -However, this will fail when using Emacs in batch mode for export, because -then no rich font definitions are in place. It will also not be good if -people with different Emacs setup contribute HTML files to a website, -because the fonts will represent the individual setups. In these cases, -it is much better to let Org/Htmlize assign classes only, and to use -a style file to define the look of these classes. -To get a start for your css file, start Emacs session and make sure that -all the faces you are interested in are defined, for example by loading files -in all modes you want. Then, use the command -\\[org-export-htmlize-generate-css] to extract class definitions." - :group 'org-export-htmlize - :type '(choice (const css) (const inline-css))) - -(defcustom org-export-htmlize-css-font-prefix "org-" - "The prefix for CSS class names for htmlize font specifications." - :group 'org-export-htmlize - :type 'string) - -(defcustom org-export-htmlized-org-css-url nil - "URL pointing to a CSS file defining text colors for htmlized Emacs buffers. -Normally when creating an htmlized version of an Org buffer, htmlize will -create CSS to define the font colors. However, this does not work when -converting in batch mode, and it also can look bad if different people -with different fontification setup work on the same website. -When this variable is non-nil, creating an htmlized version of an Org buffer -using `org-export-as-org' will remove the internal CSS section and replace it -with a link to this URL." - :group 'org-export-htmlize - :type '(choice - (const :tag "Keep internal css" nil) - (string :tag "URL or local href"))) - -;; FIXME: The following variable is obsolete since Org 7.7 but is -;; still declared and checked within code for compatibility reasons. -;; Use the custom variables `org-export-html-divs' instead. -(defvar org-export-html-content-div "content" - "The name of the container DIV that holds all the page contents. - -This variable is obsolete since Org version 7.7. -Please set `org-export-html-divs' instead.") - -(defcustom org-export-html-divs '("preamble" "content" "postamble") - "The name of the main divs for HTML export. -This is a list of three strings, the first one for the preamble -DIV, the second one for the content DIV and the third one for the -postamble DIV." - :group 'org-export-html - :version "24.1" - :type '(list - (string :tag " Div for the preamble:") - (string :tag " Div for the content:") - (string :tag "Div for the postamble:"))) - -(defcustom org-export-html-date-format-string "%Y-%m-%dT%R%z" - "Format string to format the date and time. - -The default is an extended format of the ISO 8601 specification." - :group 'org-export-html - :version "24.1" - :type 'string) - -;;; Hooks - -(defvar org-export-html-after-blockquotes-hook nil - "Hook run during HTML export, after blockquote, verse, center are done.") - -(defvar org-export-html-final-hook nil - "Hook run at the end of HTML export, in the new buffer.") - -;;; HTML export - -(defun org-export-html-preprocess (parameters) - "Convert LaTeX fragments to images." - (when (and org-current-export-file - (plist-get parameters :LaTeX-fragments)) - (org-format-latex - (concat org-latex-preview-ltxpng-directory (file-name-sans-extension - (file-name-nondirectory - org-current-export-file))) - org-current-export-dir nil "Creating LaTeX image %s" - nil nil - (cond - ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim) - ((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax) - ((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax) - ((eq (plist-get parameters :LaTeX-fragments) 'imagemagick) 'imagemagick) - ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng)))) - (goto-char (point-min)) - (let (label l1) - (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t) - (org-if-unprotected-at (match-beginning 1) - (setq label (match-string 1)) - (save-match-data - (if (string-match "\\`[a-z]\\{1,10\\}:\\(.+\\)" label) - (setq l1 (substring label (match-beginning 1))) - (setq l1 label))) - (replace-match (format "[[#%s][%s]]" label l1) t t))))) - -;;;###autoload -(defun org-export-as-html-and-open (arg) - "Export the outline as HTML and immediately open it with a browser. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted lists." - (interactive "P") - (org-export-as-html arg) - (org-open-file buffer-file-name) - (when org-export-kill-product-buffer-when-displayed - (kill-buffer (current-buffer)))) - -;;;###autoload -(defun org-export-as-html-batch () - "Call the function `org-export-as-html'. -This function can be used in batch processing as: -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-export-as-html-batch" - (org-export-as-html org-export-headline-levels)) - -;;;###autoload -(defun org-export-as-html-to-buffer (arg) - "Call `org-export-as-html` with output to a temporary buffer. -No file is created. The prefix ARG is passed through to `org-export-as-html'." - (interactive "P") - (org-export-as-html arg nil "*Org HTML Export*") - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window "*Org HTML Export*"))) - -;;;###autoload -(defun org-replace-region-by-html (beg end) - "Assume the current region has org-mode syntax, and convert it to HTML. -This can be used in any buffer. For example, you could write an -itemized list in org-mode syntax in an HTML buffer and then use this -command to convert it." - (interactive "r") - (let (reg html buf pop-up-frames) - (save-window-excursion - (if (derived-mode-p 'org-mode) - (setq html (org-export-region-as-html - beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq html (org-export-region-as-html - (point-min) (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert html))) - -;;;###autoload -(defun org-export-region-as-html (beg end &optional body-only buffer) - "Convert region from BEG to END in org-mode buffer to HTML. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted HTML. If BUFFER is the symbol `string', return the -produced HTML as a string and leave not buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq html (org-export-region-as-html beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (interactive "r\nP") - (when (org-called-interactively-p 'any) - (setq buffer "*Org HTML Export*")) - (let ((transient-mark-mode t) (zmacs-regions t) - ext-plist rtn) - (setq ext-plist (plist-put ext-plist :ignore-subtree-p t)) - (goto-char end) - (set-mark (point)) ;; to activate the region - (goto-char beg) - (setq rtn (org-export-as-html nil ext-plist buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (org-called-interactively-p 'any) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -(defvar html-table-tag nil) ; dynamically scoped into this. -(defvar org-par-open nil) - -;;; org-html-cvt-link-fn -(defconst org-html-cvt-link-fn - nil - "Function to convert link URLs to exportable URLs. -Takes two arguments, TYPE and PATH. -Returns exportable url as (TYPE PATH), or nil to signal that it -didn't handle this case. -Intended to be locally bound around a call to `org-export-as-html'." ) - -(defun org-html-cvt-org-as-html (opt-plist type path) - "Convert an org filename to an equivalent html filename. -If TYPE is not file, just return `nil'. -See variable `org-export-html-link-org-files-as-html'" - - (save-match-data - (and - org-export-html-link-org-files-as-html - (string= type "file") - (string-match "\\.org$" path) - (progn - (list - "file" - (concat - (substring path 0 (match-beginning 0)) - "." - (plist-get opt-plist :html-extension))))))) - - -;;; org-html-should-inline-p -(defun org-html-should-inline-p (filename descp) - "Return non-nil if link FILENAME should be inlined. -The decision to inline the FILENAME link is based on the current -settings. DESCP is the boolean of whether there was a link -description. See variables `org-export-html-inline-images' and -`org-export-html-inline-image-extensions'." - (declare (special - org-export-html-inline-images - org-export-html-inline-image-extensions)) - (and (or (eq t org-export-html-inline-images) - (and org-export-html-inline-images (not descp))) - (org-file-image-p - filename org-export-html-inline-image-extensions))) - -;;; org-html-make-link -(defun org-html-make-link (opt-plist type path fragment desc attr - may-inline-p) - "Make an HTML link. -OPT-PLIST is an options list. -TYPE is the device-type of the link (THIS://foo.html). -PATH is the path of the link (http://THIS#location). -FRAGMENT is the fragment part of the link, if any (foo.html#THIS). -DESC is the link description, if any. -ATTR is a string of other attributes of the \"a\" element. -MAY-INLINE-P allows inlining it as an image." - - (declare (special org-par-open)) - (save-match-data - (let* ((filename path) - ;;First pass. Just sanity stuff. - (components-1 - (cond - ((string= type "file") - (list - type - ;;Substitute just if original path was absolute. - ;;(Otherwise path must remain relative) - (if (file-name-absolute-p path) - (concat "file://" (expand-file-name path)) - path))) - ((string= type "") - (list nil path)) - (t (list type path)))) - - ;;Second pass. Components converted so they can refer - ;;to a remote site. - (components-2 - (or - (and org-html-cvt-link-fn - (apply org-html-cvt-link-fn - opt-plist components-1)) - (apply #'org-html-cvt-org-as-html - opt-plist components-1) - components-1)) - (type (first components-2)) - (thefile (second components-2))) - - - ;;Third pass. Build final link except for leading type - ;;spec. - (cond - ((or - (not type) - (string= type "http") - (string= type "https") - (string= type "file") - (string= type "coderef")) - (if fragment - (setq thefile (concat thefile "#" fragment)))) - - (t)) - - ;;Final URL-build, for all types. - (setq thefile - (let - ((str (org-export-html-format-href thefile))) - (if (and type (not (or (string= "file" type) - (string= "coderef" type)))) - (concat type ":" str) - str))) - - (if (and - may-inline-p - ;;Can't inline a URL with a fragment. - (not fragment)) - (progn - (message "image %s %s" thefile org-par-open) - (org-export-html-format-image thefile org-par-open)) - (concat - "" - (org-export-html-format-desc desc) - ""))))) - -(defun org-html-handle-links (org-line opt-plist) - "Return ORG-LINE with markup of Org mode links. -OPT-PLIST is the export options list." - (let ((start 0) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (link-validate (plist-get opt-plist :link-validation-function)) - type id-file fnc - rpl path attr desc descp desc1 desc2 link) - (while (string-match org-bracket-link-analytic-regexp++ org-line start) - (setq start (match-beginning 0)) - (setq path (save-match-data (org-link-unescape - (match-string 3 org-line)))) - (setq type (cond - ((match-end 2) (match-string 2 org-line)) - ((save-match-data - (or (file-name-absolute-p path) - (string-match "^\\.\\.?/" path))) - "file") - (t "internal"))) - (setq path (org-extract-attributes path)) - (setq attr (get-text-property 0 'org-attributes path)) - (setq desc1 (if (match-end 5) (match-string 5 org-line)) - desc2 (if (match-end 2) (concat type ":" path) path) - descp (and desc1 (not (equal desc1 desc2))) - desc (or desc1 desc2)) - ;; Make an image out of the description if that is so wanted - (when (and descp (org-file-image-p - desc org-export-html-inline-image-extensions)) - (save-match-data - (if (string-match "^file:" desc) - (setq desc (substring desc (match-end 0))))) - (setq desc (org-add-props - (concat "") - '(org-protected t)))) - (cond - ((equal type "internal") - (let - ((frag-0 - (if (= (string-to-char path) ?#) - (substring path 1) - path))) - (setq rpl - (org-html-make-link - opt-plist - "" - "" - (org-solidify-link-text - (save-match-data (org-link-unescape frag-0)) - nil) - desc attr nil)))) - ((and (equal type "id") - (setq id-file (org-id-find-id-file path))) - ;; This is an id: link to another file (if it was the same file, - ;; it would have become an internal link...) - (save-match-data - (setq id-file (file-relative-name - id-file - (file-name-directory org-current-export-file))) - (setq rpl - (org-html-make-link opt-plist - "file" id-file - (concat (if (org-uuidgen-p path) "ID-") path) - desc - attr - nil)))) - ((member type '("http" "https")) - ;; standard URL, can inline as image - (setq rpl - (org-html-make-link opt-plist - type path nil - desc - attr - (org-html-should-inline-p path descp)))) - ((member type '("ftp" "mailto" "news")) - ;; standard URL, can't inline as image - (setq rpl - (org-html-make-link opt-plist - type path nil - desc - attr - nil))) - - ((string= type "coderef") - (let* - ((coderef-str (format "coderef-%s" path)) - (attr-1 - (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" - coderef-str coderef-str))) - (setq rpl - (org-html-make-link opt-plist - type "" coderef-str - (format - (org-export-get-coderef-format - path - (and descp desc)) - (cdr (assoc path org-export-code-refs))) - attr-1 - nil)))) - - ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - ;; The link protocol has a function for format the link - (setq rpl - (save-match-data - (funcall fnc (org-link-unescape path) desc1 'html)))) - - ((string= type "file") - ;; FILE link - (save-match-data - (let* - ((components - (if - (string-match "::\\(.*\\)" path) - (list - (replace-match "" t nil path) - (match-string 1 path)) - (list path nil))) - - ;;The proper path, without a fragment - (path-1 - (first components)) - - ;;The raw fragment - (fragment-0 - (second components)) - - ;;Check the fragment. If it can't be used as - ;;target fragment we'll pass nil instead. - (fragment-1 - (if - (and fragment-0 - (not (string-match "^[0-9]*$" fragment-0)) - (not (string-match "^\\*" fragment-0)) - (not (string-match "^/.*/$" fragment-0))) - (org-solidify-link-text - (org-link-unescape fragment-0)) - nil)) - (desc-2 - ;;Description minus "file:" and ".org" - (if (string-match "^file:" desc) - (let - ((desc-1 (replace-match "" t t desc))) - (if (string-match "\\.org$" desc-1) - (replace-match "" t t desc-1) - desc-1)) - desc))) - - (setq rpl - (if - (and - (functionp link-validate) - (not (funcall link-validate path-1 current-dir))) - desc - (org-html-make-link opt-plist - "file" path-1 fragment-1 desc-2 attr - (org-html-should-inline-p path-1 descp))))))) - - (t - ;; just publish the path, as default - (setq rpl (concat "<" type ":" - (save-match-data (org-link-unescape path)) - ">")))) - (setq org-line (replace-match rpl t t org-line) - start (+ start (length rpl)))) - org-line)) - -;;; org-export-as-html - -(defvar org-heading-keyword-regexp-format) ; defined in org.el - -;;;###autoload -(defun org-export-as-html (arg &optional ext-plist to-buffer body-only pub-dir) - "Export the outline as a pretty HTML file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted -lists. EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local -settings. When TO-BUFFER is non-nil, create a buffer with that -name and export to that buffer. If TO-BUFFER is the symbol -`string', don't leave any buffer behind but just return the -resulting HTML as a string. When BODY-ONLY is set, don't produce -the file header and footer, simply return the content of -..., without even the body tags themselves. When -PUB-DIR is set, use this as the publishing directory." - (interactive "P") - (run-hooks 'org-export-first-hook) - - ;; Make sure we have a file name when we need it. - (when (and (not (or to-buffer body-only)) - (not buffer-file-name)) - (if (buffer-base-buffer) - (org-set-local 'buffer-file-name - (with-current-buffer (buffer-base-buffer) - buffer-file-name)) - (error "Need a file name to be able to export"))) - - (message "Exporting...") - (setq-default org-todo-line-regexp org-todo-line-regexp) - (setq-default org-deadline-line-regexp org-deadline-line-regexp) - (setq-default org-done-keywords org-done-keywords) - (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp) - (let* ((opt-plist - (org-export-process-option-filters - (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist)))) - (body-only (or body-only (plist-get opt-plist :body-only))) - (style (concat (if (plist-get opt-plist :style-include-default) - org-export-html-style-default) - (plist-get opt-plist :style) - (plist-get opt-plist :style-extra) - "\n" - (if (plist-get opt-plist :style-include-scripts) - org-export-html-scripts))) - (html-extension (plist-get opt-plist :html-extension)) - valid thetoc have-headings first-heading-pos - (odd org-odd-levels-only) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (level-offset (if subtree-p - (save-excursion - (goto-char rbeg) - (+ (funcall outline-level) - (if org-odd-levels-only 1 0))) - 0)) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-export-directory :html opt-plist))) - (org-current-export-file buffer-file-name) - (level 0) (org-line "") (origline "") txt todo - (umax nil) - (umax-toc nil) - (filename (if to-buffer nil - (expand-file-name - (concat - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory buffer-file-name))) - "." html-extension) - (file-name-as-directory - (or pub-dir (org-export-directory :html opt-plist)))))) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (auto-insert nil); Avoid any auto-insert stuff for the new file - (buffer (if to-buffer - (cond - ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*")) - (t (get-buffer-create to-buffer))) - (find-file-noselect filename))) - (org-levels-open (make-vector org-level-max nil)) - (date (org-html-expand (plist-get opt-plist :date))) - (author (org-html-expand (plist-get opt-plist :author))) - (html-validation-link (or org-export-html-validation-link "")) - (title (org-html-expand - (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not body-only) - (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "UNTITLED"))) - (link-up (and (plist-get opt-plist :link-up) - (string-match "\\S-" (plist-get opt-plist :link-up)) - (plist-get opt-plist :link-up))) - (link-home (and (plist-get opt-plist :link-home) - (string-match "\\S-" (plist-get opt-plist :link-home)) - (plist-get opt-plist :link-home))) - (dummy (setq opt-plist (plist-put opt-plist :title title))) - (html-table-tag (plist-get opt-plist :html-table-tag)) - (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)")) - (quote-re (format org-heading-keyword-regexp-format - org-quote-string)) - (inquote nil) - (infixed nil) - (inverse nil) - (email (plist-get opt-plist :email)) - (language (plist-get opt-plist :language)) - (keywords (org-html-expand (plist-get opt-plist :keywords))) - (description (org-html-expand (plist-get opt-plist :description))) - (num (plist-get opt-plist :section-numbers)) - (lang-words nil) - (head-count 0) cnt - (start 0) - (coding-system (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system)) - (coding-system-for-write (or org-export-html-coding-system - coding-system)) - (save-buffer-coding-system (or org-export-html-coding-system - coding-system)) - (charset (and coding-system-for-write - (fboundp 'coding-system-get) - (coding-system-get coding-system-for-write - 'mime-charset))) - (region - (buffer-substring - (if region-p (region-beginning) (point-min)) - (if region-p (region-end) (point-max)))) - (org-export-have-math nil) - (org-export-footnotes-seen nil) - (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) - (custom-id (or (org-entry-get nil "CUSTOM_ID" t) "")) - (footnote-def-prefix (format "fn-%s" custom-id)) - (footnote-ref-prefix (format "fnr-%s" custom-id)) - (lines - (org-split-string - (org-export-preprocess-string - region - :emph-multiline t - :for-backend 'html - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get opt-plist :drawers) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :timestamps (plist-get opt-plist :timestamps) - :archived-trees - (plist-get opt-plist :archived-trees) - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :add-text - (plist-get opt-plist :text) - :LaTeX-fragments - (plist-get opt-plist :LaTeX-fragments)) - "[\r\n]")) - (mathjax - (if (or (eq (plist-get opt-plist :LaTeX-fragments) 'mathjax) - (and org-export-have-math - (eq (plist-get opt-plist :LaTeX-fragments) t))) - - (org-export-html-mathjax-config - org-export-html-mathjax-template - org-export-html-mathjax-options - (or (plist-get opt-plist :mathjax) "")) - "")) - table-open - table-buffer table-orig-buffer - ind - rpl path attr desc descp desc1 desc2 link - snumber fnc - footnotes footref-seen - href) - - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (message "Exporting...") - - (setq org-min-level (org-get-min-level lines level-offset)) - (setq org-last-level org-min-level) - (org-init-section-numbers) - - (cond - ((and date (string-match "%" date)) - (setq date (format-time-string date))) - (date) - (t (setq date (format-time-string org-export-html-date-format-string)))) - - ;; Get the language-dependent settings - (setq lang-words (or (assoc language org-export-language-setup) - (assoc "en" org-export-language-setup))) - - ;; Switch to the output buffer - (set-buffer buffer) - (let ((inhibit-read-only t)) (erase-buffer)) - (fundamental-mode) - (org-install-letbind) - - (and (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system coding-system-for-write)) - - (let ((case-fold-search nil) - (org-odd-levels-only odd)) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc (if (integerp org-export-with-toc) - (min org-export-with-toc umax) - umax)) - (unless body-only - ;; File header - (insert (format - "%s - - - -%s - - - - - - - -%s -%s - - -%s -" - (format - (or (and (stringp org-export-html-xml-declaration) - org-export-html-xml-declaration) - (cdr (assoc html-extension org-export-html-xml-declaration)) - (cdr (assoc "html" org-export-html-xml-declaration)) - - "") - (or charset "iso-8859-1")) - language language - title - (or charset "iso-8859-1") - title date author description keywords - style - mathjax - (if (or link-up link-home) - (concat - (format org-export-html-home/up-format - (or link-up link-home) - (or link-home link-up)) - "\n") - ""))) - - ;; insert html preamble - (when (plist-get opt-plist :html-preamble) - (let ((html-pre (plist-get opt-plist :html-preamble)) - (html-pre-real-contents "")) - (cond ((stringp html-pre) - (setq html-pre-real-contents - (format-spec html-pre `((?t . ,title) (?a . ,author) - (?d . ,date) (?e . ,email))))) - ((functionp html-pre) - (insert "
    \n") - (if (stringp (funcall html-pre)) (insert (funcall html-pre))) - (insert "\n
    \n")) - (t - (setq html-pre-real-contents - (format-spec - (or (cadr (assoc (nth 0 lang-words) - org-export-html-preamble-format)) - (cadr (assoc "en" org-export-html-preamble-format))) - `((?t . ,title) (?a . ,author) - (?d . ,date) (?e . ,email)))))) - ;; don't output an empty preamble DIV - (unless (and (functionp html-pre) - (equal html-pre-real-contents "")) - (insert "
    \n") - (insert html-pre-real-contents) - (insert "\n
    \n")))) - - ;; begin wrap around body - (insert (format "\n
    " - ;; FIXME org-export-html-content-div is obsolete since 7.7 - (or org-export-html-content-div - (nth 1 org-export-html-divs))) - ;; FIXME this should go in the preamble but is here so - ;; that org-infojs can still find it - "\n

    " title "

    \n")) - - ;; insert body - (if org-export-with-toc - (progn - (push (format "%s\n" - org-export-html-toplevel-hlevel - (nth 3 lang-words) - org-export-html-toplevel-hlevel) - thetoc) - (push "
    \n" thetoc) - (push "
      \n
    • " thetoc) - (setq lines - (mapcar - #'(lambda (org-line) - (if (and (string-match org-todo-line-regexp org-line) - (not (get-text-property 0 'org-protected org-line))) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (save-match-data - (org-html-expand - (org-export-cleanup-toc-line - (match-string 3 org-line)))) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 org-line) - org-done-keywords))) - ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - org-line lines level)))) - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) - (setq txt (replace-match - "   \\1" t nil txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (setq snumber (org-section-number level)) - (if (and num (if (integerp num) - (>= num level) - num)) - (setq txt (concat snumber " " txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (if (<= level umax-toc) - (progn - (if (> level org-last-level) - (progn - (setq cnt (- level org-last-level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "\n
        \n
      • " thetoc)) - (push "\n" thetoc))) - (if (< level org-last-level) - (progn - (setq cnt (- org-last-level level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "
      • \n
      " thetoc)) - (push "\n" thetoc))) - ;; Check for targets - (while (string-match org-any-target-regexp org-line) - (setq org-line (replace-match - (concat "@" - (match-string 1 org-line) "@ ") - t t org-line))) - (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) - (setq txt (replace-match "" t t txt))) - (setq href - (replace-regexp-in-string - "\\." "-" (format "sec-%s" snumber))) - (setq href (org-solidify-link-text - (or (cdr (assoc href - org-export-preferred-target-alist)) href))) - (push - (format - (if todo - "
    • \n
    • %s" - "
    • \n
    • %s") - href txt) thetoc) - - (setq org-last-level level))))) - org-line) - lines)) - (while (> org-last-level (1- org-min-level)) - (setq org-last-level (1- org-last-level)) - (push "
    • \n
    \n" thetoc)) - (push "
    \n" thetoc) - (setq thetoc (if have-headings (nreverse thetoc) nil)))) - - (setq head-count 0) - (org-init-section-numbers) - - (org-open-par) - - (while (setq org-line (pop lines) origline org-line) - (catch 'nextline - - ;; end of quote section? - (when (and inquote (string-match org-outline-regexp-bol org-line)) - (insert "\n") - (org-open-par) - (setq inquote nil)) - ;; inside a quote section? - (when inquote - (insert (org-html-protect org-line) "\n") - (throw 'nextline nil)) - - ;; Fixed-width, verbatim lines (examples) - (when (and org-export-with-fixed-width - (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" org-line)) - (when (not infixed) - (setq infixed t) - (org-close-par-maybe) - - (insert "
    \n"))
    -	    (insert (org-html-protect (match-string 3 org-line)) "\n")
    -	    (when (or (not lines)
    -		      (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
    -					 (car lines))))
    -	      (setq infixed nil)
    -	      (insert "
    \n") - (org-open-par)) - (throw 'nextline nil)) - - ;; Protected HTML - (when (and (get-text-property 0 'org-protected org-line) - ;; Make sure it is the entire line that is protected - (not (< (or (next-single-property-change - 0 'org-protected org-line) 10000) - (length org-line)))) - (let (par (ind (get-text-property 0 'original-indentation org-line))) - (when (re-search-backward - "\\(

    \\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t) - (setq par (match-string 1)) - (replace-match "\\2\n")) - (insert org-line "\n") - (while (and lines - (or (= (length (car lines)) 0) - (not ind) - (equal ind (get-text-property 0 'original-indentation (car lines)))) - (or (= (length (car lines)) 0) - (get-text-property 0 'org-protected (car lines)))) - (insert (pop lines) "\n")) - (and par (insert "

    \n"))) - (throw 'nextline nil)) - - ;; Blockquotes, verse, and center - (when (equal "ORG-BLOCKQUOTE-START" org-line) - (org-close-par-maybe) - (insert "

    \n") - (org-open-par) - (throw 'nextline nil)) - (when (equal "ORG-BLOCKQUOTE-END" org-line) - (org-close-par-maybe) - (insert "\n
    \n") - (org-open-par) - (throw 'nextline nil)) - (when (equal "ORG-VERSE-START" org-line) - (org-close-par-maybe) - (insert "\n

    \n") - (setq org-par-open t) - (setq inverse t) - (throw 'nextline nil)) - (when (equal "ORG-VERSE-END" org-line) - (insert "

    \n") - (setq org-par-open nil) - (org-open-par) - (setq inverse nil) - (throw 'nextline nil)) - (when (equal "ORG-CENTER-START" org-line) - (org-close-par-maybe) - (insert "\n
    ") - (org-open-par) - (throw 'nextline nil)) - (when (equal "ORG-CENTER-END" org-line) - (org-close-par-maybe) - (insert "\n
    ") - (org-open-par) - (throw 'nextline nil)) - (run-hooks 'org-export-html-after-blockquotes-hook) - (when inverse - (let ((i (org-get-string-indentation org-line))) - (if (> i 0) - (setq org-line (concat (mapconcat 'identity - (make-list (* 2 i) "\\nbsp") "") - " " (org-trim org-line)))) - (unless (string-match "\\\\\\\\[ \t]*$" org-line) - (setq org-line (concat org-line "\\\\"))))) - - ;; make targets to anchors - (setq start 0) - (while (string-match - "<<]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" org-line start) - (cond - ((get-text-property (match-beginning 1) 'org-protected org-line) - (setq start (match-end 1))) - ((match-end 2) - (setq org-line (replace-match - (format - "@@" - (org-solidify-link-text (match-string 1 org-line)) - (org-solidify-link-text (match-string 1 org-line))) - t t org-line))) - ((and org-export-with-toc (equal (string-to-char org-line) ?*)) - ;; FIXME: NOT DEPENDENT on TOC????????????????????? - (setq org-line (replace-match - (concat "@" - (match-string 1 org-line) "@ ") - ;; (concat "@" (match-string 1 org-line) "@ ") - t t org-line))) - (t - (setq org-line (replace-match - (concat "@" (match-string 1 org-line) - "@ ") - t t org-line))))) - - (setq org-line (org-html-handle-time-stamps org-line)) - - ;; replace "&" by "&", "<" and ">" by "<" and ">" - ;; handle @<..> HTML tags (replace "@>..<" by "<..>") - ;; Also handle sub_superscripts and checkboxes - (or (string-match org-table-hline-regexp org-line) - (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" org-line) - (setq org-line (org-html-expand org-line))) - - ;; Format the links - (setq org-line (org-html-handle-links org-line opt-plist)) - - ;; TODO items - (if (and org-todo-line-regexp - (string-match org-todo-line-regexp org-line) - (match-beginning 2)) - - (setq org-line - (concat (substring org-line 0 (match-beginning 2)) - "" (match-string 2 org-line) - "" (substring org-line (match-end 2))))) - - ;; Does this contain a reference to a footnote? - (when org-export-with-footnotes - (setq start 0) - (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" org-line start) - ;; Discard protected matches not clearly identified as - ;; footnote markers. - (if (or (get-text-property (match-beginning 2) 'org-protected org-line) - (not (get-text-property (match-beginning 2) 'org-footnote org-line))) - (setq start (match-end 2)) - (let ((n (match-string 2 org-line)) extra a) - (if (setq a (assoc n footref-seen)) - (progn - (setcdr a (1+ (cdr a))) - (setq extra (format ".%d" (cdr a)))) - (setq extra "") - (push (cons n 1) footref-seen)) - (setq org-line - (replace-match - (concat - (format - (concat "%s" - (format org-export-html-footnote-format - (concat "%s"))) - (or (match-string 1 org-line) "") n extra n n) - ;; If another footnote is following the - ;; current one, add a separator. - (if (save-match-data - (string-match "\\`\\[[0-9]+\\]" - (substring org-line (match-end 0)))) - org-export-html-footnote-separator - "")) - t t org-line)))))) - - (cond - ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" org-line) - ;; This is a headline - (setq level (org-tr-level (- (match-end 1) (match-beginning 1) - level-offset)) - txt (or (match-string 2 org-line) "")) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (setq first-heading-pos (or first-heading-pos (point))) - (org-html-level-start level txt umax - (and org-export-with-toc (<= level umax)) - head-count opt-plist) - - ;; QUOTES - (when (string-match quote-re org-line) - (org-close-par-maybe) - (insert "
    ")
    -	      (setq inquote t)))
    -
    -	   ((and org-export-with-tables
    -		 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" org-line))
    -	    (when (not table-open)
    -	      ;; New table starts
    -	      (setq table-open t table-buffer nil table-orig-buffer nil))
    -
    -	    ;; Accumulate lines
    -	    (setq table-buffer (cons org-line table-buffer)
    -		  table-orig-buffer (cons origline table-orig-buffer))
    -	    (when (or (not lines)
    -		      (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
    -					 (car lines))))
    -	      (setq table-open nil
    -		    table-buffer (nreverse table-buffer)
    -		    table-orig-buffer (nreverse table-orig-buffer))
    -	      (org-close-par-maybe)
    -	      (insert (org-format-table-html table-buffer table-orig-buffer))))
    -
    -	   ;; Normal lines
    -
    -	   (t
    -	    ;; This line either is list item or end a list.
    -	    (when (get-text-property 0 'list-item org-line)
    -	      (setq org-line (org-html-export-list-line
    -			      org-line
    -			      (get-text-property 0 'list-item org-line)
    -			      (get-text-property 0 'list-struct org-line)
    -			      (get-text-property 0 'list-prevs org-line))))
    -
    -	    ;; Horizontal line
    -	    (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" org-line)
    -	      (if org-par-open
    -		  (insert "\n

    \n
    \n

    \n") - (insert "\n


    \n")) - (throw 'nextline nil)) - - ;; Empty lines start a new paragraph. If hand-formatted lists - ;; are not fully interpreted, lines starting with "-", "+", "*" - ;; also start a new paragraph. - (if (string-match "^ [-+*]-\\|^[ \t]*$" org-line) (org-open-par)) - - ;; Is this the start of a footnote? - (when org-export-with-footnotes - (when (and (boundp 'footnote-section-tag-regexp) - (string-match (concat "^" footnote-section-tag-regexp) - org-line)) - ;; ignore this line - (throw 'nextline nil)) - (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" org-line) - (org-close-par-maybe) - (let ((n (match-string 1 org-line))) - (setq org-par-open t - org-line (replace-match - (format - (concat "

    " - (format org-export-html-footnote-format - (concat - "%s"))) - n n n) t t org-line))))) - ;; Check if the line break needs to be conserved - (cond - ((string-match "\\\\\\\\[ \t]*$" org-line) - (setq org-line (replace-match "
    " t t org-line))) - (org-export-preserve-breaks - (setq org-line (concat org-line "
    ")))) - - ;; Check if a paragraph should be started - (let ((start 0)) - (while (and org-par-open - (string-match "\\\\par\\>" org-line start)) - ;; Leave a space in the

    so that the footnote matcher - ;; does not see this. - (if (not (get-text-property (match-beginning 0) - 'org-protected org-line)) - (setq org-line (replace-match "

    " t t org-line))) - (setq start (match-end 0)))) - - (insert org-line "\n"))))) - - ;; Properly close all local lists and other lists - (when inquote - (insert "

    \n") - (org-open-par)) - - (org-html-level-start 1 nil umax - (and org-export-with-toc (<= level umax)) - head-count opt-plist) - ;; the
    to close the last text-... div. - (when (and (> umax 0) first-heading-pos) (insert "\n")) - - (save-excursion - (goto-char (point-min)) - (while (re-search-forward - "\\(\\(

    \\)[^\000]*?\\)\\(\\(\\2\\)\\|\\'\\)" - nil t) - (push (match-string 1) footnotes) - (replace-match "\\4" t nil) - (goto-char (match-beginning 0)))) - (when footnotes - (insert (format org-export-html-footnotes-section - (nth 4 lang-words) - (mapconcat 'identity (nreverse footnotes) "\n")) - "\n")) - (let ((bib (org-export-html-get-bibliography))) - (when bib - (insert "\n" bib "\n"))) - - (unless body-only - ;; end wrap around body - (insert "\n") - - ;; export html postamble - (let ((html-post (plist-get opt-plist :html-postamble)) - (email - (mapconcat (lambda(e) - (format "%s" e e)) - (split-string email ",+ *") - ", ")) - (creator-info - (concat "Org version " - (org-version) " with Emacs version " - (number-to-string emacs-major-version)))) - - (when (plist-get opt-plist :html-postamble) - (insert "\n

    \n") - (cond ((stringp html-post) - (insert (format-spec html-post - `((?a . ,author) (?e . ,email) - (?d . ,date) (?c . ,creator-info) - (?v . ,html-validation-link))))) - ((functionp html-post) - (if (stringp (funcall html-post)) (insert (funcall html-post)))) - ((eq html-post 'auto) - ;; fall back on default postamble - (when (plist-get opt-plist :time-stamp-file) - (insert "

    " (nth 2 lang-words) ": " date "

    \n")) - (when (and (plist-get opt-plist :author-info) author) - (insert "

    " (nth 1 lang-words) ": " author "

    \n")) - (when (and (plist-get opt-plist :email-info) email) - (insert "

    " email "

    \n")) - (when (plist-get opt-plist :creator-info) - (insert "

    " - (concat "Org version " - (org-version) " with Emacs version " - (number-to-string emacs-major-version) "

    \n"))) - (insert html-validation-link "\n")) - (t - (insert (format-spec - (or (cadr (assoc (nth 0 lang-words) - org-export-html-postamble-format)) - (cadr (assoc "en" org-export-html-postamble-format))) - `((?a . ,author) (?e . ,email) - (?d . ,date) (?c . ,creator-info) - (?v . ,html-validation-link)))))) - (insert "\n
    ")))) - - ;; FIXME `org-export-html-with-timestamp' has been declared - ;; obsolete since Org 7.7 -- don't forget to remove this. - (if org-export-html-with-timestamp - (insert org-export-html-html-helper-timestamp)) - - (unless body-only (insert "\n\n\n")) - - (unless (plist-get opt-plist :buffer-will-be-killed) - (normal-mode) - (if (eq major-mode (default-value 'major-mode)) - (html-mode))) - - ;; insert the table of contents - (goto-char (point-min)) - (when thetoc - (if (or (re-search-forward - "

    \\s-*\\[TABLE-OF-CONTENTS\\]\\s-*

    " nil t) - (re-search-forward - "\\[TABLE-OF-CONTENTS\\]" nil t)) - (progn - (goto-char (match-beginning 0)) - (replace-match "")) - (goto-char first-heading-pos) - (when (looking-at "\\s-*

    ") - (goto-char (match-end 0)) - (insert "\n"))) - (insert "
    \n") - (let ((beg (point))) - (mapc 'insert thetoc) - (insert "
    \n") - (while (re-search-backward "
  • [ \r\n\t]*
  • \n?" beg t) - (replace-match "")))) - ;; remove empty paragraphs - (goto-char (point-min)) - (while (re-search-forward "

    [ \r\n\t]*

    " nil t) - (replace-match "")) - (goto-char (point-min)) - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end n) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq n (get-text-property beg 'org-whitespace) - end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (format "%s" - (make-string n ?x))))) - ;; Remove empty lines at the beginning of the file. - (goto-char (point-min)) - (when (looking-at "\\s-+\n") (replace-match "")) - ;; Remove display properties - (remove-text-properties (point-min) (point-max) '(display t)) - ;; Run the hook - (run-hooks 'org-export-html-final-hook) - (or to-buffer (save-buffer)) - (goto-char (point-min)) - (or (org-export-push-to-kill-ring "HTML") - (message "Exporting... done")) - (if (eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer))) - (current-buffer))))) - -(defun org-export-html-format-href (s) - "Make sure the S is valid as a href reference in an XHTML document." - (save-match-data - (let ((start 0)) - (while (string-match "&" s start) - (setq start (+ (match-beginning 0) 3) - s (replace-match "&" t t s))))) - s) - -(defun org-export-html-format-desc (s) - "Make sure the S is valid as a description in a link." - (if (and s (not (get-text-property 1 'org-protected s))) - (save-match-data - (org-html-do-expand s)) - s)) - -(defun org-export-html-format-image (src par-open) - "Create image tag with source and attributes." - (save-match-data - (if (string-match (regexp-quote org-latex-preview-ltxpng-directory) src) - (format "\"%s\"/" - src (org-find-text-property-in-string 'org-latex-src src)) - (let* ((caption (org-find-text-property-in-string 'org-caption src)) - (attr (org-find-text-property-in-string 'org-attributes src)) - (label (org-find-text-property-in-string 'org-label src))) - (setq caption (and caption (org-html-do-expand caption))) - (concat - (if caption - (format "%s
    -

    " - (if org-par-open "

    \n" "") - (if label (format "id=\"%s\" " (org-solidify-link-text label)) ""))) - (format "" - src - (if (string-match "\\%s -
    %s" - (concat "\n

    " caption "

    ") - (if org-par-open "\n

    " "")))))))) - -(defun org-export-html-get-bibliography () - "Find bibliography, cut it out and return it." - (catch 'exit - (let (beg end (cnt 1) bib) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward "^[ \t]*

    " nil t) - (setq cnt (+ cnt (if (string= (match-string 0) "") (forward-char 1)) - (setq bib (buffer-substring beg (point))) - (delete-region beg (point)) - (throw 'exit bib)))) - nil)))) - -(defvar org-table-number-regexp) ; defined in org-table.el -(defun org-format-table-html (lines olines &optional no-css) - "Find out which HTML converter to use and return the HTML code. -NO-CSS is passed to the exporter." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (string-match "^[ \t]*|" (car lines)) - ;; A normal org table - (org-format-org-table-html lines nil no-css) - ;; Table made by table.el - (or (org-format-table-table-html-using-table-generate-source - olines (not org-export-prefer-native-exporter-for-tables)) - ;; We are here only when table.el table has NO col or row - ;; spanning and the user prefers using org's own converter for - ;; exporting of such simple table.el tables. - (org-format-table-table-html lines)))) - -(defvar org-table-number-fraction) ; defined in org-table.el -(defun org-format-org-table-html (lines &optional splice no-css) - "Format a table into HTML. -LINES is a list of lines. Optional argument SPLICE means, do not -insert header and surrounding
    " . "
    tags, just format the lines. -Optional argument NO-CSS means use XHTML attributes instead of CSS -for formatting. This is required for the DocBook exporter." - (require 'org-table) - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; column and the special lines - (setq lines (org-table-clean-before-export lines))) - - (let* ((caption (org-find-text-property-in-string 'org-caption (car lines))) - (label (org-find-text-property-in-string 'org-label (car lines))) - (col-cookies (org-find-text-property-in-string 'org-col-cookies - (car lines))) - (attributes (org-find-text-property-in-string 'org-attributes - (car lines))) - (html-table-tag (org-export-splice-attributes - html-table-tag attributes)) - (head (and org-export-highlight-first-table-line - (delq nil (mapcar - (lambda (x) (string-match "^[ \t]*|-" x)) - (cdr lines))))) - (nline 0) fnum nfields i (cnt 0) - tbopen org-line fields html gr colgropen rowstart rowend - ali align aligns n) - (setq caption (and caption (org-html-do-expand caption))) - (when (and col-cookies org-table-clean-did-remove-column) - (setq col-cookies - (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies))) - (if splice (setq head nil)) - (unless splice (push (if head "" "") html)) - (setq tbopen t) - (while (setq org-line (pop lines)) - (catch 'next-line - (if (string-match "^[ \t]*|-" org-line) - (progn - (unless splice - (push (if head "" "") html) - (if lines (push "" html) (setq tbopen nil))) - (setq head nil) ;; head ends here, first time around - ;; ignore this line - (throw 'next-line t))) - ;; Break the line into fields - (setq fields (org-split-string org-line "[ \t]*|[ \t]*")) - (unless fnum (setq fnum (make-vector (length fields) 0) - nfields (length fnum))) - (setq nline (1+ nline) i -1 - rowstart (eval (car org-export-table-row-tags)) - rowend (eval (cdr org-export-table-row-tags))) - (push (concat rowstart - (mapconcat - (lambda (x) - (setq i (1+ i) ali (format "@@class%03d@@" i)) - (if (and (< i nfields) ; make sure no rogue line causes an error here - (string-match org-table-number-regexp x)) - (incf (aref fnum i))) - (cond - (head - (concat - (format (car org-export-table-header-tags) - "col" ali) - x - (cdr org-export-table-header-tags))) - ((and (= i 0) org-export-html-table-use-header-tags-for-first-column) - (concat - (format (car org-export-table-header-tags) - "row" ali) - x - (cdr org-export-table-header-tags))) - (t - (concat (format (car org-export-table-data-tags) ali) - x - (cdr org-export-table-data-tags))))) - fields "") - rowend) - html))) - (unless splice (if tbopen (push "" html))) - (unless splice (push "
    \n" html)) - (setq html (nreverse html)) - (unless splice - ;; Put in col tags with the alignment (unfortunately often ignored...) - (unless (car org-table-colgroup-info) - (setq org-table-colgroup-info - (cons :start (cdr org-table-colgroup-info)))) - (setq i 0) - (push (mapconcat - (lambda (x) - (setq gr (pop org-table-colgroup-info) - i (1+ i) - align (if (nth 1 (assoc i col-cookies)) - (cdr (assoc (nth 1 (assoc i col-cookies)) - '(("l" . "left") ("r" . "right") - ("c" . "center")))) - (if (> (/ (float x) nline) - org-table-number-fraction) - "right" "left"))) - (push align aligns) - (format (if no-css - "%s%s" - "%s%s") - (if (memq gr '(:start :startend)) - (prog1 - (if colgropen - "\n" - "") - (setq colgropen t)) - "") - align - (if (memq gr '(:end :startend)) - (progn (setq colgropen nil) "") - ""))) - fnum "") - html) - (setq aligns (nreverse aligns)) - (if colgropen (setq html (cons (car html) - (cons "" (cdr html))))) - ;; Since the output of HTML table formatter can also be used in - ;; DocBook document, include empty captions for the DocBook - ;; export only so that it produces valid XML. - (when (or caption (eq org-export-current-backend 'docbook)) - (push (format "%s" (or caption "")) html)) - (when label - (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label))))) - (push html-table-tag html)) - (setq html (mapcar - (lambda (x) - (replace-regexp-in-string - "@@class\\([0-9]+\\)@@" - (lambda (txt) - (if (not org-export-html-table-align-individual-fields) - "" - (setq n (string-to-number (match-string 1 txt))) - (format (if no-css " align=\"%s\"" " class=\"%s\"") - (or (nth n aligns) "left")))) - x)) - html)) - (concat (mapconcat 'identity html "\n") "\n"))) - -(defun org-export-splice-attributes (tag attributes) - "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG." - (if (not attributes) - tag - (let (oldatt newatt) - (setq oldatt (org-extract-attributes-from-string tag) - tag (pop oldatt) - newatt (cdr (org-extract-attributes-from-string attributes))) - (while newatt - (setq oldatt (plist-put oldatt (pop newatt) (pop newatt)))) - (if (string-match ">" tag) - (setq tag - (replace-match (concat (org-attributes-to-string oldatt) ">") - t t tag))) - tag))) - -(defun org-format-table-table-html (lines) - "Format a table generated by table.el into HTML. -This conversion does *not* use `table-generate-source' from table.el. -This has the advantage that Org-mode's HTML conversions can be used. -But it has the disadvantage, that no cell- or row-spanning is allowed." - (let (org-line field-buffer - (head org-export-highlight-first-table-line) - fields html empty i) - (setq html (concat html-table-tag "\n")) - (while (setq org-line (pop lines)) - (setq empty " ") - (catch 'next-line - (if (string-match "^[ \t]*\\+-" org-line) - (progn - (if field-buffer - (progn - (setq - html - (concat - html - "" - (mapconcat - (lambda (x) - (if (equal x "") (setq x empty)) - (if head - (concat - (format (car org-export-table-header-tags) "col" "") - x - (cdr org-export-table-header-tags)) - (concat (format (car org-export-table-data-tags) "") x - (cdr org-export-table-data-tags)))) - field-buffer "\n") - "\n")) - (setq head nil) - (setq field-buffer nil))) - ;; Ignore this line - (throw 'next-line t))) - ;; Break the line into fields and store the fields - (setq fields (org-split-string org-line "[ \t]*|[ \t]*")) - (if field-buffer - (setq field-buffer (mapcar - (lambda (x) - (concat x "
    " (pop fields))) - field-buffer)) - (setq field-buffer fields)))) - (setq html (concat html "\n")) - html)) - -(defun org-format-table-table-html-using-table-generate-source (lines - &optional - spanned-only) - "Format a table into html, using `table-generate-source' from table.el. -Use SPANNED-ONLY to suppress exporting of simple table.el tables. - -When SPANNED-ONLY is nil, all table.el tables are exported. When -SPANNED-ONLY is non-nil, only tables with either row or column -spans are exported. - -This routine returns the generated source or nil as appropriate. - -Refer docstring of `org-export-prefer-native-exporter-for-tables' -for further information." - (require 'table) - (with-current-buffer (get-buffer-create " org-tmp1 ") - (erase-buffer) - (insert (mapconcat 'identity lines "\n")) - (goto-char (point-min)) - (if (not (re-search-forward "|[^+]" nil t)) - (error "Error processing table")) - (table-recognize-table) - (when (or (not spanned-only) - (let* ((dim (table-query-dimension)) - (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim))) - (not (= (* c r) cells)))) - (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) - (table-generate-source 'html " org-tmp2 ") - (set-buffer " org-tmp2 ") - (buffer-substring (point-min) (point-max))))) - -(defun org-export-splice-style (style extra) - "Splice EXTRA into STYLE, just before \"\"." - (if (and (stringp extra) - (string-match "\\S-" extra) - (string-match "" style)) - (concat (substring style 0 (match-beginning 0)) - "\n" extra "\n" - (substring style (match-beginning 0))) - style)) - -(defun org-html-handle-time-stamps (s) - "Format time stamps in string S, or remove them." - (catch 'exit - (let (r b) - (when org-maybe-keyword-time-regexp - (while (string-match org-maybe-keyword-time-regexp s) - (or b (setq b (substring s 0 (match-beginning 0)))) - (setq r (concat - r (substring s 0 (match-beginning 0)) - " @" - (if (match-end 1) - (format "@%s @" - (match-string 1 s))) - (format " @%s@" - (substring - (org-translate-time (match-string 3 s)) 1 -1)) - "@") - s (substring s (match-end 0))))) - ;; Line break if line started and ended with time stamp stuff - (if (not r) - s - (setq r (concat r s)) - (unless (string-match "\\S-" (concat b s)) - (setq r (concat r "@
    "))) - r)))) - -(defvar htmlize-buffer-places) ; from htmlize.el -(defun org-export-htmlize-region-for-paste (beg end) - "Convert the region to HTML, using htmlize.el. -This is much like `htmlize-region-for-paste', only that it uses -the settings define in the org-... variables." - (let* ((htmlize-output-type org-export-htmlize-output-type) - (htmlize-css-name-prefix org-export-htmlize-css-font-prefix) - (htmlbuf (htmlize-region beg end))) - (unwind-protect - (with-current-buffer htmlbuf - (buffer-substring (plist-get htmlize-buffer-places 'content-start) - (plist-get htmlize-buffer-places 'content-end))) - (kill-buffer htmlbuf)))) - -(defun org-export-htmlize-generate-css () - "Create the CSS for all font definitions in the current Emacs session. -Use this to create face definitions in your CSS style file that can then -be used by code snippets transformed by htmlize. -This command just produces a buffer that contains class definitions for all -faces used in the current Emacs session. You can copy and paste the ones you -need into your CSS file. - -If you then set `org-export-htmlize-output-type' to `css', calls to -the function `org-export-htmlize-region-for-paste' will produce code -that uses these same face definitions." - (interactive) - (require 'htmlize) - (and (get-buffer "*html*") (kill-buffer "*html*")) - (with-temp-buffer - (let ((fl (face-list)) - (htmlize-css-name-prefix "org-") - (htmlize-output-type 'css) - f i) - (while (setq f (pop fl) - i (and f (face-attribute f :inherit))) - (when (and (symbolp f) (or (not i) (not (listp i)))) - (insert (org-add-props (copy-sequence "1") nil 'face f)))) - (htmlize-region (point-min) (point-max)))) - (org-pop-to-buffer-same-window "*html*") - (goto-char (point-min)) - (if (re-search-forward "" nil t) - (delete-region (1+ (match-end 0)) (point-max))) - (beginning-of-line 1) - (if (looking-at " +") (replace-match "")) - (goto-char (point-min))) - -(defun org-html-protect (s) - "Convert characters to HTML equivalent. -Possible conversions are set in `org-export-html-protect-char-alist'." - (let ((cl org-export-html-protect-char-alist) c) - (while (setq c (pop cl)) - (let ((start 0)) - (while (string-match (car c) s start) - (setq s (replace-match (cdr c) t t s) - start (1+ (match-beginning 0)))))) - s)) - -(defun org-html-expand (string) - "Prepare STRING for HTML export. Apply all active conversions. -If there are links in the string, don't modify these. If STRING -is nil, return nil." - (when string - (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) - m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-html-do-expand s) res) - (push l res)) - (push (org-html-do-expand string) res) - (apply 'concat (nreverse res))))) - -(defun org-html-do-expand (s) - "Apply all active conversions to translate special ASCII to HTML." - (setq s (org-html-protect s)) - (if org-export-html-expand - (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" t nil s)))) - (if org-export-with-emphasize - (setq s (org-export-html-convert-emphasize s))) - (if org-export-with-special-strings - (setq s (org-export-html-convert-special-strings s))) - (if org-export-with-sub-superscripts - (setq s (org-export-html-convert-sub-super s))) - (if org-export-with-TeX-macros - (let ((start 0) wd rep) - (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" - s start)) - (if (get-text-property (match-beginning 0) 'org-protected s) - (setq start (match-end 0)) - (setq wd (match-string 1 s)) - (if (setq rep (org-entity-get-representation wd 'html)) - (setq s (replace-match rep t t s)) - (setq start (+ start (length wd)))))))) - s) - -(defun org-export-html-convert-special-strings (string) - "Convert special characters in STRING to HTML." - (let ((all org-export-html-special-string-regexps) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (if (get-text-property (match-beginning 0) 'org-protected string) - (setq start (match-end 0)) - (setq string (replace-match rpl t nil string))))) - string)) - -(defun org-export-html-convert-sub-super (string) - "Convert sub- and superscripts in STRING to HTML." - (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) - (while (string-match org-match-substring-regexp string s) - (cond - ((and requireb (match-end 8)) (setq s (match-end 2))) - ((get-text-property (match-beginning 2) 'org-protected string) - (setq s (match-end 2))) - (t - (setq s (match-end 1) - key (if (string= (match-string 2 string) "_") "sub" "sup") - c (or (match-string 8 string) - (match-string 6 string) - (match-string 5 string)) - string (replace-match - (concat (match-string 1 string) - "<" key ">" c "") - t t string))))) - (while (string-match "\\\\\\([_^]\\)" string) - (setq string (replace-match (match-string 1 string) t t string))) - string)) - -(defun org-export-html-convert-emphasize (string) - "Apply emphasis." - (let ((s 0) rpl) - (while (string-match org-emph-re string s) - (if (not (equal - (substring string (match-beginning 3) (1+ (match-beginning 3))) - (substring string (match-beginning 4) (1+ (match-beginning 4))))) - (setq s (match-beginning 0) - rpl - (concat - (match-string 1 string) - (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) - (match-string 4 string) - (nth 3 (assoc (match-string 3 string) - org-emphasis-alist)) - (match-string 5 string)) - string (replace-match rpl t t string) - s (+ s (- (length rpl) 2))) - (setq s (1+ s)))) - string)) - -(defun org-open-par () - "Insert

    , but first close previous paragraph if any." - (org-close-par-maybe) - (insert "\n

    ") - (setq org-par-open t)) -(defun org-close-par-maybe () - "Close paragraph if there is one open." - (when org-par-open - (insert "

    ") - (setq org-par-open nil))) -(defun org-close-li (&optional type) - "Close
  • if necessary." - (org-close-par-maybe) - (insert (if (equal type "d") "\n" "
  • \n"))) - -(defvar body-only) ; dynamically scoped into this. -(defun org-html-level-start (level title umax with-toc head-count &optional opt-plist) - "Insert a new level in HTML export. -When TITLE is nil, just close all open levels." - (org-close-par-maybe) - (let* ((target (and title (org-get-text-property-any 0 'target title))) - (extra-targets (and target - (assoc target org-export-target-aliases))) - (extra-class (and title (org-get-text-property-any 0 'html-container-class title))) - (preferred (and target - (cdr (assoc target org-export-preferred-target-alist)))) - (l org-level-max) - (num (plist-get opt-plist :section-numbers)) - snumber snu href suffix) - (setq extra-targets (remove (or preferred target) extra-targets)) - (setq extra-targets - (mapconcat (lambda (x) - (setq x (org-solidify-link-text - (if (org-uuidgen-p x) (concat "ID-" x) x))) - (if (stringp org-export-html-headline-anchor-format) - (format org-export-html-headline-anchor-format x x) - "")) - extra-targets - "")) - (while (>= l level) - (if (aref org-levels-open (1- l)) - (progn - (org-html-level-close l umax) - (aset org-levels-open (1- l) nil))) - (setq l (1- l))) - (when title - ;; If title is nil, this means this function is called to close - ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) - (setq title (replace-match - (if org-export-with-tags - (save-match-data - (concat - "   " - (mapconcat - (lambda (x) - (format "%s" - (org-export-html-get-tag-class-name x) - x)) - (org-split-string (match-string 1 title) ":") - " ") - "")) - "") - t t title))) - (if (> level umax) - (progn - (if (aref org-levels-open (1- level)) - (progn - (org-close-li) - (if target - (insert (format "
  • " (org-solidify-link-text (or preferred target))) - extra-targets title "
    \n") - (insert "
  • " title "
    \n"))) - (aset org-levels-open (1- level) t) - (org-close-par-maybe) - (if target - (insert (format "
      \n
    • " (org-solidify-link-text (or preferred target))) - extra-targets title "
      \n") - (insert "
        \n
      • " title "
        \n")))) - (aset org-levels-open (1- level) t) - (setq snumber (org-section-number level) - snu (replace-regexp-in-string "\\." "-" snumber)) - (setq level (+ level org-export-html-toplevel-hlevel -1)) - (if (and num (not body-only)) - (setq title (concat - (format "%s" - level - (if (and num - (if (integerp num) - ;; fix up num to take into - ;; account the top-level - ;; heading value - (>= (+ num org-export-html-toplevel-hlevel -1) - level) - num)) - snumber - "")) - " " title))) - (unless (= head-count 1) (insert "\n
  • \n")) - (setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist))) - (setq suffix (org-solidify-link-text (or href snu))) - (setq href (org-solidify-link-text (or href (concat "sec-" snu)))) - (insert (format "\n
    \n%s%s\n
    \n" - suffix level (if extra-class (concat " " extra-class) "") - level href - extra-targets - title level level suffix)) - (org-open-par))))) - -(defun org-export-html-get-tag-class-name (tag) - "Turn tag into a valid class name. -Replaces invalid characters with \"_\" and then prepends a prefix." - (save-match-data - (while (string-match "[^a-zA-Z0-9_]" tag) - (setq tag (replace-match "_" t t tag)))) - (concat org-export-html-tag-class-prefix tag)) - -(defun org-export-html-get-todo-kwd-class-name (kwd) - "Turn todo keyword into a valid class name. -Replaces invalid characters with \"_\" and then prepends a prefix." - (save-match-data - (while (string-match "[^a-zA-Z0-9_]" kwd) - (setq kwd (replace-match "_" t t kwd)))) - (concat org-export-html-todo-kwd-class-prefix kwd)) - -(defun org-html-level-close (level max-outline-level) - "Terminate one level in HTML export." - (if (<= level max-outline-level) - (insert "
    \n") - (org-close-li) - (insert "\n"))) - -(defun org-html-export-list-line (org-line pos struct prevs) - "Insert list syntax in export buffer. Return ORG-LINE, maybe modified. - -POS is the item position or org-line position the org-line had before -modifications to buffer. STRUCT is the list structure. PREVS is -the alist of previous items." - (let* ((get-type - (function - ;; Translate type of list containing POS to "d", "o" or - ;; "u". - (lambda (pos struct prevs) - (let ((type (org-list-get-list-type pos struct prevs))) - (cond - ((eq 'ordered type) "o") - ((eq 'descriptive type) "d") - (t "u")))))) - (get-closings - (function - ;; Return list of all items and sublists ending at POS, in - ;; reverse order. - (lambda (pos) - (let (out) - (catch 'exit - (mapc (lambda (e) - (let ((end (nth 6 e)) - (item (car e))) - (cond - ((= end pos) (push item out)) - ((>= item pos) (throw 'exit nil))))) - struct)) - out))))) - ;; First close any previous item, or list, ending at POS. - (mapc (lambda (e) - (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) - (first-item (org-list-get-list-begin e struct prevs)) - (type (funcall get-type first-item struct prevs))) - (org-close-par-maybe) - ;; Ending for every item - (org-close-li type) - ;; We're ending last item of the list: end list. - (when lastp - (insert (format "\n" type)) - (org-open-par)))) - (funcall get-closings pos)) - (cond - ;; At an item: insert appropriate tags in export buffer. - ((assq pos struct) - (string-match - (concat "[ \t]*\\(\\S-+[ \t]*\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" - "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" - "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?" - "\\(.*\\)") org-line) - (let* ((checkbox (match-string 3 org-line)) - (desc-tag (or (match-string 4 org-line) "???")) - (body (or (match-string 5 org-line) "")) - (list-beg (org-list-get-list-begin pos struct prevs)) - (firstp (= list-beg pos)) - ;; Always refer to first item to determine list type, in - ;; case list is ill-formed. - (type (funcall get-type list-beg struct prevs)) - (counter (let ((count-tmp (org-list-get-counter pos struct))) - (cond - ((not count-tmp) nil) - ((string-match "[A-Za-z]" count-tmp) - (- (string-to-char (upcase count-tmp)) 64)) - ((string-match "[0-9]+" count-tmp) - count-tmp))))) - (when firstp - (org-close-par-maybe) - (insert (format "<%sl>\n" type))) - (insert (cond - ((equal type "d") - (format "
    %s
    " desc-tag)) - ((and (equal type "o") counter) - (format "
  • " counter)) - (t "
  • "))) - ;; If line had a checkbox, some additional modification is required. - (when checkbox - (setq body - (concat - (cond - ((string-match "X" checkbox) "[X] ") - ((string-match " " checkbox) "[ ] ") - (t "[-] ")) - body))) - ;; Return modified line - body)) - ;; At a list ender: go to next line (side-effects only). - ((equal "ORG-LIST-END-MARKER" org-line) (throw 'nextline nil)) - ;; Not at an item: return line unchanged (side-effects only). - (t org-line)))) - -(provide 'org-html) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-html.el ends here diff --git a/lisp/org-icalendar.el b/lisp/org-icalendar.el deleted file mode 100644 index 12cd0584f..000000000 --- a/lisp/org-icalendar.el +++ /dev/null @@ -1,692 +0,0 @@ -;;; org-icalendar.el --- iCalendar export for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;;; Code: - -(require 'org-exp) - -(eval-when-compile (require 'cl)) - -(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) - -(defgroup org-export-icalendar nil - "Options specific for iCalendar export of Org-mode files." - :tag "Org Export iCalendar" - :group 'org-export) - -(defcustom org-combined-agenda-icalendar-file "~/org.ics" - "The file name for the iCalendar file covering all agenda files. -This file is created with the command \\[org-export-icalendar-all-agenda-files]. -The file name should be absolute, the file will be overwritten without warning." - :group 'org-export-icalendar - :type 'file) - -(defcustom org-icalendar-alarm-time 0 - "Number of minutes for triggering an alarm for exported timed events. -A zero value (the default) turns off the definition of an alarm trigger -for timed events. If non-zero, alarms are created. - -- a single alarm per entry is defined -- The alarm will go off N minutes before the event -- only a DISPLAY action is defined." - :group 'org-export-icalendar - :version "24.1" - :type 'integer) - -(defcustom org-icalendar-combined-name "OrgMode" - "Calendar name for the combined iCalendar representing all agenda files." - :group 'org-export-icalendar - :type 'string) - -(defcustom org-icalendar-combined-description nil - "Calendar description for the combined iCalendar (all agenda files)." - :group 'org-export-icalendar - :version "24.1" - :type 'string) - -(defcustom org-icalendar-use-plain-timestamp t - "Non-nil means make an event from every plain time stamp." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-honor-noexport-tag nil - "Non-nil means don't export entries with a tag in `org-export-exclude-tags'." - :group 'org-export-icalendar - :version "24.1" - :type 'boolean) - -(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due) - "Contexts where iCalendar export should use a deadline time stamp. -This is a list with several symbols in it. Valid symbol are: - -event-if-todo Deadlines in TODO entries become calendar events. -event-if-not-todo Deadlines in non-TODO entries become calendar events. -todo-due Use deadlines in TODO entries as due-dates" - :group 'org-export-icalendar - :type '(set :greedy t - (const :tag "Deadlines in non-TODO entries become events" - event-if-not-todo) - (const :tag "Deadline in TODO entries become events" - event-if-todo) - (const :tag "Deadlines in TODO entries become due-dates" - todo-due))) - -(defcustom org-icalendar-use-scheduled '(todo-start) - "Contexts where iCalendar export should use a scheduling time stamp. -This is a list with several symbols in it. Valid symbol are: - -event-if-todo Scheduling time stamps in TODO entries become an event. -event-if-not-todo Scheduling time stamps in non-TODO entries become an event. -todo-start Scheduling time stamps in TODO entries become start date. - Some calendar applications show TODO entries only after - that date." - :group 'org-export-icalendar - :type '(set :greedy t - (const :tag - "SCHEDULED timestamps in non-TODO entries become events" - event-if-not-todo) - (const :tag "SCHEDULED timestamps in TODO entries become events" - event-if-todo) - (const :tag "SCHEDULED in TODO entries become start date" - todo-start))) - -(defcustom org-icalendar-categories '(local-tags category) - "Items that should be entered into the categories field. -This is a list of symbols, the following are valid: - -category The Org-mode category of the current file or tree -todo-state The todo state, if any -local-tags The tags, defined in the current line -all-tags All tags, including inherited ones." - :group 'org-export-icalendar - :type '(repeat - (choice - (const :tag "The file or tree category" category) - (const :tag "The TODO state" todo-state) - (const :tag "Tags defined in current line" local-tags) - (const :tag "All tags, including inherited ones" all-tags)))) - -(defcustom org-icalendar-include-todo nil - "Non-nil means export to iCalendar files should also cover TODO items. -Valid values are: -nil don't include any TODO items -t include all TODO items that are not in a DONE state -unblocked include all TODO items that are not blocked -all include both done and not done items." - :group 'org-export-icalendar - :type '(choice - (const :tag "None" nil) - (const :tag "Unfinished" t) - (const :tag "Unblocked" unblocked) - (const :tag "All" all))) - -(defvar org-icalendar-verify-function nil - "Function to verify entries for iCalendar export. -This can be set to a function that will be called at each entry that -is considered for export to iCalendar. When the function returns nil, -the entry will be skipped. When it returns a non-nil value, the entry -will be considered for export. -This is used internally when an agenda buffer is exported to an ics file, -to make sure that only entries currently listed in the agenda will end -up in the ics file. But for normal iCalendar export, you can use this -for whatever you need.") - -(defcustom org-icalendar-include-bbdb-anniversaries nil - "Non-nil means a combined iCalendar files should include anniversaries. -The anniversaries are define in the BBDB database." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-include-sexps t - "Non-nil means export to iCalendar files should also cover sexp entries. -These are entries like in the diary, but directly in an Org-mode file." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-include-body 100 - "Amount of text below headline to be included in iCalendar export. -This is a number of characters that should maximally be included. -Properties, scheduling and clocking lines will always be removed. -The text will be inserted into the DESCRIPTION field." - :group 'org-export-icalendar - :type '(choice - (const :tag "Nothing" nil) - (const :tag "Everything" t) - (integer :tag "Max characters"))) - -(defcustom org-icalendar-store-UID nil - "Non-nil means store any created UIDs in properties. -The iCalendar standard requires that all entries have a unique identifier. -Org will create these identifiers as needed. When this variable is non-nil, -the created UIDs will be stored in the ID property of the entry. Then the -next time this entry is exported, it will be exported with the same UID, -superseding the previous form of it. This is essential for -synchronization services. -This variable is not turned on by default because we want to avoid creating -a property drawer in every entry if people are only playing with this feature, -or if they are only using it locally." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-timezone (getenv "TZ") - "The time zone string for iCalendar export. -When nil or the empty string, use output from \(current-time-zone\)." - :group 'org-export-icalendar - :type '(choice - (const :tag "Unspecified" nil) - (string :tag "Time zone"))) - -;; Backward compatibility with previous variable -(defvar org-icalendar-use-UTC-date-time nil) -(defcustom org-icalendar-date-time-format - (if org-icalendar-use-UTC-date-time - ":%Y%m%dT%H%M%SZ" - ":%Y%m%dT%H%M%S") - "Format-string for exporting icalendar DATE-TIME. -See `format-time-string' for a full documentation. The only -difference is that `org-icalendar-timezone' is used for %Z. - -Interesting value are: - - \":%Y%m%dT%H%M%S\" for local time - - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone - - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time" - - :group 'org-export-icalendar - :version "24.1" - :type '(choice - (const :tag "Local time" ":%Y%m%dT%H%M%S") - (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S") - (const :tag "Universal time" ":%Y%m%dT%H%M%SZ") - (string :tag "Explicit format"))) - -(defun org-icalendar-use-UTC-date-timep () - (char-equal (elt org-icalendar-date-time-format - (1- (length org-icalendar-date-time-format))) ?Z)) - -;;; iCalendar export - -;;;###autoload -(defun org-export-icalendar-this-file () - "Export current file as an iCalendar file. -The iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (org-export-icalendar nil buffer-file-name)) - -;;;###autoload -(defun org-export-icalendar-all-agenda-files () - "Export all files in the variable `org-agenda-files' to iCalendar .ics files. -Each iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (apply 'org-export-icalendar nil (org-agenda-files t))) - -;;;###autoload -(defun org-export-icalendar-combine-agenda-files () - "Export all files in `org-agenda-files' to a single combined iCalendar file. -The file is stored under the name `org-combined-agenda-icalendar-file'." - (interactive) - (apply 'org-export-icalendar t (org-agenda-files t))) - -(defun org-export-icalendar (combine &rest files) - "Create iCalendar files for all elements of FILES. -If COMBINE is non-nil, combine all calendar entries into a single large -file and store it under the name `org-combined-agenda-icalendar-file'." - (save-excursion - (org-agenda-prepare-buffers files) - (let* ((dir (org-export-directory - :ical (list :publishing-directory - org-export-publishing-directory))) - file ical-file ical-buffer category started org-agenda-new-buffers) - (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*")) - (when combine - (setq ical-file - (if (file-name-absolute-p org-combined-agenda-icalendar-file) - org-combined-agenda-icalendar-file - (expand-file-name org-combined-agenda-icalendar-file dir)) - ical-buffer (org-get-agenda-file-buffer ical-file)) - (set-buffer ical-buffer) (erase-buffer)) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (set-buffer (org-get-agenda-file-buffer file)) - (unless combine - (setq ical-file (concat (file-name-as-directory dir) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".ics")) - (setq ical-buffer (org-get-agenda-file-buffer ical-file)) - (with-current-buffer ical-buffer (erase-buffer))) - (setq category (or org-category - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)))) - (if (symbolp category) (setq category (symbol-name category))) - (let ((standard-output ical-buffer)) - (if combine - (and (not started) (setq started t) - (org-icalendar-start-file org-icalendar-combined-name)) - (org-icalendar-start-file category)) - (org-icalendar-print-entries combine) - (when (or (and combine (not files)) (not combine)) - (when (and combine org-icalendar-include-bbdb-anniversaries) - (require 'org-bbdb) - (org-bbdb-anniv-export-ical)) - (org-icalendar-finish-file) - (set-buffer ical-buffer) - (run-hooks 'org-before-save-iCalendar-file-hook) - (save-buffer) - (run-hooks 'org-after-save-iCalendar-file-hook) - (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))))) - (org-release-buffers org-agenda-new-buffers)))) - -(defvar org-before-save-iCalendar-file-hook nil - "Hook run before an iCalendar file has been saved. -This can be used to modify the result of the export.") - -(defvar org-after-save-iCalendar-file-hook nil - "Hook run after an iCalendar file has been saved. -The iCalendar buffer is still current when this hook is run. -A good way to use this is to tell a desktop calendar application to re-read -the iCalendar file.") - -(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el -(defun org-icalendar-print-entries (&optional combine) - "Print iCalendar entries for the current Org-mode file to `standard-output'. -When COMBINE is non nil, add the category to each line." - (require 'org-agenda) - (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) - (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) - (dts (org-icalendar-ts-to-string - (format-time-string (cdr org-time-stamp-formats) (current-time)) - "DTSTART")) - hd ts ts2 state status (inc t) pos b sexp rrule - scheduledp deadlinep todo prefix due start tags - tmp pri categories location summary desc uid alarm alarm-time - (sexp-buffer (get-buffer-create "*ical-tmp*"))) - (org-refresh-category-properties) - (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re1 nil t) - (catch :skip - (org-agenda-skip) - (when org-icalendar-verify-function - (unless (save-match-data (funcall org-icalendar-verify-function)) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq pos (match-beginning 0) - ts (match-string 0) - tags (org-get-tags-at) - inc t - hd (condition-case nil - (org-icalendar-cleanup-string - (org-get-heading t)) - (error (throw :skip nil))) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION" 'selective)) - uid (if org-icalendar-store-UID - (org-id-get-create) - (or (org-id-get) (org-id-new))) - categories (org-export-get-categories) - alarm-time (get-text-property (point) 'org-appt-warntime) - alarm-time (if alarm-time (string-to-number alarm-time) 0) - alarm "" - deadlinep nil scheduledp nil) - (setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - todo (org-get-todo-state)) - ;; donep (org-entry-is-done-p) - (if (looking-at re2) - (progn - (goto-char (match-end 0)) - (setq ts2 (match-string 1) - inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2)))) - (setq ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) - (progn - (setq inc nil) - (replace-match "\\1" t nil ts)) - ts))) - (when (and (not org-icalendar-use-plain-timestamp) - (not deadlinep) (not scheduledp)) - (throw :skip t)) - ;; don't export entries with a :noexport: tag - (when (and org-icalendar-honor-noexport-tag - (delq nil (mapcar (lambda(x) - (member x org-export-exclude-tags)) tags))) - (throw :skip t)) - (when (and - deadlinep - (if todo - (not (memq 'event-if-todo org-icalendar-use-deadline)) - (not (memq 'event-if-not-todo org-icalendar-use-deadline)))) - (throw :skip t)) - (when (and - scheduledp - (if todo - (not (memq 'event-if-todo org-icalendar-use-scheduled)) - (not (memq 'event-if-not-todo org-icalendar-use-scheduled)))) - (throw :skip t)) - (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-"))) - (if (or (string-match org-tr-regexp hd) - (string-match org-ts-regexp hd)) - (setq hd (replace-match "" t t hd))) - (if (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)>" ts) - (setq rrule - (concat "\nRRULE:FREQ=" - (cdr (assoc - (match-string 2 ts) - '(("h" . "HOURLY")("d" . "DAILY")("w" . "WEEKLY") - ("m" . "MONTHLY")("y" . "YEARLY")))) - ";INTERVAL=" (match-string 1 ts))) - (setq rrule "")) - (setq summary (or summary hd)) - ;; create an alarm entry if the entry is timed. this is not very general in that: - ;; (a) only one alarm per entry is defined, - ;; (b) only minutes are allowed for the trigger period ahead of the start time, and - ;; (c) only a DISPLAY action is defined. - ;; [ESF] - (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault)))) - (if (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0)) - (car t1) (nth 1 t1) (nth 2 t1)) - (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM" - summary (or alarm-time org-icalendar-alarm-time))) - (setq alarm ""))) - (if (string-match org-bracket-link-regexp summary) - (setq summary - (replace-match (if (match-end 3) - (match-string 3 summary) - (match-string 1 summary)) - t t summary))) - (if deadlinep (setq summary (concat "DL: " summary))) - (if scheduledp (setq summary (concat "S: " summary))) - (if (string-match "\\`<%%" ts) - (with-current-buffer sexp-buffer - (let ((entry (substring ts 1 -1))) - (put-text-property 0 1 'uid - (concat " " prefix uid) entry) - (insert entry " " summary "\n"))) - (princ (format "BEGIN:VEVENT -UID: %s -%s -%s%s -SUMMARY:%s%s%s -CATEGORIES:%s%s -END:VEVENT\n" - (concat prefix uid) - (org-icalendar-ts-to-string ts "DTSTART") - (org-icalendar-ts-to-string ts2 "DTEND" inc) - rrule summary - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - categories - alarm))))) - (when (and org-icalendar-include-sexps - (condition-case nil (require 'icalendar) (error nil)) - (fboundp 'icalendar-export-region)) - ;; Get all the literal sexps - (goto-char (point-min)) - (while (re-search-forward "^&?%%(" nil t) - (catch :skip - (org-agenda-skip) - (when org-icalendar-verify-function - (unless (save-match-data (funcall org-icalendar-verify-function)) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq b (match-beginning 0)) - (goto-char (1- (match-end 0))) - (forward-sexp 1) - (end-of-line 1) - (setq sexp (buffer-substring b (point))) - (with-current-buffer sexp-buffer - (insert sexp "\n")))) - (princ (org-diary-to-ical-string sexp-buffer)) - (kill-buffer sexp-buffer)) - - (when org-icalendar-include-todo - (setq prefix "TODO-") - (goto-char (point-min)) - (while (re-search-forward org-complex-heading-regexp nil t) - (catch :skip - (org-agenda-skip) - (when org-icalendar-verify-function - (unless (save-match-data - (funcall org-icalendar-verify-function)) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq state (match-string 2)) - (setq status (if (member state org-done-keywords) - "COMPLETED" "NEEDS-ACTION")) - (when (and state - (cond - ;; check if the state is one we should use - ((eq org-icalendar-include-todo 'all) - ;; all should be included - t) - ((eq org-icalendar-include-todo 'unblocked) - ;; only undone entries that are not blocked - (and (member state org-not-done-keywords) - (or (not org-blocker-hook) - (save-match-data - (run-hook-with-args-until-failure - 'org-blocker-hook - (list :type 'todo-state-change - :position (point-at-bol) - :from 'todo - :to 'done)))))) - ((eq org-icalendar-include-todo t) - ;; include everything that is not done - (member state org-not-done-keywords)))) - (setq hd (match-string 4) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION" 'selective)) - due (and (member 'todo-due org-icalendar-use-deadline) - (org-entry-get nil "DEADLINE")) - start (and (member 'todo-start org-icalendar-use-scheduled) - (org-entry-get nil "SCHEDULED")) - categories (org-export-get-categories) - uid (if org-icalendar-store-UID - (org-id-get-create) - (or (org-id-get) (org-id-new)))) - (and due (setq due (org-icalendar-ts-to-string due "DUE"))) - (and start (setq start (org-icalendar-ts-to-string start "DTSTART"))) - - (if (string-match org-bracket-link-regexp hd) - (setq hd (replace-match (if (match-end 3) (match-string 3 hd) - (match-string 1 hd)) - t t hd))) - (if (string-match org-priority-regexp hd) - (setq pri (string-to-char (match-string 2 hd)) - hd (concat (substring hd 0 (match-beginning 1)) - (substring hd (match-end 1)))) - (setq pri org-default-priority)) - (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri)) - (- org-lowest-priority org-highest-priority)))))) - - (princ (format "BEGIN:VTODO -UID: %s -%s -SUMMARY:%s%s%s%s -CATEGORIES:%s -SEQUENCE:1 -PRIORITY:%d -STATUS:%s -END:VTODO\n" - (concat prefix uid) - (or start dts) - (or summary hd) - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - (if due (concat "\n" due) "") - categories - pri status))))))))) - -(defun org-export-get-categories () - "Get categories according to `org-icalendar-categories'." - (let ((cs org-icalendar-categories) c rtn tmp) - (while (setq c (pop cs)) - (cond - ((eq c 'category) (push (org-get-category) rtn)) - ((eq c 'todo-state) - (setq tmp (org-get-todo-state)) - (and tmp (push tmp rtn))) - ((eq c 'local-tags) - (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn))) - ((eq c 'all-tags) - (setq rtn (append (nreverse (org-get-tags-at (point))) rtn))))) - (mapconcat 'identity (nreverse rtn) ","))) - -(defun org-icalendar-cleanup-string (s &optional is-body maxlength) - "Take out stuff and quote what needs to be quoted. -When IS-BODY is non-nil, assume that this is the body of an item, clean up -whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH -characters." - (if (not s) - nil - (if is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s)))) - (setq s (replace-regexp-in-string "[[:space:]]+" " " s))) - (let ((start 0)) - (while (string-match "\\([,;]\\)" s start) - (setq start (+ (match-beginning 0) 2) - s (replace-match "\\\\\\1" nil nil s)))) - (setq s (org-trim s)) - (when is-body - (while (string-match "[ \t]*\n[ \t]*" s) - (setq s (replace-match "\\n" t t s)))) - (if is-body - (if maxlength - (if (and (numberp maxlength) - (> (length s) maxlength)) - (setq s (substring s 0 maxlength))))) - s)) - -(defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength) - "Take out stuff and quote what needs to be quoted. -When IS-BODY is non-nil, assume that this is the body of an item, clean up -whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH -characters. -This seems to be more like RFC 2455, but it causes problems, so it is -not used right now." - (if (not s) - nil - (if is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s))) - (setq s (org-trim s)) - (while (string-match "[ \t]*\n[ \t]*" s) - (setq s (replace-match "\\n" t t s))) - (if maxlength - (if (and (numberp maxlength) - (> (length s) maxlength)) - (setq s (substring s 0 maxlength))))) - (setq s (org-trim s))) - (while (string-match "\"" s) (setq s (replace-match "''" t t s))) - (when (string-match "[;,:]" s) (setq s (concat "\"" s "\""))) - s)) - -(defun org-icalendar-start-file (name) - "Start an iCalendar file by inserting the header." - (let ((user user-full-name) - (name (or name "unknown")) - (timezone (if (> (length org-icalendar-timezone) 0) - org-icalendar-timezone - (cadr (current-time-zone)))) - (description org-icalendar-combined-description)) - (princ - (format "BEGIN:VCALENDAR -VERSION:2.0 -X-WR-CALNAME:%s -PRODID:-//%s//Emacs with Org-mode//EN -X-WR-TIMEZONE:%s -X-WR-CALDESC:%s -CALSCALE:GREGORIAN\n" name user timezone description)))) - -(defun org-icalendar-finish-file () - "Finish an iCalendar file by inserting the END statement." - (princ "END:VCALENDAR\n")) - -(defun org-icalendar-ts-to-string (s keyword &optional inc) - "Take a time string S and convert it to iCalendar format. -KEYWORD is added in front, to make a complete line like DTSTART.... -When INC is non-nil, increase the hour by two (if time string contains -a time), or the day by one (if it does not contain a time)." - (let ((t1 (ignore-errors (org-parse-time-string s 'nodefault))) - t2 fmt have-time time) - (if (not t1) - "" - (if (and (car t1) (nth 1 t1) (nth 2 t1)) - (setq t2 t1 have-time t) - (setq t2 (org-parse-time-string s))) - (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) - (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) - (when inc - (if have-time - (if org-agenda-default-appointment-duration - (setq mi (+ org-agenda-default-appointment-duration mi)) - (setq h (+ 2 h))) - (setq d (1+ d)))) - (setq time (encode-time s mi h d m y))) - (setq fmt (if have-time - (replace-regexp-in-string "%Z" - org-icalendar-timezone - org-icalendar-date-time-format t) - ";VALUE=DATE:%Y%m%d")) - (concat keyword (format-time-string fmt time - (and (org-icalendar-use-UTC-date-timep) - have-time)))))) - -(provide 'org-icalendar) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-icalendar.el ends here diff --git a/lisp/org-id.el b/lisp/org-id.el index ecf67f72f..32c05e6aa 100644 --- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -186,7 +186,7 @@ the link." :type 'boolean) (defcustom org-id-locations-file (convert-standard-filename - "~/.emacs.d/.org-id-locations") + (concat user-emacs-directory ".org-id-locations")) "The file for remembering in which file an ID was defined. This variable is only relevant when `org-id-track-globally' is set." :group 'org-id @@ -343,7 +343,7 @@ So a typical ID could look like \"Org:4nd91V40HI\"." (unless (org-uuidgen-p unique) (setq unique (org-id-uuid)))) ((eq org-id-method 'org) - (let* ((etime (org-id-reverse-string (org-id-time-to-b36))) + (let* ((etime (org-reverse-string (org-id-time-to-b36))) (postfix (if org-id-include-domain (progn (require 'message) @@ -376,9 +376,6 @@ So a typical ID could look like \"Org:4nd91V40HI\"." (substring rnd 18 20) (substring rnd 20 32)))) -(defun org-id-reverse-string (s) - (mapconcat 'char-to-string (nreverse (string-to-list s)) "")) - (defun org-id-int-to-b36-one-digit (i) "Turn an integer between 0 and 61 into a single character 0..9, A..Z, a..z." (cond @@ -432,7 +429,7 @@ and time is the usual three-integer representation of time." (if (= 2 (length parts)) (setq prefix (car parts) time (nth 1 parts)) (setq prefix nil time (nth 0 parts))) - (setq time (org-id-reverse-string time)) + (setq time (org-reverse-string time)) (setq time (list (org-id-b36-to-int (substring time 0 4)) (org-id-b36-to-int (substring time 4 8)) (org-id-b36-to-int (substring time 8 12)))) diff --git a/lisp/org-indent.el b/lisp/org-indent.el index 6e6f2bf15..44311e388 100644 --- a/lisp/org-indent.el +++ b/lisp/org-indent.el @@ -88,7 +88,7 @@ This is used locally in each buffer being initialized.") (defvar org-hide-leading-stars-before-indent-mode nil "Used locally.") (defvar org-indent-modified-headline-flag nil - "Non-nil means the last deletion operated on an headline. + "Non-nil means the last deletion operated on a headline. It is modified by `org-indent-notify-modified-headline'.") @@ -147,8 +147,8 @@ useful to make it ever so slightly different." (defsubst org-indent-remove-properties (beg end) "Remove indentations between BEG and END." - (with-silent-modifications - (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) + (org-with-silent-modifications + (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) ;;;###autoload (define-minor-mode org-indent-mode @@ -182,11 +182,11 @@ during idle time." (org-set-local 'org-hide-leading-stars-before-indent-mode org-hide-leading-stars) (org-set-local 'org-hide-leading-stars t)) - (make-local-variable 'filter-buffer-substring-functions) - (add-hook 'filter-buffer-substring-functions - (lambda (fun start end delete) - (org-indent-remove-properties-from-string - (funcall fun start end delete)))) + (org-add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (org-indent-remove-properties-from-string + (funcall fun start end delete))) + nil t) (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) (org-add-hook 'before-change-functions 'org-indent-notify-modified-headline nil 'local) @@ -342,50 +342,50 @@ stopped." ;; 2. For each line, set `line-prefix' and `wrap-prefix' ;; properties depending on the type of line (headline, ;; inline task, item or other). - (with-silent-modifications - (while (and (<= (point) end) (not (eobp))) - (cond - ;; When in asynchronous mode, check if interrupt is - ;; required. - ((and delay (input-pending-p)) (throw 'interrupt (point))) - ;; In asynchronous mode, take a break of - ;; `org-indent-agent-resume-delay' every DELAY to avoid - ;; blocking any other idle timer or process output. - ((and delay (time-less-p time-limit (current-time))) - (setq org-indent-agent-resume-timer - (run-with-idle-timer - (time-add (current-idle-time) - org-indent-agent-resume-delay) - nil #'org-indent-initialize-agent)) - (throw 'interrupt (point))) - ;; Headline or inline task. - ((looking-at org-outline-regexp) - (let* ((nstars (- (match-end 0) (match-beginning 0) 1)) - (line (* added-ind-per-lvl (1- nstars))) - (wrap (+ line (1+ nstars)))) - (cond - ;; Headline: new value for PF. - ((looking-at limited-re) - (org-indent-set-line-properties line wrap t) - (setq pf wrap)) - ;; End of inline task: PF-INLINE is now nil. - ((looking-at "\\*+ end[ \t]*$") - (org-indent-set-line-properties line wrap 'inline) - (setq pf-inline nil)) - ;; Start of inline task. Determine if it contains - ;; text, or if it is only one line long. Set - ;; PF-INLINE accordingly. - (t (org-indent-set-line-properties line wrap 'inline) - (setq pf-inline (and (org-inlinetask-in-task-p) wrap)))))) - ;; List item: `wrap-prefix' is set where body starts. - ((org-at-item-p) - (let* ((line (or pf-inline pf 0)) - (wrap (+ (org-list-item-body-column (point)) line))) - (org-indent-set-line-properties line wrap nil))) - ;; Normal line: use PF-INLINE, PF or nil as prefixes. - (t (let* ((line (or pf-inline pf 0)) - (wrap (+ line (org-get-indentation)))) - (org-indent-set-line-properties line wrap nil)))))))))) + (org-with-silent-modifications + (while (and (<= (point) end) (not (eobp))) + (cond + ;; When in asynchronous mode, check if interrupt is + ;; required. + ((and delay (input-pending-p)) (throw 'interrupt (point))) + ;; In asynchronous mode, take a break of + ;; `org-indent-agent-resume-delay' every DELAY to avoid + ;; blocking any other idle timer or process output. + ((and delay (time-less-p time-limit (current-time))) + (setq org-indent-agent-resume-timer + (run-with-idle-timer + (time-add (current-idle-time) + org-indent-agent-resume-delay) + nil #'org-indent-initialize-agent)) + (throw 'interrupt (point))) + ;; Headline or inline task. + ((looking-at org-outline-regexp) + (let* ((nstars (- (match-end 0) (match-beginning 0) 1)) + (line (* added-ind-per-lvl (1- nstars))) + (wrap (+ line (1+ nstars)))) + (cond + ;; Headline: new value for PF. + ((looking-at limited-re) + (org-indent-set-line-properties line wrap t) + (setq pf wrap)) + ;; End of inline task: PF-INLINE is now nil. + ((looking-at "\\*+ end[ \t]*$") + (org-indent-set-line-properties line wrap 'inline) + (setq pf-inline nil)) + ;; Start of inline task. Determine if it contains + ;; text, or if it is only one line long. Set + ;; PF-INLINE accordingly. + (t (org-indent-set-line-properties line wrap 'inline) + (setq pf-inline (and (org-inlinetask-in-task-p) wrap)))))) + ;; List item: `wrap-prefix' is set where body starts. + ((org-at-item-p) + (let* ((line (or pf-inline pf 0)) + (wrap (+ (org-list-item-body-column (point)) line))) + (org-indent-set-line-properties line wrap nil))) + ;; Normal line: use PF-INLINE, PF or nil as prefixes. + (t (let* ((line (or pf-inline pf 0)) + (wrap (+ line (org-get-indentation)))) + (org-indent-set-line-properties line wrap nil)))))))))) (defun org-indent-notify-modified-headline (beg end) "Set `org-indent-modified-headline-flag' depending on context. @@ -412,7 +412,7 @@ range of inserted text. DUMMY is an unused argument. This function is meant to be called by `after-change-functions'." (when org-indent-mode (save-match-data - ;; If an headline was modified or inserted, set properties until + ;; If a headline was modified or inserted, set properties until ;; next headline. (if (or org-indent-modified-headline-flag (save-excursion diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el index 43913acac..112d3df20 100644 --- a/lisp/org-inlinetask.el +++ b/lisp/org-inlinetask.el @@ -27,31 +27,25 @@ ;;; Commentary: ;; ;; This module implements inline tasks in Org-mode. Inline tasks are -;; tasks that have all the properties of normal outline nodes, including -;; the ability to store meta data like scheduling dates, TODO state, tags -;; and properties. However, these nodes are treated specially by the -;; visibility cycling and export commands. +;; tasks that have all the properties of normal outline nodes, +;; including the ability to store meta data like scheduling dates, +;; TODO state, tags and properties. However, these nodes are treated +;; specially by the visibility cycling. ;; -;; Visibility cycling exempts these nodes from cycling. So whenever their -;; parent is opened, so are these tasks. This will only work with -;; `org-cycle', so if you are also using other commands to show/hide -;; entries, you will occasionally find these tasks to behave like -;; all other outline nodes, seemingly splitting the text of the parent -;; into children. +;; Visibility cycling exempts these nodes from cycling. So whenever +;; their parent is opened, so are these tasks. This will only work +;; with `org-cycle', so if you are also using other commands to +;; show/hide entries, you will occasionally find these tasks to behave +;; like all other outline nodes, seemingly splitting the text of the +;; parent into children. ;; -;; Export commands do not treat these nodes as part of the sectioning -;; structure, but as a special inline text that is either removed, or -;; formatted in some special way. This in handled by -;; `org-inlinetask-export' and `org-inlinetask-export-templates' -;; variables. +;; Special fontification of inline tasks, so that they can be +;; immediately recognized. From the stars of the headline, only the +;; first and the last two will be visible, the others will be hidden +;; using the `org-hide' face. ;; -;; Special fontification of inline tasks, so that they can be immediately -;; recognized. From the stars of the headline, only the first and the -;; last two will be visible, the others will be hidden using the -;; `org-hide' face. -;; -;; An inline task is identified solely by a minimum outline level, given -;; by the variable `org-inlinetask-min-level', default 15. +;; An inline task is identified solely by a minimum outline level, +;; given by the variable `org-inlinetask-min-level', default 15. ;; ;; If you need to have a time planning line (DEADLINE etc), drawers, ;; for example LOGBOOK of PROPERTIES, or even normal text as part of @@ -111,69 +105,6 @@ When nil, the first star is not shown." :tag "Org Inline Tasks" :group 'org-structure) -(defcustom org-inlinetask-export t - "Non-nil means export inline tasks. -When nil, they will not be exported." - :group 'org-inlinetask - :type 'boolean) - -(defvar org-inlinetask-export-templates - '((html "
    %s%s
    %s
    " - '((unless (eq todo "") - (format "%s%s " - class todo todo priority)) - heading content)) - (odt "%s" '((org-odt-format-inlinetask heading content - todo priority tags))) - - (latex "\\begin\{description\}\n\\item[%s%s]~%s\\end\{description\}" - '((unless (eq todo "") (format "\\textsc\{%s%s\} " todo priority)) - heading content)) - (ascii " -- %s%s%s" - '((unless (eq todo "") (format "%s%s " todo priority)) - heading - (unless (eq content "") - (format "\n ¦ %s" - (mapconcat 'identity (org-split-string content "\n") - "\n ¦ "))))) - (docbook " - -%s%s -%s - -" - '((unless (eq todo "") (format "%s%s " todo priority)) - heading content))) - "Templates for inline tasks in various exporters. - -This variable is an alist in the shape of \(BACKEND STRING OBJECTS\). - -BACKEND is the name of the backend for the template \(ascii, html...\). - -STRING is a format control string. - -OBJECTS is a list of elements to be substituted into the format -string. They can be of any type, from a string to a form -returning a value (thus allowing conditional insertion). A nil -object will be substituted as the empty string. Obviously, there -must be at least as many objects as %-sequences in the format -string. - -Moreover, the following special keywords are provided: `todo', -`priority', `heading', `content', `tags'. If some of them are not -defined in an inline task, their value is the empty string. - -As an example, valid associations are: - -\(html \"
    • %s

      %s

    \" \(heading content\)\) - -or, with the additional package \"todonotes\" for LaTeX, - -\(latex \"\\todo[inline]{\\textbf{\\textsf{%s %s}}\\linebreak{} %s}\" - '\(\(unless \(eq todo \"\"\) - \(format \"\\textsc{%s%s}\" todo priority\)\) - heading content\)\)\)") - (defvar org-odd-levels-only) (defvar org-keyword-time-regexp) (defvar org-drawer-regexp) @@ -328,89 +259,6 @@ If the task has an end part, also demote it." (goto-char beg) (org-fixup-indentation diff))))))) -(defvar org-export-current-backend) ; dynamically bound in org-exp.el -(defun org-inlinetask-export-handler () - "Handle headlines with level larger or equal to `org-inlinetask-min-level'. -Either remove headline and meta data, or do special formatting." - (goto-char (point-min)) - (let* ((keywords-re (concat "^[ \t]*" org-keyword-time-regexp)) - (inline-re (concat (org-inlinetask-outline-regexp) ".*"))) - (while (re-search-forward inline-re nil t) - (let ((headline (match-string 0)) - (beg (point-at-bol)) - (end (copy-marker (save-excursion - (org-inlinetask-goto-end) (point)))) - content) - ;; Delete SCHEDULED, DEADLINE... - (while (re-search-forward keywords-re end t) - (delete-region (point-at-bol) (1+ (point-at-eol)))) - (goto-char beg) - ;; Delete drawers - (while (re-search-forward org-drawer-regexp end t) - (when (save-excursion (re-search-forward org-property-end-re nil t)) - (delete-region beg (1+ (match-end 0))))) - ;; Get CONTENT, if any. - (goto-char beg) - (forward-line 1) - (unless (= (point) end) - (setq content (buffer-substring (point) - (save-excursion (goto-char end) - (forward-line -1) - (point))))) - ;; Remove the task. - (goto-char beg) - (delete-region beg end) - (when (and org-inlinetask-export - (assq org-export-current-backend - org-inlinetask-export-templates)) - ;; Format CONTENT, if appropriate. - (setq content - (if (not (and content (string-match "\\S-" content))) - "" - ;; Ensure CONTENT has minimal indentation, a single - ;; newline character at its boundaries, and isn't - ;; protected. - (when (string-match "\\`\\([ \t]*\n\\)+" content) - (setq content (substring content (match-end 0)))) - (when (string-match "[ \t\n]+\\'" content) - (setq content (substring content 0 (match-beginning 0)))) - (org-add-props - (concat "\n\n" (org-remove-indentation content) "\n\n") - '(org-protected nil org-native-text nil)))) - - (when (string-match org-complex-heading-regexp headline) - (let* ((nil-to-str - (function - ;; Change nil arguments into empty strings. - (lambda (el) (or (eval el) "")))) - ;; Set up keywords provided to templates. - (todo (or (match-string 2 headline) "")) - (class (or (and (eq "" todo) "") - (if (member todo org-done-keywords) "done" "todo"))) - (priority (or (match-string 3 headline) "")) - (heading (or (match-string 4 headline) "")) - (tags (or (match-string 5 headline) "")) - ;; Read `org-inlinetask-export-templates'. - (backend-spec (assq org-export-current-backend - org-inlinetask-export-templates)) - (format-str (org-add-props (nth 1 backend-spec) - '(org-protected t org-native-text t))) - (tokens (cadr (nth 2 backend-spec))) - ;; Build export string. Ensure it won't break - ;; surrounding lists by giving it arbitrary high - ;; indentation. - (export-str (org-add-props - (eval (append '(format format-str) - (mapcar nil-to-str tokens))) - '(original-indentation 1000)))) - ;; Ensure task starts a new paragraph. - (unless (or (bobp) - (save-excursion (forward-line -1) - (looking-at "[ \t]*$"))) - (insert "\n")) - (insert export-str) - (unless (bolp) (insert "\n"))))))))) - (defun org-inlinetask-get-current-indentation () "Get the indentation of the last non-while line above this one." (save-excursion @@ -476,9 +324,6 @@ Either remove headline and meta data, or do special formatting." org-inlinetask-min-level)) (replace-match ""))) -(eval-after-load "org-exp" - '(add-hook 'org-export-preprocess-before-backend-specifics-hook - 'org-inlinetask-export-handler)) (eval-after-load "org" '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify)) diff --git a/lisp/org-jsinfo.el b/lisp/org-jsinfo.el deleted file mode 100644 index 08c01108b..000000000 --- a/lisp/org-jsinfo.el +++ /dev/null @@ -1,262 +0,0 @@ -;;; org-jsinfo.el --- Support for org-info.js Javascript in Org HTML export - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file implements the support for Sebastian Rose's JavaScript -;; org-info.js to display an org-mode file exported to HTML in an -;; Info-like way, or using folding similar to the outline structure -;; org org-mode itself. - -;; Documentation for using this module is in the Org manual. The script -;; itself is documented by Sebastian Rose in a file distributed with -;; the script. FIXME: Accurate pointers! - -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org-exp) -(require 'org-html) - -(add-to-list 'org-export-inbuffer-options-extra '("INFOJS_OPT" :infojs-opt)) -(add-hook 'org-export-options-filters 'org-infojs-handle-options) - -(defgroup org-infojs nil - "Options specific for using org-info.js in HTML export of Org-mode files." - :tag "Org Export HTML INFOJS" - :group 'org-export-html) - -(defcustom org-export-html-use-infojs 'when-configured - "Should Sebastian Rose's Java Script org-info.js be linked into HTML files? -This option can be nil or t to never or always use the script. It can -also be the symbol `when-configured', meaning that the script will be -linked into the export file if and only if there is a \"#+INFOJS_OPT:\" -line in the buffer. See also the variable `org-infojs-options'." - :group 'org-export-html - :group 'org-infojs - :type '(choice - (const :tag "Never" nil) - (const :tag "When configured in buffer" when-configured) - (const :tag "Always" t))) - -(defconst org-infojs-opts-table - '((path PATH "http://orgmode.org/org-info.js") - (view VIEW "info") - (toc TOC :table-of-contents) - (ftoc FIXED_TOC "0") - (tdepth TOC_DEPTH "max") - (sdepth SECTION_DEPTH "max") - (mouse MOUSE_HINT "underline") - (buttons VIEW_BUTTONS "0") - (ltoc LOCAL_TOC "1") - (up LINK_UP :link-up) - (home LINK_HOME :link-home)) - "JavaScript options, long form for script, default values.") - -(defvar org-infojs-options) -(when (and (boundp 'org-infojs-options) - (assq 'runs org-infojs-options)) - (setq org-infojs-options (delq (assq 'runs org-infojs-options) - org-infojs-options))) - -(defcustom org-infojs-options - (mapcar (lambda (x) (cons (car x) (nth 2 x))) - org-infojs-opts-table) - "Options settings for the INFOJS JavaScript. -Each of the options must have an entry in `org-export-html/infojs-opts-table'. -The value can either be a string that will be passed to the script, or -a property. This property is then assumed to be a property that is defined -by the Export/Publishing setup of Org. -The `sdepth' and `tdepth' parameters can also be set to \"max\", which -means to use the maximum value consistent with other options." - :group 'org-infojs - :type - `(set :greedy t :inline t - ,@(mapcar - (lambda (x) - (list 'cons (list 'const (car x)) - '(choice - (symbol :tag "Publishing/Export property") - (string :tag "Value")))) - org-infojs-opts-table))) - -(defcustom org-infojs-template - " - -" - "The template for the export style additions when org-info.js is used. -Option settings will replace the %MANAGER-OPTIONS cookie." - :group 'org-infojs - :type 'string) - -(defun org-infojs-handle-options (exp-plist) - "Analyze JavaScript options in INFO-PLIST and modify EXP-PLIST accordingly." - (if (or (not org-export-html-use-infojs) - (and (eq org-export-html-use-infojs 'when-configured) - (or (not (plist-get exp-plist :infojs-opt)) - (string-match "\\" - (plist-get exp-plist :infojs-opt))))) - ;; We do not want to use the script - exp-plist - ;; We do want to use the script, set it up - (let ((template org-infojs-template) - (ptoc (plist-get exp-plist :table-of-contents)) - (hlevels (plist-get exp-plist :headline-levels)) - tdepth sdepth s v e opt var val table default) - (setq sdepth hlevels - tdepth hlevels) - (if (integerp ptoc) (setq tdepth (min ptoc tdepth))) - (setq v (plist-get exp-plist :infojs-opt) - table org-infojs-opts-table) - (while (setq e (pop table)) - (setq opt (car e) var (nth 1 e) - default (cdr (assoc opt org-infojs-options))) - (and (symbolp default) (not (memq default '(t nil))) - (setq default (plist-get exp-plist default))) - (if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v)) - (setq val (match-string 1 v)) - (setq val default)) - (cond - ((eq opt 'path) - (setq template - (replace-regexp-in-string "%SCRIPT_PATH" val template t t))) - ((eq opt 'sdepth) - (if (integerp (read val)) - (setq sdepth (min (read val) hlevels)))) - ((eq opt 'tdepth) - (if (integerp (read val)) - (setq tdepth (min (read val) hlevels)))) - (t - (setq val - (cond - ((or (eq val t) (equal val "t")) "1") - ((or (eq val nil) (equal val "nil")) "0") - ((stringp val) val) - (t (format "%s" val)))) - (push (cons var val) s)))) - - ;; Now we set the depth of the *generated* TOC to SDEPTH, because the - ;; toc will actually determine the splitting. How much of the toc will - ;; actually be displayed is governed by the TDEPTH option. - (setq exp-plist (plist-put exp-plist :table-of-contents sdepth)) - - ;; The table of contents should not show more sections then we generate - (setq tdepth (min tdepth sdepth)) - (push (cons "TOC_DEPTH" tdepth) s) - - (setq s (mapconcat - (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");" - (car x) (cdr x))) - s "\n")) - (when (and s (> (length s) 0)) - (and (string-match "%MANAGER_OPTIONS" template) - (setq s (replace-match s t t template)) - (setq exp-plist - (plist-put - exp-plist :style-extra - (concat (or (plist-get exp-plist :style-extra) "") "\n" s))))) - ;; This script absolutely needs the table of contents, to we change that - ;; setting - (if (not (plist-get exp-plist :table-of-contents)) - (setq exp-plist (plist-put exp-plist :table-of-contents t))) - ;; Return the modified property list - exp-plist))) - -(defun org-infojs-options-inbuffer-template () - (format "#+INFOJS_OPT: view:%s toc:%s ltoc:%s mouse:%s buttons:%s path:%s" - (if (eq t org-export-html-use-infojs) (cdr (assoc 'view org-infojs-options)) nil) - (let ((a (cdr (assoc 'toc org-infojs-options)))) - (cond ((memq a '(nil t)) a) - (t (plist-get (org-infile-export-plist) :table-of-contents)))) - (if (equal (cdr (assoc 'ltoc org-infojs-options)) "1") t nil) - (cdr (assoc 'mouse org-infojs-options)) - (cdr (assoc 'buttons org-infojs-options)) - (cdr (assoc 'path org-infojs-options)))) - -(provide 'org-infojs) -(provide 'org-jsinfo) - -;;; org-jsinfo.el ends here diff --git a/lisp/org-latex.el b/lisp/org-latex.el deleted file mode 100644 index 609bcbee1..000000000 --- a/lisp/org-latex.el +++ /dev/null @@ -1,2901 +0,0 @@ -;;; org-latex.el --- LaTeX exporter for org-mode -;; -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. -;; -;; Emacs Lisp Archive Entry -;; Filename: org-latex.el -;; Author: Bastien Guerry -;; Maintainer: Carsten Dominik -;; Keywords: org, wp, tex -;; Description: Converts an org-mode buffer into LaTeX - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; -;; This library implements a LaTeX exporter for org-mode. -;; -;; It is part of Org and will be autoloaded -;; -;; The interactive functions are similar to those of the HTML exporter: -;; -;; M-x `org-export-as-latex' -;; M-x `org-export-as-pdf' -;; M-x `org-export-as-pdf-and-open' -;; M-x `org-export-as-latex-batch' -;; M-x `org-export-as-latex-to-buffer' -;; M-x `org-export-region-as-latex' -;; M-x `org-replace-region-by-latex' -;; -;;; Code: - -(eval-when-compile - (require 'cl)) - -(require 'footnote) -(require 'org) -(require 'org-exp) -(require 'org-macs) -(require 'org-beamer) - -;;; Variables: -(defvar org-export-latex-class nil) -(defvar org-export-latex-class-options nil) -(defvar org-export-latex-header nil) -(defvar org-export-latex-append-header nil) -(defvar org-export-latex-options-plist nil) -(defvar org-export-latex-todo-keywords-1 nil) -(defvar org-export-latex-complex-heading-re nil) -(defvar org-export-latex-not-done-keywords nil) -(defvar org-export-latex-done-keywords nil) -(defvar org-export-latex-display-custom-times nil) -(defvar org-export-latex-all-targets-re nil) -(defvar org-export-latex-add-level 0) -(defvar org-export-latex-footmark-seen nil - "List of footnotes markers seen so far by exporter.") -(defvar org-export-latex-sectioning "") -(defvar org-export-latex-sectioning-depth 0) -(defvar org-export-latex-special-keyword-regexp - (concat "\\<\\(" org-scheduled-string "\\|" - org-deadline-string "\\|" - org-closed-string"\\)") - "Regexp matching special time planning keywords plus the time after it.") -(defvar org-re-quote) ; dynamically scoped from org.el -(defvar org-commentsp) ; dynamically scoped from org.el - -;;; User variables: - -(defgroup org-export-latex nil - "Options for exporting Org-mode files to LaTeX." - :tag "Org Export LaTeX" - :group 'org-export) - -(defcustom org-export-latex-default-class "article" - "The default LaTeX class." - :group 'org-export-latex - :type '(string :tag "LaTeX class")) - -(defcustom org-export-latex-classes - '(("article" - "\\documentclass[11pt]{article}" - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}") - ("\\paragraph{%s}" . "\\paragraph*{%s}") - ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) - ("report" - "\\documentclass[11pt]{report}" - ("\\part{%s}" . "\\part*{%s}") - ("\\chapter{%s}" . "\\chapter*{%s}") - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) - ("book" - "\\documentclass[11pt]{book}" - ("\\part{%s}" . "\\part*{%s}") - ("\\chapter{%s}" . "\\chapter*{%s}") - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) - ("beamer" - "\\documentclass{beamer}" - org-beamer-sectioning - )) - "Alist of LaTeX classes and associated header and structure. -If #+LaTeX_CLASS is set in the buffer, use its value and the -associated information. Here is the structure of each cell: - - \(class-name - header-string - (numbered-section . unnumbered-section\) - ...\) - -The header string ------------------ - -The HEADER-STRING is the header that will be inserted into the LaTeX file. -It should contain the \\documentclass macro, and anything else that is needed -for this setup. To this header, the following commands will be added: - -- Calls to \\usepackage for all packages mentioned in the variables - `org-export-latex-default-packages-alist' and - `org-export-latex-packages-alist'. Thus, your header definitions should - avoid to also request these packages. - -- Lines specified via \"#+LaTeX_HEADER:\" - -If you need more control about the sequence in which the header is built -up, or if you want to exclude one of these building blocks for a particular -class, you can use the following macro-like placeholders. - - [DEFAULT-PACKAGES] \\usepackage statements for default packages - [NO-DEFAULT-PACKAGES] do not include any of the default packages - [PACKAGES] \\usepackage statements for packages - [NO-PACKAGES] do not include the packages - [EXTRA] the stuff from #+LaTeX_HEADER - [NO-EXTRA] do not include #+LaTeX_HEADER stuff - [BEAMER-HEADER-EXTRA] the beamer extra headers - -So a header like - - \\documentclass{article} - [NO-DEFAULT-PACKAGES] - [EXTRA] - \\providecommand{\\alert}[1]{\\textbf{#1}} - [PACKAGES] - -will omit the default packages, and will include the #+LaTeX_HEADER lines, -then have a call to \\providecommand, and then place \\usepackage commands -based on the content of `org-export-latex-packages-alist'. - -If your header or `org-export-latex-default-packages-alist' inserts -\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be replaced with -a coding system derived from `buffer-file-coding-system'. See also the -variable `org-export-latex-inputenc-alist' for a way to influence this -mechanism. - -The sectioning structure ------------------------- - -The sectioning structure of the class is given by the elements following -the header string. For each sectioning level, a number of strings is -specified. A %s formatter is mandatory in each section string and will -be replaced by the title of the section. - -Instead of a cons cell (numbered . unnumbered), you can also provide a list -of 2 or 4 elements, - - (numbered-open numbered-close) - -or - - (numbered-open numbered-close unnumbered-open unnumbered-close) - -providing opening and closing strings for a LaTeX environment that should -represent the document section. The opening clause should have a %s -to represent the section title. - -Instead of a list of sectioning commands, you can also specify a -function name. That function will be called with two parameters, -the (reduced) level of the headline, and the headline text. The function -must return a cons cell with the (possibly modified) headline text, and the -sectioning list in the cdr." - :group 'org-export-latex - :type '(repeat - (list (string :tag "LaTeX class") - (string :tag "LaTeX header") - (repeat :tag "Levels" :inline t - (choice - (cons :tag "Heading" - (string :tag " numbered") - (string :tag "unnumbered")) - (list :tag "Environment" - (string :tag "Opening (numbered)") - (string :tag "Closing (numbered)") - (string :tag "Opening (unnumbered)") - (string :tag "Closing (unnumbered)")) - (function :tag "Hook computing sectioning")))))) - -(defcustom org-export-latex-inputenc-alist nil - "Alist of inputenc coding system names, and what should really be used. -For example, adding an entry - - (\"utf8\" . \"utf8x\") - -will cause \\usepackage[utf8x]{inputenc} to be used for buffers that -are written as utf8 files." - :group 'org-export-latex - :version "24.1" - :type '(repeat - (cons - (string :tag "Derived from buffer") - (string :tag "Use this instead")))) - - -(defcustom org-export-latex-emphasis-alist - '(("*" "\\textbf{%s}" nil) - ("/" "\\emph{%s}" nil) - ("_" "\\underline{%s}" nil) - ("+" "\\st{%s}" nil) - ("=" "\\protectedtexttt" t) - ("~" "\\verb" t)) - "Alist of LaTeX expressions to convert emphasis fontifiers. -Each element of the list is a list of three elements. -The first element is the character used as a marker for fontification. -The second element is a format string to wrap fontified text with. -If it is \"\\verb\", Org will automatically select a delimiter -character that is not in the string. \"\\protectedtexttt\" will use \\texttt -to typeset and try to protect special characters. -The third element decides whether to protect converted text from other -conversions." - :group 'org-export-latex - :type 'alist) - -(defcustom org-export-latex-title-command "\\maketitle" - "The command used to insert the title just after \\begin{document}. -If this string contains the formatting specification \"%s\" then -it will be used as a format string, passing the title as an -argument." - :group 'org-export-latex - :type 'string) - -(defcustom org-export-latex-import-inbuffer-stuff nil - "Non-nil means define TeX macros for Org's inbuffer definitions. -For example \orgTITLE for #+TITLE." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-date-format - "\\today" - "Format string for \\date{...}." - :group 'org-export-latex - :type 'string) - -(defcustom org-export-latex-todo-keyword-markup "\\textbf{%s}" - "Markup for TODO keywords, as a printf format. -This can be a single format for all keywords, a cons cell with separate -formats for not-done and done states, or an association list with setup -for individual keywords. If a keyword shows up for which there is no -markup defined, the first one in the association list will be used." - :group 'org-export-latex - :type '(choice - (string :tag "Default") - (cons :tag "Distinguish undone and done" - (string :tag "Not-DONE states") - (string :tag "DONE states")) - (repeat :tag "Per keyword markup" - (cons - (string :tag "Keyword") - (string :tag "Markup"))))) - -(defcustom org-export-latex-tag-markup "\\textbf{%s}" - "Markup for tags, as a printf format." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-timestamp-markup "\\textit{%s}" - "A printf format string to be applied to time stamps." - :group 'org-export-latex - :type 'string) - -(defcustom org-export-latex-timestamp-inactive-markup "\\textit{%s}" - "A printf format string to be applied to inactive time stamps." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}" - "A printf format string to be applied to time stamps." - :group 'org-export-latex - :type 'string) - -(defcustom org-export-latex-href-format "\\href{%s}{%s}" - "A printf format string to be applied to href links. -The format must contain either two %s instances or just one. -If it contains two %s instances, the first will be filled with -the link, the second with the link description. If it contains -only one, the %s will be filled with the link." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}" - "A printf format string to be applied to hyperref links. -The format must contain one or two %s instances. The first one -will be filled with the link, the second with its description." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-hyperref-options-format - "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={Emacs Org-mode version %s}}\n" - "A format string for hyperref options. -When non-nil, it must contain three %s format specifications -which will respectively be replaced by the document's keywords, -its description and the Org's version number, as a string. Set -this option to the empty string if you don't want to include -hyperref options altogether." - :type 'string - :version "24.3" - :group 'org-export-latex) - -(defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\," - "Text used to separate footnotes." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-quotes - '(("fr" ("\\(\\s-\\|[[(]\\)\"" . "«~") ("\\(\\S-\\)\"" . "~»") ("\\(\\s-\\|(\\)'" . "'")) - ("en" ("\\(\\s-\\|[[(]\\)\"" . "``") ("\\(\\S-\\)\"" . "''") ("\\(\\s-\\|(\\)'" . "`"))) - "Alist for quotes to use when converting english double-quotes. - -The CAR of each item in this alist is the language code. -The CDR of each item in this alist is a list of three CONS: -- the first CONS defines the opening quote; -- the second CONS defines the closing quote; -- the last CONS defines single quotes. - -For each item in a CONS, the first string is a regexp -for allowed characters before/after the quote, the second -string defines the replacement string for this quote." - :group 'org-export-latex - :version "24.1" - :type '(list - (cons :tag "Opening quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")) - (cons :tag "Closing quote" - (string :tag "Regexp for char after ") - (string :tag "Replacement quote ")) - (cons :tag "Single quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")))) - -(defcustom org-export-latex-tables-verbatim nil - "When non-nil, tables are exported verbatim." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-tables-centered t - "When non-nil, tables are exported in a center environment." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-table-caption-above t - "When non-nil, the caption is set above the table. When nil, -the caption is set below the table." - :group 'org-export-latex - :version "24.1" - :type 'boolean) - -(defcustom org-export-latex-tables-column-borders nil - "When non-nil, grouping columns can cause outer vertical lines in tables. -When nil, grouping causes only separation lines between groups." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-tables-tstart nil - "LaTeX command for top rule for tables." - :group 'org-export-latex - :version "24.1" - :type '(choice - (const :tag "Nothing" nil) - (string :tag "String") - (const :tag "Booktabs default: \\toprule" "\\toprule"))) - -(defcustom org-export-latex-tables-hline "\\hline" - "LaTeX command to use for a rule somewhere in the middle of a table." - :group 'org-export-latex - :version "24.1" - :type '(choice - (string :tag "String") - (const :tag "Standard: \\hline" "\\hline") - (const :tag "Booktabs default: \\midrule" "\\midrule"))) - -(defcustom org-export-latex-tables-tend nil - "LaTeX command for bottom rule for tables." - :group 'org-export-latex - :version "24.1" - :type '(choice - (const :tag "Nothing" nil) - (string :tag "String") - (const :tag "Booktabs default: \\bottomrule" "\\bottomrule"))) - -(defcustom org-export-latex-low-levels 'itemize - "How to convert sections below the current level of sectioning. -This is specified by the `org-export-headline-levels' option or the -value of \"H:\" in Org's #+OPTION line. - -This can be either nil (skip the sections), `description', `itemize', -or `enumerate' (convert the sections as the corresponding list type), or -a string to be used instead of \\section{%s}. In this latter case, -the %s stands here for the inserted headline and is mandatory. - -It may also be a list of three string to define a user-defined environment -that should be used. The first string should be the like -\"\\begin{itemize}\", the second should be like \"\\item %s %s\" with up -to two occurrences of %s for the title and a label, respectively. The third -string should be like \"\\end{itemize\"." - :group 'org-export-latex - :type '(choice (const :tag "Ignore" nil) - (const :tag "Convert as descriptive list" description) - (const :tag "Convert as itemized list" itemize) - (const :tag "Convert as enumerated list" enumerate) - (list :tag "User-defined environment" - :value ("\\begin{itemize}" "\\end{itemize}" "\\item %s") - (string :tag "Start") - (string :tag "End") - (string :tag "item")) - (string :tag "Use a section string" :value "\\subparagraph{%s}"))) - -(defcustom org-export-latex-list-parameters - '(:cbon "$\\boxtimes$" :cboff "$\\Box$" :cbtrans "$\\boxminus$") - "Parameters for the LaTeX list exporter. -These parameters will be passed on to `org-list-to-latex', which in turn -will pass them (combined with the LaTeX default list parameters) to -`org-list-to-generic'." - :group 'org-export-latex - :type 'plist) - -(defcustom org-export-latex-verbatim-wrap - '("\\begin{verbatim}\n" . "\\end{verbatim}") - "Environment to be wrapped around a fixed-width section in LaTeX export. -This is a cons with two strings, to be added before and after the -fixed-with text. - -Defaults to \\begin{verbatim} and \\end{verbatim}." - :group 'org-export-translation - :group 'org-export-latex - :type '(cons (string :tag "Open") - (string :tag "Close"))) - -(defcustom org-export-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 -package. Just add these to `org-export-latex-packages-alist', -for example using customize, or with something like - - (require 'org-latex) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"listings\")) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"color\")) - -Alternatively, - - (setq org-export-latex-listings 'minted) - -causes source code to be exported using the minted package as -opposed to listings. If you want to use minted, you need to add -the minted package to `org-export-latex-packages-alist', for -example using customize, or with - - (require 'org-latex) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"minted\")) - -In addition, it is necessary to install -pygments (http://pygments.org), and to configure the variable -`org-latex-to-pdf-process' so that the -shell-escape option is -passed to pdflatex. -" - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-listings-langs - '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp") - (c "C") (cc "C++") - (fortran "fortran") - (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby") - (html "HTML") (xml "XML") - (tex "TeX") (latex "TeX") - (shell-script "bash") - (gnuplot "Gnuplot") - (ocaml "Caml") (caml "Caml") - (sql "SQL") (sqlite "sql")) - "Alist mapping languages to their listing language counterpart. -The key is a symbol, the major mode symbol without the \"-mode\". -The value is the string that should be inserted as the language parameter -for the listings package. If the mode name and the listings name are -the same, the language does not need an entry in this list - but it does not -hurt if it is present." - :group 'org-export-latex - :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Listings language")))) - -(defcustom org-export-latex-listings-w-names t - "Non-nil means export names of named code blocks. -Code blocks exported with the listings package (controlled by the -`org-export-latex-listings' variable) can be named in the style -of noweb." - :group 'org-export-latex - :version "24.1" - :type 'boolean) - -(defcustom org-export-latex-minted-langs - '((emacs-lisp "common-lisp") - (cc "c++") - (cperl "perl") - (shell-script "bash") - (caml "ocaml")) - "Alist mapping languages to their minted language counterpart. -The key is a symbol, the major mode symbol without the \"-mode\". -The value is the string that should be inserted as the language parameter -for the minted package. If the mode name and the listings name are -the same, the language does not need an entry in this list - but it does not -hurt if it is present. - -Note that minted uses all lower case for language identifiers, -and that the full list of language identifiers can be obtained -with: -pygmentize -L lexers -" - :group 'org-export-latex - :version "24.1" - :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Listings language")))) - -(defcustom org-export-latex-listings-options nil - "Association list of options for the latex listings package. - -These options are supplied as a comma-separated list to the -\\lstset command. Each element of the association list should be -a list containing two strings: the name of the option, and the -value. For example, - - (setq org-export-latex-listings-options - '((\"basicstyle\" \"\\small\") - (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\"))) - -will typeset the code in a small size font with underlined, bold -black keywords. - -Note that the same options will be applied to blocks of all -languages." - :group 'org-export-latex - :version "24.1" - :type '(repeat - (list - (string :tag "Listings option name ") - (string :tag "Listings option value")))) - -(defcustom org-export-latex-minted-options nil - "Association list of options for the latex minted package. - -These options are supplied within square brackets in -\\begin{minted} environments. Each element of the alist should be -a list containing two strings: the name of the option, and the -value. For example, - - (setq org-export-latex-minted-options - '((\"bgcolor\" \"bg\") (\"frame\" \"lines\"))) - -will result in src blocks being exported with - -\\begin{minted}[bgcolor=bg,frame=lines]{} - -as the start of the minted environment. Note that the same -options will be applied to blocks of all languages." - :group 'org-export-latex - :version "24.1" - :type '(repeat - (list - (string :tag "Minted option name ") - (string :tag "Minted option value")))) - -(defvar org-export-latex-custom-lang-environments nil - "Association list mapping languages to language-specific latex - environments used during export of src blocks by the listings - and minted latex packages. For example, - - (setq org-export-latex-custom-lang-environments - '((python \"pythoncode\"))) - - would have the effect that if org encounters begin_src python - during latex export it will output - - \\begin{pythoncode} - - \\end{pythoncode}") - -(defcustom org-export-latex-remove-from-headlines - '(:todo nil :priority nil :tags nil) - "A plist of keywords to remove from headlines. OBSOLETE. -Non-nil means remove this keyword type from the headline. - -Don't remove the keys, just change their values. - -Obsolete, this variable is no longer used. Use the separate -variables `org-export-with-todo-keywords', `org-export-with-priority', -and `org-export-with-tags' instead." - :type 'plist - :group 'org-export-latex) - -(defcustom org-export-latex-image-default-option "width=.9\\linewidth" - "Default option for images." - :group 'org-export-latex - :type 'string) - -(defcustom org-latex-default-figure-position "htb" - "Default position for latex figures." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-tabular-environment "tabular" - "Default environment used to build tables." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-link-with-unknown-path-format "\\texttt{%s}" - "Format string for links with unknown path type." - :group 'org-export-latex - :version "24.3" - :type 'string) - -(defcustom org-export-latex-inline-image-extensions - '("pdf" "jpeg" "jpg" "png" "ps" "eps") - "Extensions of image files that can be inlined into LaTeX. -Note that the image extension *actually* allowed depend on the way the -LaTeX file is processed. When used with pdflatex, pdf, jpg and png images -are OK. When processing through dvi to Postscript, only ps and eps are -allowed. The default we use here encompasses both." - :group 'org-export-latex - :type '(repeat (string :tag "Extension"))) - -(defcustom org-export-latex-coding-system nil - "Coding system for the exported LaTeX file." - :group 'org-export-latex - :type 'coding-system) - -(defgroup org-export-pdf nil - "Options for exporting Org-mode files to PDF, via LaTeX." - :tag "Org Export PDF" - :group 'org-export-latex - :group 'org-export) - -(defcustom org-latex-to-pdf-process - '("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f") - "Commands to process a LaTeX file to a PDF file and process latex -fragments to pdf files.By default,this is a list of strings,and each of -strings will be given to the shell as a command. %f in the command will -be replaced by the full file name, %b by the file base name (i.e. without -extension) and %o by the base directory of the file. - -If you set `org-create-formula-image-program' -`org-export-with-LaTeX-fragments' to 'imagemagick, you can add a -sublist which contains your own command(s) for LaTeX fragments -previewing, like this: - - '(\"xelatex -interaction nonstopmode -output-directory %o %f\" - \"xelatex -interaction nonstopmode -output-directory %o %f\" - ;; use below command(s) to convert latex fragments - (\"xelatex %f\")) - -With no such sublist, the default command used to convert LaTeX -fragments will be the first string in the list. - -The reason why this is a list is that it usually takes several runs of -`pdflatex', maybe mixed with a call to `bibtex'. Org does not have a clever -mechanism to detect which of these commands have to be run to get to a stable -result, and it also does not do any error checking. - -By default, Org uses 3 runs of `pdflatex' to do the processing. If you -have texi2dvi on your system and if that does not cause the infamous -egrep/locale bug: - - http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html - -then `texi2dvi' is the superior choice. Org does offer it as one -of the customize options. - -Alternatively, this may be a Lisp function that does the processing, so you -could use this to apply the machinery of AUCTeX or the Emacs LaTeX mode. -This function should accept the file name as its single argument." - :group 'org-export-pdf - :type '(choice - (repeat :tag "Shell command sequence" - (string :tag "Shell command")) - (const :tag "2 runs of pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "3 runs of pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "pdflatex,bibtex,pdflatex,pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "2 runs of xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "3 runs of xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "xelatex,bibtex,xelatex,xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "texi2dvi" - ("texi2dvi -p -b -c -V %f")) - (const :tag "rubber" - ("rubber -d --into %o %f")) - (function))) - -(defcustom org-export-pdf-logfiles - '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") - "The list of file extensions to consider as LaTeX logfiles." - :group 'org-export-pdf - :version "24.1" - :type '(repeat (string :tag "Extension"))) - -(defcustom org-export-pdf-remove-logfiles t - "Non-nil means remove the logfiles produced by PDF production. -These are the .aux, .log, .out, and .toc files." - :group 'org-export-pdf - :type 'boolean) - -;;; Hooks - -(defvar org-export-latex-after-initial-vars-hook nil - "Hook run before LaTeX export. -The exact moment is after the initial variables like org-export-latex-class -have been determined from the environment.") - -(defvar org-export-latex-after-blockquotes-hook nil - "Hook run during LaTeX export, after blockquote, verse, center are done.") - -(defvar org-export-latex-final-hook nil - "Hook run in the finalized LaTeX buffer.") - -(defvar org-export-latex-after-save-hook nil - "Hook run in the finalized LaTeX buffer, after it has been saved.") - -;;; Autoload functions: - -;;;###autoload -(defun org-export-as-latex-batch () - "Call `org-export-as-latex', may be used in batch processing. -For example: - -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-export-as-latex-batch" - (org-export-as-latex org-export-headline-levels)) - -;;;###autoload -(defun org-export-as-latex-to-buffer (arg) - "Call `org-export-as-latex` with output to a temporary buffer. -No file is created. The prefix ARG is passed through to `org-export-as-latex'." - (interactive "P") - (org-export-as-latex arg nil "*Org LaTeX Export*") - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window "*Org LaTeX Export*"))) - -;;;###autoload -(defun org-replace-region-by-latex (beg end) - "Replace the region from BEG to END with its LaTeX export. -It assumes the region has `org-mode' syntax, and then convert it to -LaTeX. This can be used in any buffer. For example, you could -write an itemized list in `org-mode' syntax in an LaTeX buffer and -then use this command to convert it." - (interactive "r") - (let (reg latex buf) - (save-window-excursion - (if (derived-mode-p 'org-mode) - (setq latex (org-export-region-as-latex - beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq latex (org-export-region-as-latex - (point-min) (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert latex))) - -;;;###autoload -(defun org-export-region-as-latex (beg end &optional body-only buffer) - "Convert region from BEG to END in `org-mode' buffer to LaTeX. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted LaTeX. If BUFFER is the symbol `string', return the -produced LaTeX as a string and leave no buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq latex (org-export-region-as-latex beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (interactive "r\nP") - (when (org-called-interactively-p 'any) - (setq buffer "*Org LaTeX Export*")) - (let ((transient-mark-mode t) (zmacs-regions t) - ext-plist rtn) - (setq ext-plist (plist-put ext-plist :ignore-subtree-p t)) - (goto-char end) - (set-mark (point)) ;; to activate the region - (goto-char beg) - (setq rtn (org-export-as-latex - nil ext-plist - buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (org-called-interactively-p 'any) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -;;;###autoload -(defun org-export-as-latex (arg &optional ext-plist to-buffer body-only pub-dir) - "Export current buffer to a LaTeX file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will be exported -depending on `org-export-latex-low-levels'. The default is to -convert them as description lists. -EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local settings. -When TO-BUFFER is non-nil, create a buffer with that name and export -to that buffer. If TO-BUFFER is the symbol `string', don't leave any -buffer behind and just return the resulting LaTeX as a string, with -no LaTeX header. -When BODY-ONLY is set, don't produce the file header and footer, -simply return the content of \\begin{document}...\\end{document}, -without even the \\begin{document} and \\end{document} commands. -When PUB-DIR is set, use this as the publishing directory." - (interactive "P") - (when (and (not body-only) arg (listp arg)) (setq body-only t)) - (run-hooks 'org-export-first-hook) - - ;; Make sure we have a file name when we need it. - (when (and (not (or to-buffer body-only)) - (not buffer-file-name)) - (if (buffer-base-buffer) - (org-set-local 'buffer-file-name - (with-current-buffer (buffer-base-buffer) - buffer-file-name)) - (error "Need a file name to be able to export"))) - - (message "Exporting to LaTeX...") - (org-unmodified - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill nil)))) - (org-update-radio-target-regexp) - (org-export-latex-set-initial-vars ext-plist arg) - (setq org-export-opt-plist org-export-latex-options-plist - org-export-footnotes-data (org-footnote-all-labels 'with-defs) - org-export-footnotes-seen nil - org-export-latex-footmark-seen nil) - (org-install-letbind) - (run-hooks 'org-export-latex-after-initial-vars-hook) - (let* ((wcf (current-window-configuration)) - (opt-plist - (org-export-process-option-filters org-export-latex-options-plist)) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - ;; Make sure the variable contains the updated values. - (org-export-latex-options-plist (setq org-export-opt-plist opt-plist)) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-export-directory :html opt-plist))) - (org-current-export-file buffer-file-name) - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "No Title")) - (filename - (and (not to-buffer) - (concat - (file-name-as-directory - (or pub-dir - (org-export-directory :LaTeX org-export-latex-options-plist))) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get rbeg "EXPORT_FILE_NAME" t)) - (file-name-nondirectory ;sans-extension - (or buffer-file-name - (error "Don't know which export file to use"))))) - ".tex"))) - (filename - (and filename - (if (equal (file-truename filename) - (file-truename (or buffer-file-name "dummy.org"))) - (concat filename ".tex") - filename))) - (auto-insert nil); Avoid any auto-insert stuff for the new file - (TeX-master (boundp 'TeX-master)) - (buffer (if to-buffer - (if (eq to-buffer 'string) - (get-buffer-create "*Org LaTeX Export*") - (get-buffer-create to-buffer)) - (find-file-noselect filename))) - (odd org-odd-levels-only) - (header (org-export-latex-make-header title opt-plist)) - (skip (cond (subtree-p nil) - (region-p nil) - (t (plist-get opt-plist :skip-before-1st-heading)))) - (text (plist-get opt-plist :text)) - (org-export-preprocess-hook - (cons - `(lambda () (org-set-local 'org-complex-heading-regexp - ,org-export-latex-complex-heading-re)) - org-export-preprocess-hook)) - (first-lines (if skip "" (org-export-latex-first-lines - opt-plist - (if subtree-p - (save-excursion - (goto-char rbeg) - (point-at-bol 2)) - rbeg) - (if region-p rend)))) - (coding-system (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system)) - (coding-system-for-write (or org-export-latex-coding-system - coding-system)) - (save-buffer-coding-system (or org-export-latex-coding-system - coding-system)) - (region (buffer-substring - (if region-p (region-beginning) (point-min)) - (if region-p (region-end) (point-max)))) - (text - (and text (string-match "\\S-" text) - (org-export-preprocess-string - text - :emph-multiline t - :for-backend 'latex - :comments nil - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :drawers (plist-get opt-plist :drawers) - :timestamps (plist-get opt-plist :timestamps) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :add-text nil - :skip-before-1st-heading skip - :select-tags nil - :exclude-tags nil - :LaTeX-fragments nil))) - (string-for-export - (org-export-preprocess-string - region - :emph-multiline t - :for-backend 'latex - :comments nil - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :drawers (plist-get opt-plist :drawers) - :timestamps (plist-get opt-plist :timestamps) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :add-text (if (eq to-buffer 'string) nil text) - :skip-before-1st-heading skip - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :LaTeX-fragments nil))) - - (set-buffer buffer) - (erase-buffer) - (org-install-letbind) - - (and (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system coding-system-for-write)) - - ;; insert the header and initial document commands - (unless (or (eq to-buffer 'string) body-only) - (insert header)) - - ;; insert text found in #+TEXT - (when (and text (not (eq to-buffer 'string))) - (insert (org-export-latex-content - text '(lists tables fixed-width keywords)) - "\n\n")) - - ;; insert lines before the first headline - (unless (or skip (string-match "^\\*" first-lines)) - (insert first-lines)) - - ;; export the content of headlines - (org-export-latex-global - (with-temp-buffer - (insert string-for-export) - (goto-char (point-min)) - (when (re-search-forward "^\\(\\*+\\) " nil t) - (let* ((asters (length (match-string 1))) - (level (if odd (- asters 2) (- asters 1)))) - (setq org-export-latex-add-level - (if odd (1- (/ (1+ asters) 2)) (1- asters))) - (org-export-latex-parse-global level odd))))) - - ;; finalization - (unless body-only (insert "\n\\end{document}")) - - ;; Attach description terms to the \item macro - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*\\\\item\\([ \t]+\\)\\[" nil t) - (delete-region (match-beginning 1) (match-end 1))) - - ;; Relocate the table of contents - (goto-char (point-min)) - (when (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t) - (goto-char (point-min)) - (while (re-search-forward "\\\\tableofcontents\\>[ \t]*\n?" nil t) - (replace-match "")) - (goto-char (point-min)) - (and (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t) - (replace-match "\\tableofcontents" t t))) - - ;; Cleanup forced line ends in items where they are not needed - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*\n\\\\begin" - nil t) - (delete-region (match-beginning 1) (match-end 1))) - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*" - nil t) - (if (looking-at "[\n \t]+") - (replace-match "\n"))) - - ;; Ensure we have a final newline - (goto-char (point-max)) - (or (eq (char-before) ?\n) - (insert ?\n)) - - (run-hooks 'org-export-latex-final-hook) - (if to-buffer - (unless (eq major-mode 'latex-mode) (latex-mode)) - (save-buffer)) - (org-export-latex-fix-inputenc) - (run-hooks 'org-export-latex-after-save-hook) - (goto-char (point-min)) - (or (org-export-push-to-kill-ring "LaTeX") - (message "Exporting to LaTeX...done")) - (prog1 - (if (eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer))) - (current-buffer)) - (set-window-configuration wcf)))) - -;;;###autoload -(defun org-export-as-pdf (arg &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export as LaTeX, then process through to PDF." - (interactive "P") - (message "Exporting to PDF...") - (let* ((wconfig (current-window-configuration)) - (lbuf (org-export-as-latex arg ext-plist to-buffer body-only pub-dir)) - (file (buffer-file-name lbuf)) - (base (file-name-sans-extension (buffer-file-name lbuf))) - (pdffile (concat base ".pdf")) - (cmds (if (eq org-export-latex-listings 'minted) - ;; automatically add -shell-escape when needed - (mapcar (lambda (cmd) - (replace-regexp-in-string - "pdflatex " "pdflatex -shell-escape " cmd)) - org-latex-to-pdf-process) - org-latex-to-pdf-process)) - (outbuf (get-buffer-create "*Org PDF LaTeX Output*")) - (bibtex-p (with-current-buffer lbuf - (save-excursion - (goto-char (point-min)) - (re-search-forward "\\\\bibliography{" nil t)))) - cmd output-dir errors) - (with-current-buffer outbuf (erase-buffer)) - (message (concat "Processing LaTeX file " file "...")) - (setq output-dir (file-name-directory file)) - (with-current-buffer lbuf - (save-excursion - (if (and cmds (symbolp cmds)) - (funcall cmds (shell-quote-argument file)) - (while cmds - (setq cmd (pop cmds)) - (cond - ((not (listp cmd)) - (while (string-match "%b" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument base)) - t t cmd))) - (while (string-match "%f" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument file)) - t t cmd))) - (while (string-match "%o" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument output-dir)) - t t cmd))) - (shell-command cmd outbuf))))))) - (message (concat "Processing LaTeX file " file "...done")) - (setq errors (org-export-latex-get-error outbuf)) - (if (not (file-exists-p pdffile)) - (error (concat "PDF file " pdffile " was not produced" - (if errors (concat ":" errors "") ""))) - (set-window-configuration wconfig) - (when org-export-pdf-remove-logfiles - (dolist (ext org-export-pdf-logfiles) - (setq file (concat base "." ext)) - (and (file-exists-p file) (delete-file file)))) - (message (concat - "Exporting to PDF...done" - (if errors - (concat ", with some errors:" errors) - ""))) - pdffile))) - -(defun org-export-latex-get-error (buf) - "Collect the kinds of errors that remain in pdflatex processing." - (with-current-buffer buf - (save-excursion - (goto-char (point-max)) - (when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t) - ;; OK, we are at the location of the final run - (let ((pos (point)) (errors "") (case-fold-search t)) - (if (re-search-forward "Reference.*?undefined" nil t) - (setq errors (concat errors " [undefined reference]"))) - (goto-char pos) - (if (re-search-forward "Citation.*?undefined" nil t) - (setq errors (concat errors " [undefined citation]"))) - (goto-char pos) - (if (re-search-forward "Undefined control sequence" nil t) - (setq errors (concat errors " [undefined control sequence]"))) - (and (org-string-nw-p errors) errors)))))) - -;;;###autoload -(defun org-export-as-pdf-and-open (arg) - "Export as LaTeX, then process through to PDF, and open." - (interactive "P") - (let ((pdffile (org-export-as-pdf arg))) - (if pdffile - (progn - (org-open-file pdffile) - (when org-export-kill-product-buffer-when-displayed - (kill-buffer (find-buffer-visiting - (concat (file-name-sans-extension (buffer-file-name)) - ".tex"))))) - (error "PDF file was not produced")))) - -;;; Parsing functions: - -(defun org-export-latex-parse-global (level odd) - "Parse the current buffer recursively, starting at LEVEL. -If ODD is non-nil, assume the buffer only contains odd sections. -Return a list reflecting the document structure." - (save-excursion - (goto-char (point-min)) - (let* ((cnt 0) output - (depth org-export-latex-sectioning-depth)) - (while (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string (+ (if odd 2 1) level)) - "\\}\\) \\(.*\\)$") - ;; make sure that there is no upper heading - (when (> level 0) - (save-excursion - (save-match-data - (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string level) - "\\}\\) \\(.*\\)$") nil t)))) t) - (setq cnt (1+ cnt)) - (let* ((pos (match-beginning 0)) - (heading (match-string 2)) - (nlevel (if odd (/ (+ 3 level) 2) (1+ level)))) - (save-excursion - (narrow-to-region - (point) - (save-match-data - (if (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string (+ (if odd 2 1) level)) - "\\}\\) \\(.*\\)$") nil t) - (match-beginning 0) - (point-max)))) - (goto-char (point-min)) - (setq output - (append output - (list - (list - `(pos . ,pos) - `(level . ,nlevel) - `(occur . ,cnt) - `(heading . ,heading) - `(content . ,(org-export-latex-parse-content)) - `(subcontent . ,(org-export-latex-parse-subcontent - level odd))))))) - (widen))) - (list output)))) - -(defun org-export-latex-parse-content () - "Extract the content of a section." - (let ((beg (point)) - (end (if (org-re-search-forward-unprotected "^\\(\\*\\)+ .*$" nil t) - (progn (beginning-of-line) (point)) - (point-max)))) - (buffer-substring beg end))) - -(defun org-export-latex-parse-subcontent (level odd) - "Extract the subcontent of a section at LEVEL. -If ODD Is non-nil, assume subcontent only contains odd sections." - (if (not (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string (+ (if odd 4 2) level)) - "\\}\\) \\(.*\\)$") - nil t)) - nil ; subcontent is nil - (org-export-latex-parse-global (+ (if odd 2 1) level) odd))) - -;;; Rendering functions: -(defun org-export-latex-global (content) - "Export CONTENT to LaTeX. -CONTENT is an element of the list produced by -`org-export-latex-parse-global'." - (if (eq (car content) 'subcontent) - (mapc 'org-export-latex-sub (cdr content)) - (org-export-latex-sub (car content)))) - -(defun org-export-latex-sub (subcontent) - "Export the list SUBCONTENT to LaTeX. -SUBCONTENT is an alist containing information about the headline -and its content." - (let ((num (plist-get org-export-latex-options-plist :section-numbers))) - (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent))) - -(defun org-export-latex-subcontent (subcontent num) - "Export each cell of SUBCONTENT to LaTeX. -If NUM is non-nil export numbered sections, otherwise use unnumbered -sections. If NUM is an integer, export the highest NUM levels as -numbered sections and lower levels as unnumbered sections." - (let* ((heading (cdr (assoc 'heading subcontent))) - (level (- (cdr (assoc 'level subcontent)) - org-export-latex-add-level)) - (occur (number-to-string (cdr (assoc 'occur subcontent)))) - (content (cdr (assoc 'content subcontent))) - (subcontent (cadr (assoc 'subcontent subcontent))) - (label (org-get-text-property-any 0 'target heading)) - (label-list (cons label (cdr (assoc label - org-export-target-aliases)))) - (sectioning org-export-latex-sectioning) - (depth org-export-latex-sectioning-depth) - main-heading sub-heading ctnt) - (when (symbolp (car sectioning)) - (setq sectioning (funcall (car sectioning) level heading)) - (when sectioning - (setq heading (car sectioning) - sectioning (cdr sectioning) - ;; target property migh have changed... - label (org-get-text-property-any 0 'target heading) - label-list (cons label (cdr (assoc label - org-export-target-aliases))))) - (if sectioning (setq sectioning (make-list 10 sectioning))) - (setq depth (if sectioning 10000 0))) - (if (string-match "[ \t]*\\\\\\\\[ \t]*" heading) - (setq main-heading (substring heading 0 (match-beginning 0)) - sub-heading (substring heading (match-end 0)))) - (setq heading (org-export-latex-fontify-headline heading) - sub-heading (and sub-heading - (org-export-latex-fontify-headline sub-heading)) - main-heading (and main-heading - (org-export-latex-fontify-headline main-heading))) - (cond - ;; Normal conversion - ((<= level depth) - (let* ((sec (nth (1- level) sectioning)) - (num (if (integerp num) - (>= num level) - num)) - start end) - (if (consp (cdr sec)) - (setq start (nth (if num 0 2) sec) - end (nth (if num 1 3) sec)) - (setq start (if num (car sec) (cdr sec)))) - (insert (format start (if main-heading main-heading heading) - (or sub-heading ""))) - (insert "\n") - (when label - (insert (mapconcat (lambda (l) (format "\\label{%s}" l)) - label-list "\n") "\n")) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) - (while (org-looking-back "\n\n") (backward-delete-char 1)) - (org-export-latex-sub subcontent))) - (when (and end (string-match "[^ \t]" end)) - (let ((hook (org-get-text-property-any 0 'org-insert-hook end))) - (and (functionp hook) (funcall hook))) - (insert end "\n")))) - ;; At a level under the hl option: we can drop this subsection - ((> level depth) - (cond ((eq org-export-latex-low-levels 'description) - (if (string-match "% ends low level$" - (buffer-substring (point-at-bol 0) (point))) - (delete-region (point-at-bol 0) (point)) - (insert "\\begin{description}\n")) - (insert (format "\n\\item[%s]%s~\n" - heading - (if label (format "\\label{%s}" label) ""))) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))) - (insert "\\end{description} % ends low level\n")) - ((memq org-export-latex-low-levels '(itemize enumerate)) - (if (string-match "% ends low level$" - (buffer-substring (point-at-bol 0) (point))) - (delete-region (point-at-bol 0) (point)) - (insert (format "\\begin{%s}\n" - (symbol-name org-export-latex-low-levels)))) - (let ((ctnt (org-export-latex-content content))) - (insert (format (if (not (equal (replace-regexp-in-string "\n" "" ctnt) "")) - "\n\\item %s\\\\\n%s%%" - "\n\\item %s\n%s%%") - heading - (if label (format "\\label{%s}" label) ""))) - (insert ctnt)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))) - (insert (format "\\end{%s} %% ends low level\n" - (symbol-name org-export-latex-low-levels)))) - - ((and (listp org-export-latex-low-levels) - org-export-latex-low-levels) - (if (string-match "% ends low level$" - (buffer-substring (point-at-bol 0) (point))) - (delete-region (point-at-bol 0) (point)) - (insert (car org-export-latex-low-levels) "\n")) - (insert (format (nth 2 org-export-latex-low-levels) - heading - (if label (format "\\label{%s}" label) ""))) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))) - (insert (nth 1 org-export-latex-low-levels) - " %% ends low level\n")) - - ((stringp org-export-latex-low-levels) - (insert (format org-export-latex-low-levels heading) "\n") - (when label (insert (format "\\label{%s}\n" label))) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))))))))) - -;;; Exporting internals: -(defun org-export-latex-set-initial-vars (ext-plist level) - "Store org local variables required for LaTeX export. -EXT-PLIST is an optional additional plist. -LEVEL indicates the default depth for export." - (setq org-export-latex-todo-keywords-1 org-todo-keywords-1 - org-export-latex-done-keywords org-done-keywords - org-export-latex-not-done-keywords org-not-done-keywords - org-export-latex-complex-heading-re org-complex-heading-regexp - org-export-latex-display-custom-times org-display-custom-times - org-export-latex-all-targets-re - (org-make-target-link-regexp (org-all-targets)) - org-export-latex-options-plist - (org-combine-plists (org-default-export-plist) ext-plist - (org-infile-export-plist)) - org-export-latex-class - (or (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (and (looking-at org-complex-heading-regexp) - (org-entry-get nil "LaTeX_CLASS" 'selective)))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([-/a-zA-Z]+\\)" nil t) - (match-string 1)))) - (plist-get org-export-latex-options-plist :latex-class) - org-export-latex-default-class) - org-export-latex-class-options - (or (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (and (looking-at org-complex-heading-regexp) - (org-entry-get nil "LaTeX_CLASS_OPTIONS" 'selective)))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (and (re-search-forward "^#\\+LaTeX_CLASS_OPTIONS:[ \t]*\\(.*?\\)[ \t]*$" nil t) - (match-string 1)))) - (plist-get org-export-latex-options-plist :latex-class-options)) - org-export-latex-class - (or (car (assoc org-export-latex-class org-export-latex-classes)) - (error "No definition for class `%s' in `org-export-latex-classes'" - org-export-latex-class)) - org-export-latex-header - (cadr (assoc org-export-latex-class org-export-latex-classes)) - org-export-latex-sectioning - (cddr (assoc org-export-latex-class org-export-latex-classes)) - org-export-latex-sectioning-depth - (or level - (let ((hl-levels - (plist-get org-export-latex-options-plist :headline-levels)) - (sec-depth (length org-export-latex-sectioning))) - (if (> hl-levels sec-depth) sec-depth hl-levels)))) - (when (and org-export-latex-class-options - (string-match "\\S-" org-export-latex-class-options) - (string-match "^[ \t]*\\(\\\\documentclass\\)\\(\\[.*?\\]\\)?" - org-export-latex-header)) - (setq org-export-latex-header - (concat (substring org-export-latex-header 0 (match-end 1)) - org-export-latex-class-options - (substring org-export-latex-header (match-end 0)))))) - -(defvar org-export-latex-format-toc-function - 'org-export-latex-format-toc-default - "The function formatting returning the string to create the table of contents. -The function mus take one parameter, the depth of the table of contents.") - -(defun org-export-latex-make-header (title opt-plist) - "Make the LaTeX header and return it as a string. -TITLE is the current title from the buffer or region. -OPT-PLIST is the options plist for current buffer." - (let ((toc (plist-get opt-plist :table-of-contents)) - (author (org-export-apply-macros-in-string - (plist-get opt-plist :author))) - (email (replace-regexp-in-string - "_" "\\\\_" - (org-export-apply-macros-in-string - (plist-get opt-plist :email)))) - (description (org-export-apply-macros-in-string - (plist-get opt-plist :description))) - (keywords (org-export-apply-macros-in-string - (plist-get opt-plist :keywords)))) - (concat - (if (plist-get opt-plist :time-stamp-file) - (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) - ;; insert LaTeX custom header and packages from the list - (org-splice-latex-header - (org-export-apply-macros-in-string org-export-latex-header) - org-export-latex-default-packages-alist - org-export-latex-packages-alist nil - (org-export-apply-macros-in-string - (plist-get opt-plist :latex-header-extra))) - ;; append another special variable - (org-export-apply-macros-in-string org-export-latex-append-header) - ;; define alert if not yet defined - "\n\\providecommand{\\alert}[1]{\\textbf{#1}}" - ;; insert the title - (format - "\n\n\\title{%s}\n" - (org-export-latex-fontify-headline title)) - ;; insert author info - (if (plist-get opt-plist :author-info) - (format "\\author{%s%s}\n" - (org-export-latex-fontify-headline (or author user-full-name)) - (if (and (plist-get opt-plist :email-info) email - (string-match "\\S-" email)) - (format "\\thanks{%s}" email) - "")) - (format "%%\\author{%s}\n" - (org-export-latex-fontify-headline (or author user-full-name)))) - ;; insert the date - (format "\\date{%s}\n" - (format-time-string - (or (plist-get opt-plist :date) - org-export-latex-date-format))) - ;; add some hyperref options - (format org-export-latex-hyperref-options-format - (org-export-latex-fontify-headline keywords) - (org-export-latex-fontify-headline description) - (org-version)) - ;; beginning of the document - "\n\\begin{document}\n\n" - ;; insert the title command - (when (string-match "\\S-" title) - (if (string-match "%s" org-export-latex-title-command) - (format org-export-latex-title-command title) - org-export-latex-title-command)) - "\n\n" - ;; table of contents - (when (and org-export-with-toc - (plist-get opt-plist :section-numbers)) - (funcall org-export-latex-format-toc-function - (cond ((numberp toc) - (min toc (plist-get opt-plist :headline-levels))) - (toc (plist-get opt-plist :headline-levels)))))))) - -(defun org-export-latex-format-toc-default (depth) - (when depth - (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n" - depth))) - -(defun org-export-latex-first-lines (opt-plist &optional beg end) - "Export the first lines before first headline. -If BEG is non-nil, it is the beginning of the region. -If END is non-nil, it is the end of the region." - (save-excursion - (goto-char (or beg (point-min))) - (let* ((pt (point)) - (end (if (re-search-forward - (concat "^" (org-get-limited-outline-regexp)) end t) - (goto-char (match-beginning 0)) - (goto-char (or end (point-max)))))) - (prog1 - (org-export-latex-content - (org-export-preprocess-string - (buffer-substring pt end) - :for-backend 'latex - :emph-multiline t - :add-text nil - :comments nil - :skip-before-1st-heading nil - :LaTeX-fragments nil - :timestamps (plist-get opt-plist :timestamps) - :footnotes (plist-get opt-plist :footnotes))) - (org-unmodified - (let ((inhibit-read-only t) - (limit (max pt (1- end)))) - (add-text-properties pt limit - '(:org-license-to-kill t)) - (save-excursion - (goto-char pt) - (while (re-search-forward "^[ \t]*#\\+.*\n?" limit t) - (let ((case-fold-search t)) - (unless (org-string-match-p - "^[ \t]*#\\+\\(attr_\\|caption\\>\\|label\\>\\)" - (match-string 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(:org-license-to-kill t)))))))))))) - - -(defvar org-export-latex-header-defs nil - "The header definitions that might be used in the LaTeX body.") - -(defun org-export-latex-content (content &optional exclude-list) - "Convert CONTENT string to LaTeX. -Don't perform conversions that are in EXCLUDE-LIST. Recognized -conversion types are: quotation-marks, emphasis, sub-superscript, -links, keywords, lists, tables, fixed-width" - (with-temp-buffer - (org-install-letbind) - (insert content) - (unless (memq 'timestamps exclude-list) - (org-export-latex-time-stamps)) - (unless (memq 'quotation-marks exclude-list) - (org-export-latex-quotation-marks)) - (unless (memq 'emphasis exclude-list) - (when (plist-get org-export-latex-options-plist :emphasize) - (org-export-latex-fontify))) - (unless (memq 'sub-superscript exclude-list) - (org-export-latex-special-chars - (plist-get org-export-latex-options-plist :sub-superscript))) - (unless (memq 'links exclude-list) - (org-export-latex-links)) - (unless (memq 'keywords exclude-list) - (org-export-latex-keywords)) - (unless (memq 'lists exclude-list) - (org-export-latex-lists)) - (unless (memq 'tables exclude-list) - (org-export-latex-tables - (plist-get org-export-latex-options-plist :tables))) - (unless (memq 'fixed-width exclude-list) - (org-export-latex-fixed-width - (plist-get org-export-latex-options-plist :fixed-width))) - ;; return string - (buffer-substring (point-min) (point-max)))) - -(defun org-export-latex-protect-string (s) - "Add the org-protected property to string S." - (add-text-properties 0 (length s) '(org-protected t) s) s) - -(defun org-export-latex-protect-char-in-string (char-list string) - "Add org-protected text-property to char from CHAR-LIST in STRING." - (with-temp-buffer - (save-match-data - (insert string) - (goto-char (point-min)) - (while (re-search-forward (regexp-opt char-list) nil t) - (add-text-properties (match-beginning 0) - (match-end 0) '(org-protected t))) - (buffer-string)))) - -(defun org-export-latex-keywords-maybe (&optional remove-list) - "Maybe remove keywords depending on rules in REMOVE-LIST." - (goto-char (point-min)) - (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|")) - (case-fold-search nil) - (todo-markup org-export-latex-todo-keyword-markup) - fmt) - ;; convert TODO keywords - (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t) - (if (plist-get remove-list :todo) - (replace-match "") - (setq fmt (cond - ((stringp todo-markup) todo-markup) - ((and (consp todo-markup) (stringp (car todo-markup))) - (if (member (match-string 1) org-export-latex-done-keywords) - (cdr todo-markup) (car todo-markup))) - (t (cdr (or (assoc (match-string 1) todo-markup) - (car todo-markup)))))) - (replace-match (org-export-latex-protect-string - (format fmt (match-string 1))) t t))) - ;; convert priority string - (when (re-search-forward "\\[\\\\#.\\]" nil t) - (if (plist-get remove-list :priority) - (replace-match "") - (replace-match (format "\\textbf{%s}" (match-string 0)) t t))) - ;; convert tags - (when (re-search-forward "\\(:[a-zA-Z0-9_@#%]+\\)+:" nil t) - (if (or (not org-export-with-tags) - (plist-get remove-list :tags)) - (replace-match "") - (replace-match - (org-export-latex-protect-string - (format org-export-latex-tag-markup - (save-match-data - (replace-regexp-in-string - "\\([_#]\\)" "\\\\\\1" (match-string 0))))) - t t))))) - -(defun org-export-latex-fontify-headline (string) - "Fontify special words in STRING." - (with-temp-buffer - ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at - ;; the beginning of the buffer - inserting "\n" is safe here though. - (insert "\n" string) - - ;; Preserve math snippets - - (let* ((matchers (plist-get org-format-latex-options :matchers)) - (re-list org-latex-regexps) - beg end re e m n block off) - ;; Check the different regular expressions - (while (setq e (pop re-list)) - (setq m (car e) re (nth 1 e) n (nth 2 e) - block (if (nth 3 e) "\n\n" "")) - (setq off (if (member m '("$" "$1")) 1 0)) - (when (and (member m matchers) (not (equal m "begin"))) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0)) - (add-text-properties beg end - '(org-protected t org-latex-math t)))))) - - ;; Convert LaTeX to \LaTeX{} and TeX to \TeX{} - (goto-char (point-min)) - (let ((case-fold-search nil)) - (while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t) - (unless (eq (char-before (match-beginning 1)) ?\\) - (org-if-unprotected-1 - (replace-match (org-export-latex-protect-string - (concat "\\" (match-string 1) - "{}")) t t))))) - (goto-char (point-min)) - (let ((re (concat "\\\\\\([a-zA-Z]+\\)" - "\\(?:<[^<>\n]*>\\)*" - "\\(?:\\[[^][\n]*?\\]\\)*" - "\\(?:<[^<>\n]*>\\)*" - "\\(" - (org-create-multibrace-regexp "{" "}" 3) - "\\)\\{1,3\\}"))) - (while (re-search-forward re nil t) - (unless (or - ;; check for comment line - (save-excursion (goto-char (match-beginning 0)) - (org-in-indented-comment-line)) - ;; Check if this is a defined entity, so that is may need conversion - (org-entity-get (match-string 1))) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))))) - (when (plist-get org-export-latex-options-plist :emphasize) - (org-export-latex-fontify)) - (org-export-latex-time-stamps) - (org-export-latex-quotation-marks) - (org-export-latex-keywords-maybe) - (org-export-latex-special-chars - (plist-get org-export-latex-options-plist :sub-superscript)) - (org-export-latex-links) - (org-trim (buffer-string)))) - -(defun org-export-latex-time-stamps () - "Format time stamps." - (goto-char (point-min)) - (let ((org-display-custom-times org-export-latex-display-custom-times)) - (while (re-search-forward org-ts-regexp-both nil t) - (org-if-unprotected-at (1- (point)) - (replace-match - (org-export-latex-protect-string - (format (if (string= "<" (substring (match-string 0) 0 1)) - org-export-latex-timestamp-markup - org-export-latex-timestamp-inactive-markup) - (substring (org-translate-time (match-string 0)) 1 -1))) - t t))))) - -(defun org-export-latex-quotation-marks () - "Export quotation marks depending on language conventions." - (mapc (lambda(l) - (goto-char (point-min)) - (while (re-search-forward (car l) nil t) - (let ((rpl (concat (match-string 1) - (org-export-latex-protect-string - (copy-sequence (cdr l)))))) - (org-if-unprotected-1 - (replace-match rpl t t))))) - (cdr (or (assoc (plist-get org-export-latex-options-plist :language) - org-export-latex-quotes) - ;; falls back on english - (assoc "en" org-export-latex-quotes))))) - -(defun org-export-latex-special-chars (sub-superscript) - "Export special characters to LaTeX. -If SUB-SUPERSCRIPT is non-nil, convert \\ and ^. -See the `org-export-latex.el' code for a complete conversion table." - (goto-char (point-min)) - (mapc (lambda(c) - (goto-char (point-min)) - (while (re-search-forward c nil t) - ;; Put the point where to check for org-protected - (unless (get-text-property (match-beginning 2) 'org-protected) - (cond ((member (match-string 2) '("\\$" "$")) - (if (equal (match-string 2) "\\$") - nil - (replace-match "\\$" t t))) - ((member (match-string 2) '("&" "%" "#")) - (if (equal (match-string 1) "\\") - (replace-match (match-string 2) t t) - (replace-match (concat (match-string 1) "\\" - (match-string 2)) t t) - (backward-char 1))) - ((equal (match-string 2) "...") - (replace-match - (concat (match-string 1) - (org-export-latex-protect-string "\\ldots{}")) t t)) - ((equal (match-string 2) "~") - (cond ((equal (match-string 1) "\\") nil) - ((eq 'org-link (get-text-property 0 'face (match-string 2))) - (replace-match (concat (match-string 1) "\\~") t t)) - (t (replace-match - (org-export-latex-protect-string - (concat (match-string 1) "\\~{}")) t t)))) - ((member (match-string 2) '("{" "}")) - (unless (save-match-data (org-inside-latex-math-p)) - (if (equal (match-string 1) "\\") - (replace-match (match-string 2) t t) - (replace-match (concat (match-string 1) "\\" - (match-string 2)) t t))))) - (unless (save-match-data (or (org-inside-latex-math-p) (org-at-table-p))) - (cond ((equal (match-string 2) "\\") - (replace-match (or (save-match-data - (org-export-latex-treat-backslash-char - (match-string 1) - (or (match-string 3) ""))) - "") t t) - (when (and (get-text-property (1- (point)) 'org-entity) - (looking-at "{}")) - ;; OK, this was an entity replacement, and the user - ;; had terminated the entity with {}. Make sure - ;; {} is protected as well, and remove the extra {} - ;; inserted by the conversion. - (put-text-property (point) (+ 2 (point)) 'org-protected t) - (if (save-excursion (goto-char (max (- (point) 2) (point-min))) - (looking-at "{}")) - (replace-match "")) - (forward-char 2)) - (backward-char 1)) - ((member (match-string 2) '("_" "^")) - (replace-match (or (save-match-data - (org-export-latex-treat-sub-super-char - sub-superscript - (match-string 2) - (match-string 1) - (match-string 3))) "") t t) - (backward-char 1))))))) - '(;"^\\([^\n$]*?\\|^\\)\\(\\\\?\\$\\)\\([^\n$]*\\)$" - "\\(\\(\\\\?\\$\\)\\)" - "\\([a-zA-Z0-9()]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-zA-Z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-zA-Z0-9]+}\\|([a-zA-Z0-9]+)\\)" - "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|\\([&#%{}\"]\\|[a-zA-Z][a-zA-Z0-9]*\\)\\)" - "\\(^\\|.\\)\\([&#%{}~]\\|\\.\\.\\.\\)" - ;; (?\< . "\\textless{}") - ;; (?\> . "\\textgreater{}") - ))) - -(defun org-inside-latex-math-p () - (get-text-property (point) 'org-latex-math)) - -(defun org-export-latex-treat-sub-super-char - (subsup char string-before string-after) - "Convert the \"_\" and \"^\" characters to LaTeX. -SUBSUP corresponds to the ^: option in the #+OPTIONS line. -Convert CHAR depending on STRING-BEFORE and STRING-AFTER." - (cond ((equal string-before "\\") - (concat string-before char string-after)) - ((and (string-match "\\S-+" string-after)) - ;; this is part of a math formula - (cond ((eq 'org-link (get-text-property 0 'face char)) - (concat string-before "\\" char string-after)) - ((save-match-data (org-inside-latex-math-p)) - (if subsup - (cond ((eq 1 (length string-after)) - (concat string-before char string-after)) - ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after) - (format "%s%s{%s}" string-before char - (match-string 1 string-after)))))) - ((and (> (length string-after) 1) - (or (eq subsup t) - (and (equal subsup '{}) (eq (string-to-char string-after) ?\{))) - (or (string-match "[{]?\\([^}]+\\)[}]?" string-after) - (string-match "[(]?\\([^)]+\\)[)]?" string-after))) - - (org-export-latex-protect-string - (format "%s$%s{%s}$" string-before char - (if (and (> (match-end 1) (1+ (match-beginning 1))) - (not (equal (substring string-after 0 2) "{\\"))) - (concat "\\mathrm{" (match-string 1 string-after) "}") - (match-string 1 string-after))))) - ((eq subsup t) (concat string-before "$" char string-after "$")) - (t (org-export-latex-protect-string - (concat string-before "\\" char "{}" string-after))))) - (t (org-export-latex-protect-string - (concat string-before "\\" char "{}" string-after))))) - -(defun org-export-latex-treat-backslash-char (string-before string-after) - "Convert the \"$\" special character to LaTeX. -The conversion is made depending of STRING-BEFORE and STRING-AFTER." - (let ((ass (org-entity-get string-after))) - (cond - (ass (org-add-props - (if (nth 2 ass) - (concat string-before - (org-export-latex-protect-string - (concat "$" (nth 1 ass) "$"))) - (concat string-before (org-export-latex-protect-string - (nth 1 ass)))) - nil 'org-entity t)) - ((and (not (string-match "^[ \n\t]" string-after)) - (not (string-match "[ \t]\\'\\|^" string-before))) - ;; backslash is inside a word - (concat string-before - (org-export-latex-protect-string - (concat "\\textbackslash{}" string-after)))) - ((not (or (equal string-after "") - (string-match "^[ \t\n]" string-after))) - ;; backslash might escape a character (like \#) or a user TeX - ;; macro (like \setcounter) - (concat string-before - (org-export-latex-protect-string (concat "\\" string-after)))) - ((and (string-match "^[ \t\n]" string-after) - (string-match "[ \t\n]\\'" string-before)) - ;; backslash is alone, convert it to $\backslash$ - (org-export-latex-protect-string - (concat string-before "\\textbackslash{}" string-after))) - (t (org-export-latex-protect-string - (concat string-before "\\textbackslash{}" string-after)))))) - -(defun org-export-latex-keywords () - "Convert special keywords to LaTeX." - (goto-char (point-min)) - (while (re-search-forward org-export-latex-special-keyword-regexp nil t) - (replace-match (format org-export-latex-timestamp-keyword-markup - (match-string 0)) t t) - (save-excursion - (beginning-of-line 1) - (unless (looking-at ".*\n[ \t]*\n") - (end-of-line 1) - (insert "\n"))))) - -(defun org-export-latex-fixed-width (opt) - "When OPT is non-nil convert fixed-width sections to LaTeX." - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t) - (unless (get-text-property (point) 'org-example) - (if opt - (progn (goto-char (match-beginning 0)) - (insert "\\begin{verbatim}\n") - (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") - (replace-match (concat (match-string 1) - (match-string 2)) t t) - (forward-line)) - (insert "\\end{verbatim}\n")) - (progn (goto-char (match-beginning 0)) - (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") - (replace-match (concat "%" (match-string 1) - (match-string 2)) t t) - (forward-line))))))) - -(defvar org-table-last-alignment) ; defined in org-table.el -(defvar org-table-last-column-widths) ; defined in org-table.el -(declare-function orgtbl-to-latex "org-table" (table params) t) -(defun org-export-latex-tables (insert) - "Convert tables to LaTeX and INSERT it." - ;; First, get the table.el tables - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*\\(\\+-[-+]*\\+\\)[ \t]*\n[ \t]*|" nil t) - (org-if-unprotected - (require 'table) - (org-export-latex-convert-table.el-table))) - - ;; And now the Org-mode tables - (goto-char (point-min)) - (while (re-search-forward "^\\([ \t]*\\)|" nil t) - (org-if-unprotected-at (1- (point)) - (org-table-align) - (let* ((beg (org-table-begin)) - (end (org-table-end)) - (raw-table (buffer-substring beg end)) - (org-table-last-alignment (copy-sequence org-table-last-alignment)) - (org-table-last-column-widths (copy-sequence - org-table-last-column-widths)) - fnum fields line lines olines gr colgropen line-fmt align - caption width shortn label attr hfmt floatp placement - longtblp tblenv tabular-env) - (if org-export-latex-tables-verbatim - (let* ((tbl (concat "\\begin{verbatim}\n" raw-table - "\\end{verbatim}\n"))) - (apply 'delete-region (list beg end)) - (insert (org-export-latex-protect-string tbl))) - (progn - (setq caption (org-find-text-property-in-string - 'org-caption raw-table) - shortn (org-find-text-property-in-string - 'org-caption-shortn raw-table) - attr (org-find-text-property-in-string - 'org-attributes raw-table) - label (org-find-text-property-in-string - 'org-label raw-table) - longtblp (and attr (stringp attr) - (string-match "\\" attr)) - tblenv (if (and attr (stringp attr)) - (cond ((string-match "\\" attr) - "sidewaystable") - ((or (string-match (regexp-quote "table*") attr) - (string-match "\\" attr)) - "table*") - (t "table")) - "table") - tabular-env - (if (and attr (stringp attr) - (string-match "\\(tabular.\\)" attr)) - (match-string 1 attr) - org-export-latex-tabular-environment) - width (and attr (stringp attr) - (string-match "\\" attr)) - floatp (or label caption)) - (and (get-buffer "*org-export-table*") - (kill-buffer (get-buffer "*org-export-table*"))) - (table-generate-source 'latex "*org-export-table*" "caption") - (setq tbl (with-current-buffer "*org-export-table*" - (buffer-string))) - (while (string-match "^%.*\n" tbl) - (setq tbl (replace-match "" t t tbl))) - ;; fix the hlines - (when rmlines - (let ((n 0) lines) - (setq lines (mapcar (lambda (x) - (if (string-match "^\\\\hline$" x) - (progn - (setq n (1+ n)) - (if (= n 2) x nil)) - x)) - (org-split-string tbl "\n"))) - (setq tbl (mapconcat 'identity (delq nil lines) "\n")))) - (when (and align (string-match "\\\\begin{tabular}{.*}" tbl)) - (setq tbl (replace-match (concat "\\begin{tabular}{" align "}") - t t tbl))) - (and (get-buffer "*org-export-table*") - (kill-buffer (get-buffer "*org-export-table*"))) - (beginning-of-line 0) - (while (looking-at "[ \t]*\\(|\\|\\+-\\)") - (delete-region (point) (1+ (point-at-eol)))) - (when org-export-latex-tables-centered - (setq tbl (concat "\\begin{center}\n" tbl "\\end{center}"))) - (when floatp - (setq tbl (concat "\\begin{table}\n" - (if (not org-export-latex-table-caption-above) tbl) - (format "\\caption%s{%s%s}\n" - (if shortn (format "[%s]" shortn) "") - (if label (format "\\label{%s}" label) "") - (or caption "")) - (if org-export-latex-table-caption-above tbl) - "\n\\end{table}\n"))) - (insert (org-export-latex-protect-string tbl)))) - -(defun org-export-latex-fontify () - "Convert fontification to LaTeX." - (goto-char (point-min)) - (while (re-search-forward org-emph-re nil t) - ;; The match goes one char after the *string*, except at the end of a line - (let ((emph (assoc (match-string 3) - org-export-latex-emphasis-alist)) - (beg (match-beginning 0)) - (end (match-end 0)) - rpl s) - (unless emph - (message "`org-export-latex-emphasis-alist' has no entry for formatting triggered by \"%s\"" - (match-string 3))) - (unless (or (and (get-text-property (- (point) 2) 'org-protected) - (not (get-text-property - (- (point) 2) 'org-verbatim-emph))) - (equal (char-after (match-beginning 3)) - (char-after (1+ (match-beginning 3)))) - (save-excursion - (goto-char (match-beginning 1)) - (save-match-data - (and (org-at-table-p) - (string-match - "[|\n]" (buffer-substring beg end))))) - (and (equal (match-string 3) "+") - (save-match-data - (string-match "\\`-+\\'" (match-string 4))))) - (setq s (match-string 4)) - (setq rpl (concat (match-string 1) - (org-export-latex-emph-format (cadr emph) - (match-string 4)) - (match-string 5))) - (if (caddr emph) - (setq rpl (org-export-latex-protect-string rpl)) - (save-match-data - (if (string-match "\\`.?\\(\\\\[a-z]+{\\)\\(.*\\)\\(}\\).?\\'" rpl) - (progn - (add-text-properties (match-beginning 1) (match-end 1) - '(org-protected t) rpl) - (add-text-properties (match-beginning 3) (match-end 3) - '(org-protected t) rpl))))) - (replace-match rpl t t))) - (backward-char))) - -(defun org-export-latex-emph-format (format string) - "Format an emphasis string and handle the \\verb special case." - (when (member format '("\\verb" "\\protectedtexttt")) - (save-match-data - (if (equal format "\\verb") - (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) - (catch 'exit - (loop for i from 0 to (1- (length ll)) do - (if (not (string-match (regexp-quote (substring ll i (1+ i))) - string)) - (progn - (setq format (concat "\\verb" (substring ll i (1+ i)) - "%s" (substring ll i (1+ i)))) - (throw 'exit nil)))))) - (let ((start 0) - (trans '(("\\" . "\\textbackslash{}") - ("~" . "\\textasciitilde{}") - ("^" . "\\textasciicircum{}"))) - (rtn "") char) - (while (string-match "[\\{}$%&_#~^]" string) - (setq char (match-string 0 string)) - (if (> (match-beginning 0) 0) - (setq rtn (concat rtn (substring string - 0 (match-beginning 0))))) - (setq string (substring string (1+ (match-beginning 0)))) - (setq char (or (cdr (assoc char trans)) (concat "\\" char)) - rtn (concat rtn char))) - (setq string (concat rtn string) format "\\texttt{%s}") - (while (string-match "--" string) - (setq string (replace-match "-{}-" t t string))))))) - (format format string)) - -(defun org-export-latex-links () - ;; Make sure to use the LaTeX hyperref and graphicx package - ;; or send some warnings. - "Convert links to LaTeX." - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-analytic-regexp++ nil t) - (org-if-unprotected-1 - (goto-char (match-beginning 0)) - (let* ((re-radio org-export-latex-all-targets-re) - (remove (list (match-beginning 0) (match-end 0))) - (raw-path (org-extract-attributes (match-string 3))) - (full-raw-path (concat (match-string 1) raw-path)) - (desc (match-string 5)) - (type (or (match-string 2) - (if (or (file-name-absolute-p raw-path) - (string-match "^\\.\\.?/" raw-path)) - "file"))) - (coderefp (equal type "coderef")) - (caption (org-find-text-property-in-string 'org-caption raw-path)) - (shortn (org-find-text-property-in-string 'org-caption-shortn raw-path)) - (attr (or (org-find-text-property-in-string 'org-attributes raw-path) - (plist-get org-export-latex-options-plist :latex-image-options))) - (label (org-find-text-property-in-string 'org-label raw-path)) - imgp radiop fnc - ;; define the path of the link - (path (cond - ((member type '("coderef")) - raw-path) - ((member type '("http" "https" "ftp")) - (concat type ":" raw-path)) - ((and re-radio (string-match re-radio raw-path)) - (setq radiop t)) - ((equal type "mailto") - (concat type ":" raw-path)) - ((equal type "file") - (if (and (org-file-image-p - (expand-file-name (org-link-unescape raw-path)) - org-export-latex-inline-image-extensions) - (or (get-text-property 0 'org-no-description raw-path) - (equal desc full-raw-path))) - (setq imgp t) - (progn (setq raw-path (org-link-unescape raw-path)) - (when (string-match "\\(.+\\)::.+" raw-path) - (setq raw-path (match-string 1 raw-path))) - (if (file-exists-p raw-path) - (concat type "://" (expand-file-name raw-path)) - (concat type "://" (org-export-directory - :LaTeX org-export-latex-options-plist) - raw-path)))))))) - ;; process with link inserting - (apply 'delete-region remove) - (setq caption (and caption (org-export-latex-fontify-headline caption))) - (cond ((and imgp - (plist-get org-export-latex-options-plist :inline-images)) - ;; OK, we need to inline an image - (insert - (org-export-latex-format-image raw-path caption label attr shortn))) - (coderefp - (insert (format - (org-export-get-coderef-format path desc) - (cdr (assoc path org-export-code-refs))))) - (radiop (insert (format org-export-latex-hyperref-format - (org-solidify-link-text raw-path) desc))) - ((not type) - (insert (format org-export-latex-hyperref-format - (org-remove-initial-hash - (org-solidify-link-text raw-path)) - desc))) - (path - (when (org-at-table-p) - ;; There is a strange problem when we have a link in a table, - ;; ampersands then cause a problem. I think this must be - ;; a LaTeX issue, but we here implement a work-around anyway. - (setq path (org-export-latex-protect-amp path) - desc (org-export-latex-protect-amp desc))) - (insert - (if (string-match "%s.*%s" org-export-latex-href-format) - (format org-export-latex-href-format path desc) - (format org-export-latex-href-format path)))) - - ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - ;; The link protocol has a function for formatting the link - (insert - (save-match-data - (funcall fnc (org-link-unescape raw-path) desc 'latex)))) - ;; Unrecognized path type - (t (insert (format org-export-latex-link-with-unknown-path-format desc)))))))) - - -(defun org-export-latex-format-image (path caption label attr &optional shortn) - "Format the image element, depending on user settings." - (let (ind floatp wrapp multicolumnp placement figenv) - (setq floatp (or caption label)) - (setq ind (org-get-text-property-any 0 'original-indentation path)) - (when (and attr (stringp attr)) - (if (string-match "[ \t]*\\" attr) - (setq wrapp t floatp nil attr (replace-match "" t t attr))) - (if (string-match "[ \t]*\\" attr) - (setq wrapp nil floatp t attr (replace-match "" t t attr))) - (if (string-match "[ \t]*\\" attr) - (setq multicolumnp t attr (replace-match "" t t attr)))) - - (setq placement - (cond - (wrapp "{l}{0.5\\textwidth}") - (floatp (concat "[" org-latex-default-figure-position "]")) - (t ""))) - - (when (and attr (stringp attr) - (string-match "[ \t]*\\" nil t) - (unless (eq (char-before (match-beginning 1)) ?\\) - (org-if-unprotected-1 - (replace-match (org-export-latex-protect-string - (concat "\\" (match-string 1) - "{}")) t t))))) - - ;; Convert blockquotes - (goto-char (point-min)) - (while (search-forward "ORG-BLOCKQUOTE-START" nil t) - (org-replace-match-keep-properties "\\begin{quote}" t t)) - (goto-char (point-min)) - (while (search-forward "ORG-BLOCKQUOTE-END" nil t) - (org-replace-match-keep-properties "\\end{quote}" t t)) - - ;; Convert verse - (goto-char (point-min)) - (while (search-forward "ORG-VERSE-START" nil t) - (org-replace-match-keep-properties "\\begin{verse}" t t) - (beginning-of-line 2) - (while (and (not (looking-at "[ \t]*ORG-VERSE-END.*")) (not (eobp))) - (when (looking-at "\\([ \t]+\\)\\([^ \t\n]\\)") - (goto-char (match-end 1)) - (org-replace-match-keep-properties - (org-export-latex-protect-string - (concat "\\hspace*{1cm}" (match-string 2))) t t) - (beginning-of-line 1)) - (if (looking-at "[ \t]*$") - (insert (org-export-latex-protect-string "\\vspace*{1em}")) - (unless (looking-at ".*?[^ \t\n].*?\\\\\\\\[ \t]*$") - (end-of-line 1) - (insert "\\\\"))) - (beginning-of-line 2)) - (and (looking-at "[ \t]*ORG-VERSE-END.*") - (org-replace-match-keep-properties "\\end{verse}" t t))) - - ;; Convert #+INDEX to LaTeX \\index. - (goto-char (point-min)) - (let ((case-fold-search t) entry) - (while (re-search-forward - "^[ \t]*#\\+index:[ \t]*\\([^ \t\r\n].*?\\)[ \t]*$" - nil t) - (setq entry - (save-match-data - (org-export-latex-protect-string - (org-export-latex-fontify-headline (match-string 1))))) - (replace-match (format "\\index{%s}" entry) t t))) - - ;; Convert center - (goto-char (point-min)) - (while (search-forward "ORG-CENTER-START" nil t) - (org-replace-match-keep-properties "\\begin{center}" t t)) - (goto-char (point-min)) - (while (search-forward "ORG-CENTER-END" nil t) - (org-replace-match-keep-properties "\\end{center}" t t)) - - (run-hooks 'org-export-latex-after-blockquotes-hook) - - ;; Convert horizontal rules - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*-\\{5,\\}[ \t]*$" nil t) - (org-if-unprotected - (replace-match (org-export-latex-protect-string "\\hrule") t t))) - - ;; Protect LaTeX commands like \command[...]{...} or \command{...} - (goto-char (point-min)) - (let ((re (concat - "\\\\\\([a-zA-Z]+\\*?\\)" - "\\(?:<[^<>\n]*>\\)*" - "\\(?:\\[[^][\n]*?\\]\\)*" - "\\(?:<[^<>\n]*>\\)*" - "\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}"))) - (while (re-search-forward re nil t) - (unless (or - ;; Check for comment line. - (save-excursion (goto-char (match-beginning 0)) - (org-in-indented-comment-line)) - ;; Check if this is a defined entity, so that is may - ;; need conversion. - (org-entity-get (match-string 1)) - ;; Do not protect interior of footnotes. Those have - ;; already been taken care of earlier in the function. - ;; Yet, keep looking inside them for more commands. - (and (equal (match-string 1) "footnote") - (goto-char (match-end 1)))) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))))) - - ;; Special case for \nbsp - (goto-char (point-min)) - (while (re-search-forward "\\\\nbsp\\({}\\|\\>\\)" nil t) - (org-if-unprotected - (replace-match (org-export-latex-protect-string "~")))) - - ;; Protect LaTeX entities - (goto-char (point-min)) - (while (re-search-forward org-latex-entities-regexp nil t) - (org-if-unprotected - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t)))) - - ;; Replace radio links - (goto-char (point-min)) - (while (re-search-forward - (concat "<<>>?\\((INVISIBLE)\\)?") nil t) - (org-if-unprotected-at (+ (match-beginning 0) 2) - (replace-match - (concat - (org-export-latex-protect-string - (format "\\label{%s}" (save-match-data (org-solidify-link-text - (match-string 1))))) - (if (match-string 2) "" (match-string 1))) - t t))) - - ;; Delete @<...> constructs - ;; Thanks to Daniel Clemente for this regexp - (goto-char (point-min)) - (while (re-search-forward "@<\\(?:[^\"\n]\\|\".*\"\\)*?>" nil t) - (org-if-unprotected - (replace-match "")))) - -(defun org-export-latex-fix-inputenc () - "Set the coding system in inputenc to what the buffer is." - (let* ((cs buffer-file-coding-system) - (opt (or (ignore-errors (latexenc-coding-system-to-inputenc cs)) - "utf8"))) - (when opt - ;; Translate if that is requested - (setq opt (or (cdr (assoc opt org-export-latex-inputenc-alist)) opt)) - ;; find the \usepackage statement and replace the option - (goto-char (point-min)) - (while (re-search-forward "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}" - nil t) - (goto-char (match-beginning 1)) - (delete-region (match-beginning 1) (match-end 1)) - (insert opt)) - (and buffer-file-name - (save-buffer))))) - -;;; List handling: - -(defun org-export-latex-lists () - "Convert plain text lists in current buffer into LaTeX lists." - ;; `org-list-end-re' output has changed since preprocess from - ;; org-exp.el. Make sure it is taken into account. - (let ((org-list-end-re "^ORG-LIST-END-MARKER\n")) - (mapc - (lambda (e) - ;; For each type of context allowed for list export (E), find - ;; every list, parse it, delete it and insert resulting - ;; conversion to latex (RES), while keeping the same - ;; `original-indentation' property. - (let (res) - (goto-char (point-min)) - (while (re-search-forward (org-item-beginning-re) nil t) - (when (and (eq (get-text-property (point) 'list-context) e) - (not (get-text-property (point) 'org-example))) - (beginning-of-line) - (setq res - (org-list-to-latex - ;; Narrowing is needed because we're converting - ;; from inner functions to outer ones. - (save-restriction - (narrow-to-region (point) (point-max)) - (org-list-parse-list t)) - org-export-latex-list-parameters)) - ;; Extend previous value of original-indentation to the - ;; whole string - (insert (org-add-props res nil 'original-indentation - (org-find-text-property-in-string - 'original-indentation res))))))) - ;; List of allowed contexts for export, and the default one. - (append org-list-export-context '(nil))))) - -(defconst org-latex-entities - '("\\!" - "\\'" - "\\+" - "\\," - "\\-" - "\\:" - "\\;" - "\\<" - "\\=" - "\\>" - "\\Huge" - "\\LARGE" - "\\Large" - "\\Styles" - "\\\\" - "\\`" - "\\\"" - "\\addcontentsline" - "\\address" - "\\addtocontents" - "\\addtocounter" - "\\addtolength" - "\\addvspace" - "\\alph" - "\\appendix" - "\\arabic" - "\\author" - "\\begin{array}" - "\\begin{center}" - "\\begin{description}" - "\\begin{enumerate}" - "\\begin{eqnarray}" - "\\begin{equation}" - "\\begin{figure}" - "\\begin{flushleft}" - "\\begin{flushright}" - "\\begin{itemize}" - "\\begin{list}" - "\\begin{minipage}" - "\\begin{picture}" - "\\begin{quotation}" - "\\begin{quote}" - "\\begin{tabbing}" - "\\begin{table}" - "\\begin{tabular}" - "\\begin{thebibliography}" - "\\begin{theorem}" - "\\begin{titlepage}" - "\\begin{verbatim}" - "\\begin{verse}" - "\\bf" - "\\bf" - "\\bibitem" - "\\bigskip" - "\\cdots" - "\\centering" - "\\circle" - "\\cite" - "\\cleardoublepage" - "\\clearpage" - "\\cline" - "\\closing" - "\\dashbox" - "\\date" - "\\ddots" - "\\dotfill" - "\\em" - "\\fbox" - "\\flushbottom" - "\\fnsymbol" - "\\footnote" - "\\footnotemark" - "\\footnotesize" - "\\footnotetext" - "\\frac" - "\\frame" - "\\framebox" - "\\hfill" - "\\hline" - "\\hrulespace" - "\\hspace" - "\\huge" - "\\hyphenation" - "\\include" - "\\includeonly" - "\\indent" - "\\input" - "\\it" - "\\kill" - "\\label" - "\\large" - "\\ldots" - "\\line" - "\\linebreak" - "\\linethickness" - "\\listoffigures" - "\\listoftables" - "\\location" - "\\makebox" - "\\maketitle" - "\\mark" - "\\mbox" - "\\medskip" - "\\multicolumn" - "\\multiput" - "\\newcommand" - "\\newcounter" - "\\newenvironment" - "\\newfont" - "\\newlength" - "\\newline" - "\\newpage" - "\\newsavebox" - "\\newtheorem" - "\\nocite" - "\\nofiles" - "\\noindent" - "\\nolinebreak" - "\\nopagebreak" - "\\normalsize" - "\\onecolumn" - "\\opening" - "\\oval" - "\\overbrace" - "\\overline" - "\\pagebreak" - "\\pagenumbering" - "\\pageref" - "\\pagestyle" - "\\par" - "\\parbox" - "\\put" - "\\raggedbottom" - "\\raggedleft" - "\\raggedright" - "\\raisebox" - "\\ref" - "\\rm" - "\\roman" - "\\rule" - "\\savebox" - "\\sc" - "\\scriptsize" - "\\setcounter" - "\\setlength" - "\\settowidth" - "\\sf" - "\\shortstack" - "\\signature" - "\\sl" - "\\small" - "\\smallskip" - "\\sqrt" - "\\tableofcontents" - "\\telephone" - "\\thanks" - "\\thispagestyle" - "\\tiny" - "\\title" - "\\tt" - "\\twocolumn" - "\\typein" - "\\typeout" - "\\underbrace" - "\\underline" - "\\usebox" - "\\usecounter" - "\\value" - "\\vdots" - "\\vector" - "\\verb" - "\\vfill" - "\\vline" - "\\vspace") - "A list of LaTeX commands to be protected when performing conversion.") - -(defconst org-latex-entities-regexp - (let (names rest) - (dolist (x org-latex-entities) - (if (string-match "[a-zA-Z]$" x) - (push x names) - (push x rest))) - (concat "\\(" (regexp-opt (nreverse names)) "\\>\\)" - "\\|\\(" (regexp-opt (nreverse rest)) "\\)"))) - -(provide 'org-export-latex) -(provide 'org-latex) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-latex.el ends here diff --git a/lisp/org-list.el b/lisp/org-list.el index 474764816..628dd0a7b 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -94,6 +94,11 @@ (defvar org-ts-regexp) (defvar org-ts-regexp-both) +(declare-function outline-invisible-p "outline" (&optional pos)) +(declare-function outline-flag-region "outline" (from to flag)) +(declare-function outline-next-heading "outline" ()) +(declare-function outline-previous-heading "outline" ()) + (declare-function org-at-heading-p "org" (&optional ignored)) (declare-function org-before-first-heading-p "org" ()) (declare-function org-back-to-heading "org" (&optional invisible-ok)) @@ -107,10 +112,6 @@ (declare-function org-icompleting-read "org" (&rest args)) (declare-function org-in-block-p "org" (names)) (declare-function org-in-regexp "org" (re &optional nlines visually)) -(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) -(declare-function org-inlinetask-goto-end "org-inlinetask" ()) -(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) -(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-level-increment "org" ()) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-at-heading-p "org" (&optional invisible-ok)) @@ -118,15 +119,21 @@ (declare-function org-remove-if "org" (predicate seq)) (declare-function org-reduced-level "org" (L)) (declare-function org-show-subtree "org" ()) +(declare-function org-sort-remove-invisible "org" (S)) (declare-function org-time-string-to-seconds "org" (s)) (declare-function org-timer-hms-to-secs "org-timer" (hms)) (declare-function org-timer-item "org-timer" (&optional arg)) (declare-function org-trim "org" (s)) (declare-function org-uniquify "org" (list)) -(declare-function outline-invisible-p "outline" (&optional pos)) -(declare-function outline-flag-region "outline" (from to flag)) -(declare-function outline-next-heading "outline" ()) -(declare-function outline-previous-heading "outline" ()) + +(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) +(declare-function org-inlinetask-goto-end "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) + +(declare-function org-export-string-as "ox" + (string backend &optional body-only ext-plist)) + @@ -154,6 +161,7 @@ plain list item with an implied large level number, all true children and grand children of the outline heading will be exposed in a children' view." :group 'org-plain-lists + :group 'org-cycle :type '(choice (const :tag "Never" nil) (const :tag "With cursor in plain list (recommended)" t) @@ -209,7 +217,9 @@ Valid values are ?. and ?\). To get both terminators, use t." (const :tag "paren like in \"2)\"" ?\)) (const :tag "both" t))) -(defcustom org-alphabetical-lists nil +(define-obsolete-variable-alias 'org-alphabetical-lists + 'org-list-allow-alphabetical "24.4") ; Since 8.0 +(defcustom org-list-allow-alphabetical nil "Non-nil means single character alphabetical bullets are allowed. Both uppercase and lowercase are handled. Lists with more than 26 items will fallback to standard numbering. Alphabetical @@ -230,7 +240,9 @@ spaces instead of one after the bullet in each item of the list." (const :tag "never" nil) (regexp))) -(defcustom org-empty-line-terminates-plain-lists nil +(define-obsolete-variable-alias 'org-empty-line-terminates-plain-lists + 'org-list-empty-line-terminates-plain-lists "24.4") ;; Since 8.0 +(defcustom org-list-empty-line-terminates-plain-lists nil "Non-nil means an empty line ends all plain list levels. Otherwise, two of them will be necessary." :group 'org-plain-lists @@ -282,7 +294,9 @@ This hook runs even if checkbox rule in implement alternative ways of collecting statistics information.") -(defcustom org-hierarchical-checkbox-statistics t +(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics + 'org-checkbox-hierarchical-statistics "24.4") ;; Since 8.0 +(defcustom org-checkbox-hierarchical-statistics t "Non-nil means checkbox statistics counts only the state of direct children. When nil, all boxes below the cookie are counted. This can be set to nil on a per-node basis using a COOKIE_DATA property @@ -290,7 +304,9 @@ with the word \"recursive\" in the value." :group 'org-plain-lists :type 'boolean) -(defcustom org-description-max-indent 20 +(org-defvaralias 'org-description-max-indent + 'org-list-description-max-indent) ;; Since 8.0 +(defcustom org-list-description-max-indent 20 "Maximum indentation for the second line of a description list. When the indentation would be larger than this, it will become 5 characters instead." @@ -333,7 +349,7 @@ list, obtained by prompting the user." (string :tag "Format")))) (defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer" - "docbook" "html" "latex" "odt") + "html" "latex" "odt") "Names of blocks where lists are not allowed. Names must be in lower case.") @@ -348,10 +364,10 @@ specifically, type `block' is determined by the variable ;;; Predicates and regexps -(defconst org-list-end-re (if org-empty-line-terminates-plain-lists "^[ \t]*\n" +(defconst org-list-end-re (if org-list-empty-line-terminates-plain-lists "^[ \t]*\n" "^[ \t]*\n[ \t]*\n") "Regex corresponding to the end of a list. -It depends on `org-empty-line-terminates-plain-lists'.") +It depends on `org-list-empty-line-terminates-plain-lists'.") (defconst org-list-full-item-re (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)" @@ -371,7 +387,7 @@ group 4: description tag") ((= org-plain-list-ordered-item-terminator ?\)) ")") ((= org-plain-list-ordered-item-terminator ?.) "\\.") (t "[.)]"))) - (alpha (if org-alphabetical-lists "\\|[A-Za-z]" ""))) + (alpha (if org-list-allow-alphabetical "\\|[A-Za-z]" ""))) (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)"))) @@ -385,7 +401,7 @@ group 4: description tag") (save-excursion (goto-char (match-end 0)) (let ((counter-re (concat "\\(?:\\[@\\(?:start:\\)?" - (if org-alphabetical-lists + (if org-list-allow-alphabetical "\\([0-9]+\\|[A-Za-z]\\)" "[0-9]+") "\\][ \t]*\\)"))) @@ -642,8 +658,7 @@ Assume point is at an item." (save-excursion (catch 'exit (while t - (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) - (org-get-indentation)))) + (let ((ind (org-get-indentation))) (cond ((<= (point) lim-up) ;; At upward limit: if we ended at an item, store it, @@ -651,18 +666,10 @@ Assume point is at an item." ;; Jump to part 2. (throw 'exit (setq itm-lst - (if (or (not (looking-at item-re)) - (get-text-property (point) 'org-example)) + (if (not (looking-at item-re)) (memq (assq (car beg-cell) itm-lst) itm-lst) (setq beg-cell (cons (point) ind)) (cons (funcall assoc-at-point ind) itm-lst))))) - ;; At a verbatim block, go before its beginning. Move - ;; from eol to ensure `previous-single-property-change' - ;; will return a value. - ((get-text-property (point) 'org-example) - (goto-char (previous-single-property-change - (point-at-eol) 'org-example nil lim-up)) - (forward-line -1)) ;; Looking at a list ending regexp. Dismiss useless ;; data recorded above BEG-CELL. Jump to part 2. ((looking-at org-list-end-re) @@ -711,8 +718,7 @@ Assume point is at an item." ;; position of items in END-LST-2. (catch 'exit (while t - (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) - (org-get-indentation)))) + (let ((ind (org-get-indentation))) (cond ((>= (point) lim-down) ;; At downward limit: this is de facto the end of the @@ -720,12 +726,6 @@ Assume point is at an item." ;; part 3. (throw 'exit (push (cons 0 (funcall end-before-blank)) end-lst-2))) - ;; At a verbatim block, move to its end. Point is at bol - ;; and 'org-example property is set by whole lines: - ;; `next-single-property-change' always return a value. - ((get-text-property (point) 'org-example) - (goto-char - (next-single-property-change (point) 'org-example nil lim-down))) ;; Looking at a list ending regexp. Save point as an ;; ending position and jump to part 3. ((looking-at org-list-end-re) @@ -1097,8 +1097,9 @@ It determines the number of whitespaces to append by looking at org-list-two-spaces-after-bullet-regexp bullet)) " " " "))) - (string-match "\\S-+\\([ \t]*\\)" bullet) - (replace-match spaces nil nil bullet 1)))) + (if (string-match "\\S-+\\([ \t]*\\)" bullet) + (replace-match spaces nil nil bullet 1) + bullet)))) (defun org-list-swap-items (beg-A beg-B struct) "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. @@ -1208,7 +1209,7 @@ some heuristics to guess the result." (point)))))))) (cond ;; Trivial cases where there should be none. - ((or org-empty-line-terminates-plain-lists (not insert-blank-p)) 0) + ((or org-list-empty-line-terminates-plain-lists (not insert-blank-p)) 0) ;; When `org-blank-before-new-entry' says so, it is 1. ((eq insert-blank-p t) 1) ;; `plain-list-item' is 'auto. Count blank lines separating @@ -1613,7 +1614,7 @@ bullets between START and END." STRUCT is list structure. PREVS is the alist of previous items, as returned by `org-list-prevs-alist'." - (and org-alphabetical-lists + (and org-list-allow-alphabetical (catch 'exit (let ((item first) (ascii 64) (case-fold-search nil)) ;; Pretend that bullets are uppercase and check if alphabet @@ -2148,7 +2149,7 @@ the item, so this really moves item trees." (prevs (org-list-prevs-alist struct)) (next-item (org-list-get-next-item (point-at-bol) struct prevs))) (unless (or next-item org-list-use-circular-motion) - (error "Cannot move this item further down")) + (user-error "Cannot move this item further down")) (if (not next-item) (setq struct (org-list-send-item item 'begin struct)) (setq struct (org-list-swap-items item next-item struct)) @@ -2169,7 +2170,7 @@ the item, so this really moves item trees." (prevs (org-list-prevs-alist struct)) (prev-item (org-list-get-prev-item (point-at-bol) struct prevs))) (unless (or prev-item org-list-use-circular-motion) - (error "Cannot move this item further up")) + (user-error "Cannot move this item further up")) (if (not prev-item) (setq struct (org-list-send-item item 'end struct)) (setq struct (org-list-swap-items prev-item item struct))) @@ -2203,9 +2204,8 @@ item is invisible." ;; If we're in a description list, ask for the new term. (desc (when (eq (org-list-get-list-type itemp struct prevs) 'descriptive) - (concat (read-string "Term: ") " :: ")))) - (setq struct - (org-list-insert-item pos struct prevs checkbox desc)) + " :: "))) + (setq struct (org-list-insert-item pos struct prevs checkbox desc)) (org-list-write-struct struct (org-list-parents-alist struct)) (when checkbox (org-update-checkbox-count-maybe)) (looking-at org-list-full-item-re) @@ -2214,6 +2214,7 @@ item is invisible." (string-match "[.)]" (match-string 1)))) (match-beginning 4) (match-end 0))) + (if desc (backward-char 1)) t))))) (defun org-list-repair () @@ -2429,7 +2430,7 @@ With optional prefix argument ALL, do this for the whole buffer." (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)") (recursivep - (or (not org-hierarchical-checkbox-statistics) + (or (not org-checkbox-hierarchical-statistics) (string-match "\\" (or (org-entry-get nil "COOKIE_DATA") "")))) (bounds (if all @@ -2771,7 +2772,7 @@ Return t at each successful move." (cond ((ignore-errors (org-list-indent-item-generic 1 t struct))) ((ignore-errors (org-list-indent-item-generic -1 t struct))) - (t (error "Cannot move item")))) + (t (user-error "Cannot move item")))) t)))) (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) @@ -2801,7 +2802,10 @@ If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be called with point at the beginning of the record. It must return either a string or a number that should serve as the sorting key for that record. It will then use -COMPARE-FUNC to compare entries." +COMPARE-FUNC to compare entries. + +Sorting is done against the visible part of the headlines, it +ignores hidden links." (interactive "P") (let* ((case-func (if with-case 'identity 'downcase)) (struct (org-list-struct)) @@ -2809,13 +2813,16 @@ COMPARE-FUNC to compare entries." (start (org-list-get-list-begin (point-at-bol) struct prevs)) (end (org-list-get-list-end (point-at-bol) struct prevs)) (sorting-type - (progn - (message - "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:") - (read-char-exclusive))) - (getkey-func (and (= (downcase sorting-type) ?f) - (intern (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil))))) + (or sorting-type + (progn + (message + "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:") + (read-char-exclusive)))) + (getkey-func + (or getkey-func + (and (= (downcase sorting-type) ?f) + (intern (org-icompleting-read "Sort using function: " + obarray 'fboundp t nil nil)))))) (message "Sorting items...") (save-restriction (narrow-to-region start end) @@ -2838,19 +2845,23 @@ COMPARE-FUNC to compare entries." (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") (cond ((= dcst ?n) - (string-to-number (buffer-substring (match-end 0) - (point-at-eol)))) + (string-to-number + (org-sort-remove-invisible + (buffer-substring (match-end 0) (point-at-eol))))) ((= dcst ?a) (funcall case-func - (buffer-substring (match-end 0) (point-at-eol)))) + (org-sort-remove-invisible + (buffer-substring + (match-end 0) (point-at-eol))))) ((= dcst ?t) (cond ;; If it is a timer list, convert timer to seconds ((org-at-item-timer-p) (org-timer-hms-to-secs (match-string 1))) - ((or (re-search-forward org-ts-regexp (point-at-eol) t) - (re-search-forward org-ts-regexp-both - (point-at-eol) t)) + ((or (save-excursion + (re-search-forward org-ts-regexp (point-at-eol) t)) + (save-excursion (re-search-forward org-ts-regexp-both + (point-at-eol) t))) (org-time-string-to-seconds (match-string 0))) (t (org-float-time now)))) ((= dcst ?f) @@ -3021,9 +3032,8 @@ for this list." (unless (org-at-item-p) (error "Not at a list item")) (save-excursion (re-search-backward "#\\+ORGLST" nil t) - (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") - (if maybe - (throw 'exit nil) + (unless (looking-at "#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)") + (if maybe (throw 'exit nil) (error "Don't know how to transform this list")))) (let* ((name (match-string 1)) (transform (intern (match-string 2))) @@ -3037,13 +3047,11 @@ for this list." (re-search-backward "#\\+ORGLST" nil t) (re-search-forward (org-item-beginning-re) bottom-point t) (match-beginning 0))) - (list (save-restriction - (narrow-to-region top-point bottom-point) - (org-list-parse-list))) + (plain-list (buffer-substring-no-properties top-point bottom-point)) beg txt) (unless (fboundp transform) (error "No such transformation function %s" transform)) - (let ((txt (funcall transform list))) + (let ((txt (funcall transform plain-list))) ;; Find the insertion place (save-excursion (goto-char (point-min)) @@ -3200,65 +3208,24 @@ items." (defun org-list-to-latex (list &optional params) "Convert LIST into a LaTeX list. -LIST is as returned by `org-list-parse-list'. PARAMS is a property list -with overruling parameters for `org-list-to-generic'." - (org-list-to-generic - list - (org-combine-plists - '(:splice nil :ostart "\\begin{enumerate}\n" :oend "\\end{enumerate}" - :ustart "\\begin{itemize}\n" :uend "\\end{itemize}" - :dstart "\\begin{description}\n" :dend "\\end{description}" - :dtstart "[" :dtend "] " - :istart "\\item " :iend "\n" - :icount (let ((enum (nth depth '("i" "ii" "iii" "iv")))) - (if enum - ;; LaTeX increments counter just before - ;; using it, so set it to the desired - ;; value, minus one. - (format "\\setcounter{enum%s}{%s}\n\\item " - enum (1- counter)) - "\\item ")) - :csep "\n" - :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}" - :cbtrans "\\texttt{[-]}") - params))) +LIST is as string representing the list to transform, as Org +syntax. Return converted list as a string." + (require 'ox-latex) + (org-export-string-as list 'latex t)) -(defun org-list-to-html (list &optional params) +(defun org-list-to-html (list) "Convert LIST into a HTML list. -LIST is as returned by `org-list-parse-list'. PARAMS is a property list -with overruling parameters for `org-list-to-generic'." - (org-list-to-generic - list - (org-combine-plists - '(:splice nil :ostart "
      \n" :oend "\n
    " - :ustart "
      \n" :uend "\n
    " - :dstart "
    \n" :dend "\n
    " - :dtstart "
    " :dtend "
    \n" - :ddstart "
    " :ddend "
    " - :istart "
  • " :iend "
  • " - :icount (format "
  • " counter) - :isep "\n" :lsep "\n" :csep "\n" - :cbon "[X]" :cboff "[ ]" - :cbtrans "[-]") - params))) +LIST is as string representing the list to transform, as Org +syntax. Return converted list as a string." + (require 'ox-html) + (org-export-string-as list 'html t)) (defun org-list-to-texinfo (list &optional params) "Convert LIST into a Texinfo list. -LIST is as returned by `org-list-parse-list'. PARAMS is a property list -with overruling parameters for `org-list-to-generic'." - (org-list-to-generic - list - (org-combine-plists - '(:splice nil :ostart "@itemize @minus\n" :oend "@end itemize" - :ustart "@enumerate\n" :uend "@end enumerate" - :dstart "@table @asis\n" :dend "@end table" - :dtstart " " :dtend "\n" - :istart "@item\n" :iend "\n" - :icount "@item\n" - :csep "\n" - :cbon "@code{[X]}" :cboff "@code{[ ]}" - :cbtrans "@code{[-]}") - params))) +LIST is as string representing the list to transform, as Org +syntax. Return converted list as a string." + (require 'ox-texinfo) + (org-export-string-as list 'texinfo t)) (defun org-list-to-subtree (list &optional params) "Convert LIST into an Org subtree. diff --git a/lisp/org-lparse.el b/lisp/org-lparse.el deleted file mode 100644 index 11711353f..000000000 --- a/lisp/org-lparse.el +++ /dev/null @@ -1,2303 +0,0 @@ -;;; org-lparse.el --- Line-oriented parser-exporter for Org-mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Jambunathan K -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; `org-lparse' is the entry point for the generic line-oriented -;; exporter. `org-do-lparse' is the genericized version of the -;; original `org-export-as-html' routine. - -;; `org-lparse-native-backends' is a good starting point for -;; exploring the generic exporter. - -;; Following new interactive commands are provided by this library. -;; `org-lparse', `org-lparse-and-open', `org-lparse-to-buffer' -;; `org-replace-region-by', `org-lparse-region'. - -;; Note that the above routines correspond to the following routines -;; in the html exporter `org-export-as-html', -;; `org-export-as-html-and-open', `org-export-as-html-to-buffer', -;; `org-replace-region-by-html' and `org-export-region-as-html'. - -;; The new interactive command `org-lparse-convert' can be used to -;; convert documents between various formats. Use this to command, -;; for example, to convert odt file to doc or pdf format. - -;;; Code: -(eval-when-compile - (require 'cl)) -(require 'org-exp) -(require 'org-list) -(require 'format-spec) - -(defun org-lparse-and-open (target-backend native-backend arg - &optional file-or-buf) - "Export outline to TARGET-BACKEND via NATIVE-BACKEND and open exported file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted -lists." - (let (f (file-or-buf (or file-or-buf - (org-lparse target-backend native-backend - arg 'hidden)))) - (when file-or-buf - (setq f (cond - ((bufferp file-or-buf) buffer-file-name) - ((file-exists-p file-or-buf) file-or-buf) - (t (error "org-lparse-and-open: This shouldn't happen")))) - (message "Opening file %s" f) - (org-open-file f 'system) - (when org-export-kill-product-buffer-when-displayed - (kill-buffer (current-buffer)))))) - -(defun org-lparse-batch (target-backend &optional native-backend) - "Call the function `org-lparse'. -This function can be used in batch processing as: -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-lparse-batch" - (setq native-backend (or native-backend target-backend)) - (org-lparse target-backend native-backend - org-export-headline-levels 'hidden)) - -(defun org-lparse-to-buffer (backend arg) - "Call `org-lparse' with output to a temporary buffer. -No file is created. The prefix ARG is passed through to -`org-lparse'." - (let ((tempbuf (format "*Org %s Export*" (upcase backend)))) - (org-lparse backend backend arg nil nil tempbuf) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window tempbuf)))) - -(defun org-replace-region-by (backend beg end) - "Assume the current region has org-mode syntax, and convert it to HTML. -This can be used in any buffer. For example, you could write an -itemized list in org-mode syntax in an HTML buffer and then use -this command to convert it." - (let (reg backend-string buf pop-up-frames) - (save-window-excursion - (if (derived-mode-p 'org-mode) - (setq backend-string (org-lparse-region backend beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq backend-string (org-lparse-region backend (point-min) - (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert backend-string))) - -(defun org-lparse-region (backend beg end &optional body-only buffer) - "Convert region from BEG to END in org-mode buffer to HTML. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted HTML. If BUFFER is the symbol `string', return the -produced HTML as a string and leave not buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq html (org-lparse-region \"html\" beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (let ((transient-mark-mode t) (zmacs-regions t) - ext-plist rtn) - (setq ext-plist (plist-put ext-plist :ignore-subtree-p t)) - (goto-char end) - (set-mark (point)) ;; to activate the region - (goto-char beg) - (setq rtn (org-lparse backend backend nil nil ext-plist buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (org-called-interactively-p 'any) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -(defvar org-lparse-par-open nil) - -(defun org-lparse-should-inline-p (filename descp) - "Return non-nil if link FILENAME should be inlined. -The decision to inline the FILENAME link is based on the current -settings. DESCP is the boolean of whether there was a link -description. See variables `org-export-html-inline-images' and -`org-export-html-inline-image-extensions'." - (let ((inline-images (org-lparse-get 'INLINE-IMAGES)) - (inline-image-extensions - (org-lparse-get 'INLINE-IMAGE-EXTENSIONS))) - (and (or (eq t inline-images) (and inline-images (not descp))) - (org-file-image-p filename inline-image-extensions)))) - -(defun org-lparse-format-org-link (line opt-plist) - "Return LINE with markup of Org mode links. -OPT-PLIST is the export options list." - (let ((start 0) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (link-validate (plist-get opt-plist :link-validation-function)) - type id-file fnc - rpl path attr desc descp desc1 desc2 link - org-lparse-link-description-is-image) - (while (string-match org-bracket-link-analytic-regexp++ line start) - (setq org-lparse-link-description-is-image nil) - (setq start (match-beginning 0)) - (setq path (save-match-data (org-link-unescape - (match-string 3 line)))) - (setq type (cond - ((match-end 2) (match-string 2 line)) - ((save-match-data - (or (file-name-absolute-p path) - (string-match "^\\.\\.?/" path))) - "file") - (t "internal"))) - (setq path (org-extract-attributes path)) - (setq attr (get-text-property 0 'org-attributes path)) - (setq desc1 (if (match-end 5) (match-string 5 line)) - desc2 (if (match-end 2) (concat type ":" path) path) - descp (and desc1 (not (equal desc1 desc2))) - desc (or desc1 desc2)) - ;; Make an image out of the description if that is so wanted - (when (and descp (org-file-image-p - desc (org-lparse-get 'INLINE-IMAGE-EXTENSIONS))) - (setq org-lparse-link-description-is-image t) - (save-match-data - (if (string-match "^file:" desc) - (setq desc (substring desc (match-end 0))))) - (save-match-data - (setq desc (org-add-props - (org-lparse-format 'INLINE-IMAGE desc) - '(org-protected t))))) - (cond - ((equal type "internal") - (let - ((frag-0 - (if (= (string-to-char path) ?#) - (substring path 1) - path))) - (setq rpl - (org-lparse-format - 'ORG-LINK opt-plist "" "" (org-solidify-link-text - (save-match-data - (org-link-unescape frag-0)) - nil) desc attr descp)))) - ((and (equal type "id") - (setq id-file (org-id-find-id-file path))) - ;; This is an id: link to another file (if it was the same file, - ;; it would have become an internal link...) - (save-match-data - (setq id-file (file-relative-name - id-file - (file-name-directory org-current-export-file))) - (setq rpl - (org-lparse-format - 'ORG-LINK opt-plist type id-file - (concat (if (org-uuidgen-p path) "ID-") path) - desc attr descp)))) - ((member type '("http" "https")) - ;; standard URL, can inline as image - (setq rpl - (org-lparse-format - 'ORG-LINK opt-plist type path nil desc attr descp))) - ((member type '("ftp" "mailto" "news")) - ;; standard URL, can't inline as image - (setq rpl - (org-lparse-format - 'ORG-LINK opt-plist type path nil desc attr descp))) - - ((string= type "coderef") - (setq rpl (org-lparse-format - 'ORG-LINK opt-plist type "" path desc nil descp))) - - ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - ;; The link protocol has a function for format the link - (setq rpl (save-match-data - (funcall fnc (org-link-unescape path) - desc1 (and (boundp 'org-lparse-backend) - (case org-lparse-backend - (xhtml 'html) - (t org-lparse-backend))))))) - ((string= type "file") - ;; FILE link - (save-match-data - (let* - ((components - (if - (string-match "::\\(.*\\)" path) - (list - (replace-match "" t nil path) - (match-string 1 path)) - (list path nil))) - - ;;The proper path, without a fragment - (path-1 - (first components)) - - ;;The raw fragment - (fragment-0 - (second components)) - - ;;Check the fragment. If it can't be used as - ;;target fragment we'll pass nil instead. - (fragment-1 - (if - (and fragment-0 - (not (string-match "^[0-9]*$" fragment-0)) - (not (string-match "^\\*" fragment-0)) - (not (string-match "^/.*/$" fragment-0))) - (org-solidify-link-text - (org-link-unescape fragment-0)) - nil)) - (desc-2 - ;;Description minus "file:" and ".org" - (if (string-match "^file:" desc) - (let - ((desc-1 (replace-match "" t t desc))) - (if (string-match "\\.org$" desc-1) - (replace-match "" t t desc-1) - desc-1)) - desc))) - - (setq rpl - (if - (and - (functionp link-validate) - (not (funcall link-validate path-1 current-dir))) - desc - (org-lparse-format - 'ORG-LINK opt-plist "file" path-1 fragment-1 - desc-2 attr descp)))))) - - (t - ;; just publish the path, as default - (setq rpl (concat "<" type ":" - (save-match-data (org-link-unescape path)) - ">")))) - (setq line (replace-match rpl t t line) - start (+ start (length rpl)))) - line)) - -(defvar org-lparse-par-open-stashed) ; bound during `org-do-lparse' -(defun org-lparse-stash-save-paragraph-state () - (assert (zerop org-lparse-par-open-stashed)) - (setq org-lparse-par-open-stashed org-lparse-par-open) - (setq org-lparse-par-open nil)) - -(defun org-lparse-stash-pop-paragraph-state () - (setq org-lparse-par-open org-lparse-par-open-stashed) - (setq org-lparse-par-open-stashed 0)) - -(defmacro with-org-lparse-preserve-paragraph-state (&rest body) - `(let ((org-lparse-do-open-par org-lparse-par-open)) - (org-lparse-end-paragraph) - ,@body - (when org-lparse-do-open-par - (org-lparse-begin-paragraph)))) -(def-edebug-spec with-org-lparse-preserve-paragraph-state (body)) - -(defvar org-lparse-native-backends nil - "List of native backends registered with `org-lparse'. -A backend can use `org-lparse-register-backend' to add itself to -this list. - -All native backends must implement a get routine and a mandatory -set of callback routines. - -The get routine must be named as org--get where backend -is the name of the backend. The exporter uses `org-lparse-get' -and retrieves the backend-specific callback by querying for -ENTITY-CONTROL and ENTITY-FORMAT variables. - -For the sake of illustration, the html backend implements -`org-xhtml-get'. It returns -`org-xhtml-entity-control-callbacks-alist' and -`org-xhtml-entity-format-callbacks-alist' as the values of -ENTITY-CONTROL and ENTITY-FORMAT settings.") - -(defun org-lparse-register-backend (backend) - "Make BACKEND known to `org-lparse' library. -Add BACKEND to `org-lparse-native-backends'." - (when backend - (setq backend (cond - ((symbolp backend) (symbol-name backend)) - ((stringp backend) backend) - (t (error "Error while registering backend: %S" backend)))) - (add-to-list 'org-lparse-native-backends backend))) - -(defun org-lparse-unregister-backend (backend) - (setq org-lparse-native-backends - (remove (cond - ((symbolp backend) (symbol-name backend)) - ((stringp backend) backend)) - org-lparse-native-backends)) - (message "Unregistered backend %S" backend)) - -(defun org-lparse-do-reachable-formats (in-fmt) - "Return verbose info about formats to which IN-FMT can be converted. -Return a list where each element is of the -form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See -`org-export-odt-convert-processes' for CONVERTER-PROCESS and see -`org-export-odt-convert-capabilities' for OUTPUT-FMT-ALIST." - (let (reachable-formats) - (dolist (backend org-lparse-native-backends reachable-formats) - (let* ((converter (org-lparse-backend-get - backend 'CONVERT-METHOD)) - (capabilities (org-lparse-backend-get - backend 'CONVERT-CAPABILITIES))) - (when converter - (dolist (c capabilities) - (when (member in-fmt (nth 1 c)) - (push (cons converter (nth 2 c)) reachable-formats)))))))) - -(defun org-lparse-reachable-formats (in-fmt) - "Return list of formats to which IN-FMT can be converted. -The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)." - (let (l) - (mapc (lambda (e) (add-to-list 'l e)) - (apply 'append (mapcar - (lambda (e) (mapcar 'car (cdr e))) - (org-lparse-do-reachable-formats in-fmt)))) - l)) - -(defun org-lparse-reachable-p (in-fmt out-fmt) - "Return non-nil if IN-FMT can be converted to OUT-FMT." - (catch 'done - (let ((reachable-formats (org-lparse-do-reachable-formats in-fmt))) - (dolist (e reachable-formats) - (let ((out-fmt-spec (assoc out-fmt (cdr e)))) - (when out-fmt-spec - (throw 'done (cons (car e) out-fmt-spec)))))))) - -(defun org-lparse-backend-is-native-p (backend) - (member backend org-lparse-native-backends)) - -(defun org-lparse (target-backend native-backend arg - &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the outline to various formats. -If there is an active region, export only the region. The -outline is first exported to NATIVE-BACKEND and optionally -converted to TARGET-BACKEND. See `org-lparse-native-backends' -for list of known native backends. Each native backend can -specify a converter and list of target backends it exports to -using the CONVERT-PROCESS and OTHER-BACKENDS settings of it's get -method. See `org-xhtml-get' for an illustrative example. - -ARG is a prefix argument that specifies how many levels of -outline should become headlines. The default is 3. Lower levels -will become bulleted lists. - -HIDDEN is obsolete and does nothing. - -EXT-PLIST is a property list that controls various aspects of -export. The settings here override org-mode's default settings -and but are inferior to file-local settings. - -TO-BUFFER dumps the exported lines to a buffer or a string -instead of a file. If TO-BUFFER is the symbol `string' return the -exported lines as a string. If TO-BUFFER is non-nil, create a -buffer with that name and export to that buffer. - -BODY-ONLY controls the presence of header and footer lines in -exported text. If BODY-ONLY is non-nil, don't produce the file -header and footer, simply return the content of ..., -without even the body tags themselves. - -PUB-DIR specifies the publishing directory." - (let* ((org-lparse-backend (intern native-backend)) - (org-lparse-other-backend (and target-backend - (intern target-backend)))) - (add-hook 'org-export-preprocess-hook - 'org-lparse-strip-experimental-blocks-maybe) - (add-hook 'org-export-preprocess-after-blockquote-hook - 'org-lparse-preprocess-after-blockquote) - (unless (org-lparse-backend-is-native-p native-backend) - (error "Don't know how to export natively to backend %s" native-backend)) - - (unless (or (equal native-backend target-backend) - (org-lparse-reachable-p native-backend target-backend)) - (error "Don't know how to export to backend %s %s" target-backend - (format "via %s" native-backend))) - (run-hooks 'org-export-first-hook) - (prog1 - (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir) - (remove-hook 'org-export-preprocess-hook - 'org-lparse-strip-experimental-blocks-maybe) - (remove-hook 'org-export-preprocess-after-blockquote-hook - 'org-lparse-preprocess-after-blockquote)))) - -(defcustom org-lparse-use-flashy-warning nil - "Control flashing of messages logged with `org-lparse-warn'. -When non-nil, messages are fontified with warning face and the -exporter lingers for a while to catch user's attention." - :type 'boolean - :group 'org-lparse) - -(defun org-lparse-convert-read-params () - "Return IN-FILE and OUT-FMT params for `org-lparse-do-convert'. -This is a helper routine for interactive use." - (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read)) - (in-file (read-file-name "File to be converted: " - nil buffer-file-name t)) - (in-fmt (file-name-extension in-file)) - (out-fmt-choices (org-lparse-reachable-formats in-fmt)) - (out-fmt - (or (and out-fmt-choices - (funcall input "Output format: " - out-fmt-choices nil nil nil)) - (error - "No known converter or no known output formats for %s files" - in-fmt)))) - (list in-file out-fmt))) - -(eval-when-compile - (require 'browse-url)) - -(declare-function browse-url-file-url "browse-url" (file)) - -(defun org-lparse-do-convert (in-file out-fmt &optional prefix-arg) - "Workhorse routine for `org-export-odt-convert'." - (require 'browse-url) - (let* ((in-file (expand-file-name (or in-file buffer-file-name))) - (dummy (or (file-readable-p in-file) - (error "Cannot read %s" in-file))) - (in-fmt (file-name-extension in-file)) - (out-fmt (or out-fmt (error "Output format unspecified"))) - (how (or (org-lparse-reachable-p in-fmt out-fmt) - (error "Cannot convert from %s format to %s format?" - in-fmt out-fmt))) - (convert-process (car how)) - (out-file (concat (file-name-sans-extension in-file) "." - (nth 1 (or (cdr how) out-fmt)))) - (extra-options (or (nth 2 (cdr how)) "")) - (out-dir (file-name-directory in-file)) - (cmd (format-spec convert-process - `((?i . ,(shell-quote-argument in-file)) - (?I . ,(browse-url-file-url in-file)) - (?f . ,out-fmt) - (?o . ,out-file) - (?O . ,(browse-url-file-url out-file)) - (?d . , (shell-quote-argument out-dir)) - (?D . ,(browse-url-file-url out-dir)) - (?x . ,extra-options))))) - (when (file-exists-p out-file) - (delete-file out-file)) - - (message "Executing %s" cmd) - (let ((cmd-output (shell-command-to-string cmd))) - (message "%s" cmd-output)) - - (cond - ((file-exists-p out-file) - (message "Exported to %s" out-file) - (when prefix-arg - (message "Opening %s..." out-file) - (org-open-file out-file 'system)) - out-file) - (t - (message "Export to %s failed" out-file) - nil)))) - -(defvar org-lparse-insert-tag-with-newlines 'both) - -;; Following variables are let-bound during `org-lparse' -(defvar org-lparse-dyn-first-heading-pos) -(defvar org-lparse-toc) -(defvar org-lparse-entity-control-callbacks-alist) -(defvar org-lparse-entity-format-callbacks-alist) -(defvar org-lparse-backend nil - "The native backend to which the document is currently exported. -This variable is let bound during `org-lparse'. Valid values are -one of the symbols corresponding to `org-lparse-native-backends'. - -Compare this variable with `org-export-current-backend' which is -bound only during `org-export-preprocess-string' stage of the -export process. - -See also `org-lparse-other-backend'.") - -(defvar org-lparse-other-backend nil - "The target backend to which the document is currently exported. -This variable is let bound during `org-lparse'. This variable is -set to either `org-lparse-backend' or one of the symbols -corresponding to OTHER-BACKENDS specification of the -org-lparse-backend. - -For example, if a document is exported to \"odt\" then both -org-lparse-backend and org-lparse-other-backend are bound to -'odt. On the other hand, if a document is exported to \"odt\" -and then converted to \"doc\" then org-lparse-backend is set to -'odt and org-lparse-other-backend is set to 'doc.") - -(defvar org-lparse-body-only nil - "Bind this to BODY-ONLY arg of `org-lparse'.") - -(defvar org-lparse-to-buffer nil - "Bind this to TO-BUFFER arg of `org-lparse'.") - -(defun org-lparse-get-block-params (params) - (save-match-data - (when params - (setq params (org-trim params)) - (unless (string-match "\\`(.*)\\'" params) - (setq params (format "(%s)" params))) - (ignore-errors (read params))))) - -(defvar org-heading-keyword-regexp-format) ; defined in org.el -(defvar org-lparse-special-blocks '("list-table" "annotation")) -(defun org-do-lparse (arg &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the outline to various formats. -See `org-lparse' for more information. This function is a -html-agnostic version of the `org-export-as-html' function in 7.5 -version." - ;; Make sure we have a file name when we need it. - (when (and (not (or to-buffer body-only)) - (not buffer-file-name)) - (if (buffer-base-buffer) - (org-set-local 'buffer-file-name - (with-current-buffer (buffer-base-buffer) - buffer-file-name)) - (error "Need a file name to be able to export"))) - - (org-lparse-warn - (format "Exporting to %s using org-lparse..." - (upcase (symbol-name - (or org-lparse-backend org-lparse-other-backend))))) - - (setq-default org-todo-line-regexp org-todo-line-regexp) - (setq-default org-deadline-line-regexp org-deadline-line-regexp) - (setq-default org-done-keywords org-done-keywords) - (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp) - (let* (hfy-user-sheet-assoc ; let `htmlfontify' know that - ; we are interested in - ; collecting styles - org-lparse-encode-pending - org-lparse-par-open - (org-lparse-par-open-stashed 0) - - ;; list related vars - (org-lparse-list-stack '()) - - ;; list-table related vars - org-lparse-list-table-p - org-lparse-list-table:table-cell-open - org-lparse-list-table:table-row - org-lparse-list-table:lines - - org-lparse-outline-text-open - (org-lparse-latex-fragment-fallback ; currently used only by - ; odt exporter - (or (ignore-errors (org-lparse-get 'LATEX-FRAGMENT-FALLBACK)) - (if (and (org-check-external-command "latex" "" t) - (org-check-external-command "dvipng" "" t)) - 'dvipng - 'verbatim))) - (org-lparse-insert-tag-with-newlines 'both) - (org-lparse-to-buffer to-buffer) - (org-lparse-body-only body-only) - (org-lparse-entity-control-callbacks-alist - (org-lparse-get 'ENTITY-CONTROL)) - (org-lparse-entity-format-callbacks-alist - (org-lparse-get 'ENTITY-FORMAT)) - (opt-plist - (org-export-process-option-filters - (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist)))) - (body-only (or body-only (plist-get opt-plist :body-only))) - valid org-lparse-dyn-first-heading-pos - (odd org-odd-levels-only) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (level-offset (if subtree-p - (save-excursion - (goto-char rbeg) - (+ (funcall outline-level) - (if org-odd-levels-only 1 0))) - 0)) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist))) - (org-current-export-file buffer-file-name) - (level 0) (line "") (origline "") txt todo - (umax nil) - (umax-toc nil) - (filename (if to-buffer nil - (expand-file-name - (concat - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory buffer-file-name))) - "." (org-lparse-get 'FILE-NAME-EXTENSION opt-plist)) - (file-name-as-directory - (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist)))))) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (auto-insert nil) ; Avoid any auto-insert stuff for the new file - (buffer (if to-buffer - (cond - ((eq to-buffer 'string) - (get-buffer-create (org-lparse-get 'EXPORT-BUFFER-NAME))) - (t (get-buffer-create to-buffer))) - (find-file-noselect - (or (let ((f (org-lparse-get 'INIT-METHOD))) - (and f (functionp f) (funcall f filename))) - filename)))) - (org-levels-open (make-vector org-level-max nil)) - (dummy (mapc - (lambda(p) - (let* ((val (plist-get opt-plist p)) - (val (org-xml-encode-org-text-skip-links val))) - (setq opt-plist (plist-put opt-plist p val)))) - '(:date :author :keywords :description))) - (date (plist-get opt-plist :date)) - (date (cond - ((and date (string-match "%" date)) - (format-time-string date)) - (date date) - (t (format-time-string "%Y-%m-%d %T %Z")))) - (dummy (setq opt-plist (plist-put opt-plist :effective-date date))) - (title (org-xml-encode-org-text-skip-links - (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not body-only) - (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "UNTITLED"))) - (dummy (setq opt-plist (plist-put opt-plist :title title))) - (html-table-tag (plist-get opt-plist :html-table-tag)) - (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)")) - (quote-re (format org-heading-keyword-regexp-format - org-quote-string)) - (org-lparse-dyn-current-environment nil) - ;; Get the language-dependent settings - (lang-words (or (assoc (plist-get opt-plist :language) - org-export-language-setup) - (assoc "en" org-export-language-setup))) - (dummy (setq opt-plist (plist-put opt-plist :lang-words lang-words))) - (head-count 0) cnt - (start 0) - (coding-system-for-write - (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-WRITE)) - (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system))) - (save-buffer-coding-system - (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-SAVE)) - (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system))) - (region - (buffer-substring - (if region-p (region-beginning) (point-min)) - (if region-p (region-end) (point-max)))) - (org-export-have-math nil) - (org-export-footnotes-seen nil) - (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) - (org-footnote-insert-pos-for-preprocessor 'point-min) - (org-lparse-opt-plist opt-plist) - (lines - (org-split-string - (org-export-preprocess-string - region - :emph-multiline t - :for-backend (if (equal org-lparse-backend 'xhtml) ; hack - 'html - org-lparse-backend) - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get opt-plist :drawers) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :timestamps (plist-get opt-plist :timestamps) - :archived-trees - (plist-get opt-plist :archived-trees) - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :add-text - (plist-get opt-plist :text) - :LaTeX-fragments - (plist-get opt-plist :LaTeX-fragments)) - "[\r\n]")) - table-open - table-buffer table-orig-buffer - ind - rpl path attr desc descp desc1 desc2 link - snumber fnc - footnotes footref-seen - org-lparse-output-buffer - org-lparse-footnote-definitions - org-lparse-footnote-number - ;; collection - org-lparse-collect-buffer - (org-lparse-collect-count 0) ; things will get haywire if - ; collections are chained. Use - ; this variable to assert this - ; pre-requisite - org-lparse-toc - href - ) - - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (message "Exporting...") - (org-init-section-numbers) - - ;; Switch to the output buffer - (setq org-lparse-output-buffer buffer) - (set-buffer org-lparse-output-buffer) - (let ((inhibit-read-only t)) (erase-buffer)) - (fundamental-mode) - (org-install-letbind) - - (and (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system coding-system-for-write)) - - (let ((case-fold-search nil) - (org-odd-levels-only odd)) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc (if (integerp org-export-with-toc) - (min org-export-with-toc umax) - umax)) - (setq org-lparse-opt-plist - (plist-put org-lparse-opt-plist :headline-levels umax)) - - (when (and org-export-with-toc (not body-only)) - (setq lines (org-lparse-prepare-toc - lines level-offset opt-plist umax-toc))) - - (unless body-only - (org-lparse-begin 'DOCUMENT-CONTENT opt-plist) - (org-lparse-begin 'DOCUMENT-BODY opt-plist)) - - (setq head-count 0) - (org-init-section-numbers) - - (org-lparse-begin-paragraph) - - (while (setq line (pop lines) origline line) - (catch 'nextline - (when (and (org-lparse-current-environment-p 'quote) - (string-match org-outline-regexp-bol line)) - (org-lparse-end-environment 'quote)) - - (when (org-lparse-current-environment-p 'quote) - (org-lparse-insert 'LINE line) - (throw 'nextline nil)) - - ;; Fixed-width, verbatim lines (examples) - (when (and org-export-with-fixed-width - (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line)) - (when (not (org-lparse-current-environment-p 'fixedwidth)) - (org-lparse-begin-environment 'fixedwidth)) - (org-lparse-insert 'LINE (match-string 3 line)) - (when (or (not lines) - (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" - (car lines)))) - (org-lparse-end-environment 'fixedwidth)) - (throw 'nextline nil)) - - ;; Native Text - (when (and (get-text-property 0 'org-native-text line) - ;; Make sure it is the entire line that is protected - (not (< (or (next-single-property-change - 0 'org-native-text line) 10000) - (length line)))) - (let ((ind (get-text-property 0 'original-indentation line))) - (org-lparse-begin-environment 'native) - (org-lparse-insert 'LINE line) - (while (and lines - (or (= (length (car lines)) 0) - (not ind) - (equal ind (get-text-property - 0 'original-indentation (car lines)))) - (or (= (length (car lines)) 0) - (get-text-property 0 'org-native-text (car lines)))) - (org-lparse-insert 'LINE (pop lines))) - (org-lparse-end-environment 'native)) - (throw 'nextline nil)) - - ;; Protected HTML - (when (and (get-text-property 0 'org-protected line) - ;; Make sure it is the entire line that is protected - (not (< (or (next-single-property-change - 0 'org-protected line) 10000) - (length line)))) - (let ((ind (get-text-property 0 'original-indentation line))) - (org-lparse-insert 'LINE line) - (while (and lines - (or (= (length (car lines)) 0) - (not ind) - (equal ind (get-text-property - 0 'original-indentation (car lines)))) - (or (= (length (car lines)) 0) - (get-text-property 0 'org-protected (car lines)))) - (org-lparse-insert 'LINE (pop lines)))) - (throw 'nextline nil)) - - ;; Blockquotes, verse, and center - (when (string-match - "^ORG-\\(.+\\)-\\(START\\|END\\)\\([ \t]+.*\\)?$" line) - (let* ((style (intern (downcase (match-string 1 line)))) - (env-options-plist (org-lparse-get-block-params - (match-string 3 line))) - (f (cdr (assoc (match-string 2 line) - '(("START" . org-lparse-begin-environment) - ("END" . org-lparse-end-environment)))))) - (when (memq style - (append - '(blockquote verse center) - (mapcar 'intern org-lparse-special-blocks))) - (funcall f style env-options-plist) - (throw 'nextline nil)))) - - (when (org-lparse-current-environment-p 'verse) - (let ((i (org-get-string-indentation line))) - (if (> i 0) - (setq line (concat - (let ((org-lparse-encode-pending t)) - (org-lparse-format 'SPACES (* 2 i))) - " " (org-trim line)))) - (unless (string-match "\\\\\\\\[ \t]*$" line) - (setq line (concat line "\\\\"))))) - - ;; make targets to anchors - (setq start 0) - (while (string-match - "<<]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start) - (cond - ((get-text-property (match-beginning 1) 'org-protected line) - (setq start (match-end 1))) - ((match-end 2) - (setq line (replace-match - (let ((org-lparse-encode-pending t)) - (org-lparse-format - 'ANCHOR "" (org-solidify-link-text - (match-string 1 line)))) - t t line))) - ((and org-export-with-toc (equal (string-to-char line) ?*)) - ;; FIXME: NOT DEPENDENT on TOC????????????????????? - (setq line (replace-match - (let ((org-lparse-encode-pending t)) - (org-lparse-format - 'FONTIFY (match-string 1 line) "target")) - ;; (concat "@" (match-string 1 line) "@ ") - t t line))) - (t - (setq line (replace-match - (concat - (let ((org-lparse-encode-pending t)) - (org-lparse-format - 'ANCHOR (match-string 1 line) - (org-solidify-link-text (match-string 1 line)) - "target")) " ") - t t line))))) - - (let ((org-lparse-encode-pending t)) - (setq line (org-lparse-handle-time-stamps line))) - - ;; replace "&" by "&", "<" and ">" by "<" and ">" - ;; handle @<..> HTML tags (replace "@>..<" by "<..>") - ;; Also handle sub_superscripts and checkboxes - (or (string-match org-table-hline-regexp line) - (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line) - (setq line (org-xml-encode-org-text-skip-links line))) - - (setq line (org-lparse-format-org-link line opt-plist)) - - ;; TODO items - (if (and org-todo-line-regexp - (string-match org-todo-line-regexp line) - (match-beginning 2)) - (setq line (concat - (substring line 0 (match-beginning 2)) - (org-lparse-format 'TODO (match-string 2 line)) - (substring line (match-end 2))))) - - ;; Does this contain a reference to a footnote? - (when org-export-with-footnotes - (setq start 0) - (while (string-match "\\([^* \t].*?\\)[ \t]*\\[\\([0-9]+\\)\\]" line start) - ;; Discard protected matches not clearly identified as - ;; footnote markers. - (if (or (get-text-property (match-beginning 2) 'org-protected line) - (not (get-text-property (match-beginning 2) 'org-footnote line))) - (setq start (match-end 2)) - (let ((n (match-string 2 line)) refcnt a) - (if (setq a (assoc n footref-seen)) - (progn - (setcdr a (1+ (cdr a))) - (setq refcnt (cdr a))) - (setq refcnt 1) - (push (cons n 1) footref-seen)) - (setq line - (replace-match - (concat - (or (match-string 1 line) "") - (org-lparse-format - 'FOOTNOTE-REFERENCE - n (cdr (assoc n org-lparse-footnote-definitions)) - refcnt) - ;; If another footnote is following the - ;; current one, add a separator. - (if (save-match-data - (string-match "\\`\\[[0-9]+\\]" - (substring line (match-end 0)))) - (ignore-errors - (org-lparse-get 'FOOTNOTE-SEPARATOR)) - "")) - t t line)))))) - - (cond - ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line) - ;; This is a headline - (setq level (org-tr-level (- (match-end 1) (match-beginning 1) - level-offset)) - txt (match-string 2 line)) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (unless org-lparse-dyn-first-heading-pos - (setq org-lparse-dyn-first-heading-pos (point))) - (org-lparse-begin-level level txt umax head-count) - - ;; QUOTES - (when (string-match quote-re line) - (org-lparse-begin-environment 'quote))) - - ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) - (when (not table-open) - ;; New table starts - (setq table-open t table-buffer nil table-orig-buffer nil)) - - ;; Accumulate lines - (setq table-buffer (cons line table-buffer) - table-orig-buffer (cons origline table-orig-buffer)) - (when (or (not lines) - (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" - (car lines)))) - (setq table-open nil - table-buffer (nreverse table-buffer) - table-orig-buffer (nreverse table-orig-buffer)) - (org-lparse-end-paragraph) - (when org-lparse-list-table-p - (error "Regular tables are not allowed in a list-table block")) - (org-lparse-insert 'TABLE table-buffer table-orig-buffer))) - - ;; Normal lines - (t - ;; This line either is list item or end a list. - (when (get-text-property 0 'list-item line) - (setq line (org-lparse-export-list-line - line - (get-text-property 0 'list-item line) - (get-text-property 0 'list-struct line) - (get-text-property 0 'list-prevs line)))) - - ;; Horizontal line - (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) - (with-org-lparse-preserve-paragraph-state - (org-lparse-insert 'HORIZONTAL-LINE)) - (throw 'nextline nil)) - - ;; Empty lines start a new paragraph. If hand-formatted lists - ;; are not fully interpreted, lines starting with "-", "+", "*" - ;; also start a new paragraph. - (when (string-match "^ [-+*]-\\|^[ \t]*$" line) - (when org-lparse-footnote-number - (org-lparse-end-footnote-definition org-lparse-footnote-number) - (setq org-lparse-footnote-number nil)) - (org-lparse-begin-paragraph)) - - ;; Is this the start of a footnote? - (when org-export-with-footnotes - (when (and (boundp 'footnote-section-tag-regexp) - (string-match (concat "^" footnote-section-tag-regexp) - line)) - ;; ignore this line - (throw 'nextline nil)) - (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line) - (org-lparse-end-paragraph) - (setq org-lparse-footnote-number (match-string 1 line)) - (setq line (replace-match "" t t line)) - (org-lparse-begin-footnote-definition org-lparse-footnote-number))) - ;; Check if the line break needs to be conserved - (cond - ((string-match "\\\\\\\\[ \t]*$" line) - (setq line (replace-match - (org-lparse-format 'LINE-BREAK) - t t line))) - (org-export-preserve-breaks - (setq line (concat line (org-lparse-format 'LINE-BREAK))))) - - ;; Check if a paragraph should be started - (let ((start 0)) - (while (and org-lparse-par-open - (string-match "\\\\par\\>" line start)) - (error "FIXME") - ;; Leave a space in the

    so that the footnote matcher - ;; does not see this. - (if (not (get-text-property (match-beginning 0) - 'org-protected line)) - (setq line (replace-match "

    " t t line))) - (setq start (match-end 0)))) - - (org-lparse-insert 'LINE line))))) - - ;; Properly close all local lists and other lists - (when (org-lparse-current-environment-p 'quote) - (org-lparse-end-environment 'quote)) - - (org-lparse-end-level 1 umax) - - ;; the

  • to close the last text-... div. - (when (and (> umax 0) org-lparse-dyn-first-heading-pos) - (org-lparse-end-outline-text-or-outline)) - - (org-lparse-end 'DOCUMENT-BODY opt-plist) - (unless body-only - (org-lparse-end 'DOCUMENT-CONTENT)) - - (org-lparse-end 'EXPORT) - - ;; kill collection buffer - (when org-lparse-collect-buffer - (kill-buffer org-lparse-collect-buffer)) - - (goto-char (point-min)) - (or (org-export-push-to-kill-ring - (upcase (symbol-name org-lparse-backend))) - (message "Exporting... done")) - - (cond - ((not to-buffer) - (let ((f (org-lparse-get 'SAVE-METHOD))) - (or (and f (functionp f) (funcall f filename opt-plist)) - (save-buffer))) - (or (and (boundp 'org-lparse-other-backend) - org-lparse-other-backend - (not (equal org-lparse-backend org-lparse-other-backend)) - (org-lparse-do-convert - buffer-file-name (symbol-name org-lparse-other-backend))) - (current-buffer))) - ((eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer)))) - (t (current-buffer)))))) - -(defun org-lparse-format-table (lines olines) - "Returns backend-specific code for org-type and table-type tables." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (string-match "^[ \t]*|" (car lines)) - ;; A normal org table - (org-lparse-format-org-table lines nil) - ;; Table made by table.el - (or (org-lparse-format-table-table-using-table-generate-source - ;; FIXME: Need to take care of this during merge - (if (eq org-lparse-backend 'xhtml) 'html org-lparse-backend) - olines - (not org-export-prefer-native-exporter-for-tables)) - ;; We are here only when table.el table has NO col or row - ;; spanning and the user prefers using org's own converter for - ;; exporting of such simple table.el tables. - (org-lparse-format-table-table lines)))) - -(defun org-lparse-table-get-colalign-info (lines) - (let ((col-cookies (org-find-text-property-in-string - 'org-col-cookies (car lines)))) - (when (and col-cookies org-table-clean-did-remove-column) - (setq col-cookies - (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies))) - col-cookies)) - -(defvar org-lparse-table-style) -(defvar org-lparse-table-ncols) -(defvar org-lparse-table-rownum) -(defvar org-lparse-table-is-styled) -(defvar org-lparse-table-begin-marker) -(defvar org-lparse-table-num-numeric-items-per-column) -(defvar org-lparse-table-colalign-info) -(defvar org-lparse-table-colalign-vector) - -;; Following variables are defined in org-table.el -(defvar org-table-number-fraction) -(defvar org-table-number-regexp) -(defun org-lparse-org-table-to-list-table (lines &optional splice) - "Convert org-table to list-table. -LINES is a list of the form (ROW1 ROW2 ROW3 ...) where each -element is a `string' representing a single row of org-table. -Thus each ROW has vertical separators \"|\" separating the table -fields. A ROW could also be a row-group separator of the form -\"|---...|\". Return a list of the form (ROW1 ROW2 ROW3 -...). ROW could either be symbol `:hrule' or a list of the -form (FIELD1 FIELD2 FIELD3 ...) as appropriate." - (let (line lines-1) - (cond - (splice - (while (setq line (pop lines)) - (unless (string-match "^[ \t]*|-" line) - (push (org-split-string line "[ \t]*|[ \t]*") lines-1)))) - (t - (while (setq line (pop lines)) - (cond - ((string-match "^[ \t]*|-" line) - (when lines - (push :hrule lines-1))) - (t - (push (org-split-string line "[ \t]*|[ \t]*") lines-1)))))) - (nreverse lines-1))) - -(defun org-lparse-insert-org-table (lines &optional splice) - "Format a org-type table into backend-specific code. -LINES is a list of lines. Optional argument SPLICE means, do not -insert header and surrounding tags, just format the lines. -Optional argument NO-CSS means use XHTML attributes instead of CSS -for formatting. This is required for the DocBook exporter." - (require 'org-table) - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; column and the special lines - (setq lines (org-table-clean-before-export lines))) - (let* ((caption (org-find-text-property-in-string 'org-caption (car lines))) - (short-caption (or (org-find-text-property-in-string - 'org-caption-shortn (car lines)) caption)) - (caption (and caption (org-xml-encode-org-text caption))) - (short-caption (and short-caption - (org-xml-encode-plain-text short-caption))) - (label (org-find-text-property-in-string 'org-label (car lines))) - (org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines)) - (attributes (org-find-text-property-in-string 'org-attributes - (car lines))) - (head (and org-export-highlight-first-table-line - (delq nil (mapcar - (lambda (x) (string-match "^[ \t]*|-" x)) - (cdr lines)))))) - (setq lines (org-lparse-org-table-to-list-table lines splice)) - (org-lparse-insert-list-table - lines splice caption label attributes head org-lparse-table-colalign-info - short-caption))) - -(defun org-lparse-insert-list-table (lines &optional splice - caption label attributes head - org-lparse-table-colalign-info - short-caption) - (or (featurep 'org-table) ; required for - (require 'org-table)) ; `org-table-number-regexp' - (let* ((org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0) - tbopen fields line - org-lparse-table-cur-rowgrp-is-hdr - org-lparse-table-rowgrp-open - org-lparse-table-num-numeric-items-per-column - org-lparse-table-colalign-vector n - org-lparse-table-rowgrp-info - org-lparse-table-begin-marker - (org-lparse-table-style 'org-table) - org-lparse-table-is-styled) - (cond - (splice - (setq org-lparse-table-is-styled nil) - (while (setq line (pop lines)) - (insert (org-lparse-format-table-row line) "\n"))) - (t - (setq org-lparse-table-is-styled t) - (org-lparse-begin 'TABLE caption label attributes short-caption) - (setq org-lparse-table-begin-marker (point)) - (org-lparse-begin-table-rowgroup head) - (while (setq line (pop lines)) - (cond - ((equal line :hrule) - (org-lparse-begin-table-rowgroup)) - (t - (insert (org-lparse-format-table-row line) "\n")))) - (org-lparse-end 'TABLE-ROWGROUP) - (org-lparse-end-table))))) - -(defun org-lparse-format-org-table (lines &optional splice) - (with-temp-buffer - (org-lparse-insert-org-table lines splice) - (buffer-substring-no-properties (point-min) (point-max)))) - -(defun org-lparse-format-list-table (lines &optional splice) - (with-temp-buffer - (org-lparse-insert-list-table lines splice) - (buffer-substring-no-properties (point-min) (point-max)))) - -(defun org-lparse-insert-table-table (lines) - "Format a table generated by table.el into backend-specific code. -This conversion does *not* use `table-generate-source' from table.el. -This has the advantage that Org-mode's HTML conversions can be used. -But it has the disadvantage, that no cell- or row-spanning is allowed." - (let (line field-buffer - (org-lparse-table-cur-rowgrp-is-hdr - org-export-highlight-first-table-line) - (caption nil) - (short-caption nil) - (attributes nil) - (label nil) - (org-lparse-table-style 'table-table) - (org-lparse-table-is-styled nil) - fields org-lparse-table-ncols i (org-lparse-table-rownum -1) - (empty (org-lparse-format 'SPACES 1))) - (org-lparse-begin 'TABLE caption label attributes short-caption) - (while (setq line (pop lines)) - (cond - ((string-match "^[ \t]*\\+-" line) - (when field-buffer - (let ((org-export-table-row-tags '("" . "")) - ;; (org-export-html-table-use-header-tags-for-first-column nil) - ) - (insert (org-lparse-format-table-row field-buffer empty))) - (setq org-lparse-table-cur-rowgrp-is-hdr nil) - (setq field-buffer nil))) - (t - ;; Break the line into fields and store the fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (if field-buffer - (setq field-buffer (mapcar - (lambda (x) - (concat x (org-lparse-format 'LINE-BREAK) - (pop fields))) - field-buffer)) - (setq field-buffer fields))))) - (org-lparse-end-table))) - -(defun org-lparse-format-table-table (lines) - (with-temp-buffer - (org-lparse-insert-table-table lines) - (buffer-substring-no-properties (point-min) (point-max)))) - -(defvar table-source-languages) ; defined in table.el -(defun org-lparse-format-table-table-using-table-generate-source (backend - lines - &optional - spanned-only) - "Format a table into BACKEND, using `table-generate-source' from table.el. -Use SPANNED-ONLY to suppress exporting of simple table.el tables. - -When SPANNED-ONLY is nil, all table.el tables are exported. When -SPANNED-ONLY is non-nil, only tables with either row or column -spans are exported. - -This routine returns the generated source or nil as appropriate. - -Refer docstring of `org-export-prefer-native-exporter-for-tables' -for further information." - (require 'table) - (with-current-buffer (get-buffer-create " org-tmp1 ") - (erase-buffer) - (insert (mapconcat 'identity lines "\n")) - (goto-char (point-min)) - (if (not (re-search-forward "|[^+]" nil t)) - (error "Error processing table")) - (table-recognize-table) - (when (or (not spanned-only) - (let* ((dim (table-query-dimension)) - (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim))) - (not (= (* c r) cells)))) - (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) - (cond - ((member backend table-source-languages) - (table-generate-source backend " org-tmp2 ") - (set-buffer " org-tmp2 ") - (buffer-substring (point-min) (point-max))) - (t - ;; table.el doesn't support the given backend. Currently this - ;; happens in case of odt export. Strip the table from the - ;; generated document. A better alternative would be to embed - ;; the table as ascii text in the output document. - (org-lparse-warn - (concat - "Found table.el-type table in the source org file. " - (format "table.el doesn't support %s backend. " - (upcase (symbol-name backend))) - "Skipping ahead ...")) - ""))))) - -(defun org-lparse-handle-time-stamps (s) - "Format time stamps in string S, or remove them." - (catch 'exit - (let (r b) - (when org-maybe-keyword-time-regexp - (while (string-match org-maybe-keyword-time-regexp s) - (or b (setq b (substring s 0 (match-beginning 0)))) - (setq r (concat - r (substring s 0 (match-beginning 0)) " " - (org-lparse-format - 'FONTIFY - (concat - (if (match-end 1) - (org-lparse-format - 'FONTIFY - (match-string 1 s) "timestamp-kwd")) - " " - (org-lparse-format - 'FONTIFY - (substring (org-translate-time (match-string 3 s)) 1 -1) - "timestamp")) - "timestamp-wrapper")) - s (substring s (match-end 0))))) - - ;; Line break if line started and ended with time stamp stuff - (if (not r) - s - (setq r (concat r s)) - (unless (string-match "\\S-" (concat b s)) - (setq r (concat r (org-lparse-format 'LINE-BREAK)))) - r)))) - -(defun org-xml-encode-plain-text (s) - "Convert plain text characters to HTML equivalent. -Possible conversions are set in `org-export-html-protect-char-alist'." - (let ((cl (org-lparse-get 'PLAIN-TEXT-MAP)) c) - (while (setq c (pop cl)) - (let ((start 0)) - (while (string-match (car c) s start) - (setq s (replace-match (cdr c) t t s) - start (1+ (match-beginning 0)))))) - s)) - -(defun org-xml-encode-org-text-skip-links (string) - "Prepare STRING for HTML export. Apply all active conversions. -If there are links in the string, don't modify these. If STRING -is nil, return nil." - (when string - (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) - m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-xml-encode-org-text s) res) - (push l res)) - (push (org-xml-encode-org-text string) res) - (apply 'concat (nreverse res))))) - -(defun org-xml-encode-org-text (s) - "Apply all active conversions to translate special ASCII to HTML." - (setq s (org-xml-encode-plain-text s)) - (if org-export-html-expand - (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" t nil s)))) - (if org-export-with-emphasize - (setq s (org-lparse-apply-char-styles s))) - (if org-export-with-special-strings - (setq s (org-lparse-convert-special-strings s))) - (if org-export-with-sub-superscripts - (setq s (org-lparse-apply-sub-superscript-styles s))) - (if org-export-with-TeX-macros - (let ((start 0) wd rep) - (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" - s start)) - (if (get-text-property (match-beginning 0) 'org-protected s) - (setq start (match-end 0)) - (setq wd (match-string 1 s)) - (if (setq rep (org-lparse-format 'ORG-ENTITY wd)) - (setq s (replace-match rep t t s)) - (setq start (+ start (length wd)))))))) - s) - -(defun org-lparse-convert-special-strings (string) - "Convert special characters in STRING to HTML." - (let ((all (org-lparse-get 'SPECIAL-STRING-REGEXPS)) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (if (get-text-property (match-beginning 0) 'org-protected string) - (setq start (match-end 0)) - (setq string (replace-match rpl t nil string))))) - string)) - -(defun org-lparse-apply-sub-superscript-styles (string) - "Apply subscript and superscript styles to STRING. -Use `org-export-with-sub-superscripts' to control application of -sub and superscript styles." - (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) - (while (string-match org-match-substring-regexp string s) - (cond - ((and requireb (match-end 8)) (setq s (match-end 2))) - ((get-text-property (match-beginning 2) 'org-protected string) - (setq s (match-end 2))) - (t - (setq s (match-end 1) - key (if (string= (match-string 2 string) "_") - 'subscript 'superscript) - c (or (match-string 8 string) - (match-string 6 string) - (match-string 5 string)) - string (replace-match - (concat (match-string 1 string) - (org-lparse-format 'FONTIFY c key)) - t t string))))) - (while (string-match "\\\\\\([_^]\\)" string) - (setq string (replace-match (match-string 1 string) t t string))) - string)) - -(defvar org-lparse-char-styles - `(("*" bold) - ("/" emphasis) - ("_" underline) - ("=" code) - ("~" verbatim) - ("+" strike)) - "Map Org emphasis markers to char styles. -This is an alist where each element is of the -form (ORG-EMPHASIS-CHAR . CHAR-STYLE).") - -(defun org-lparse-apply-char-styles (string) - "Apply char styles to STRING. -The variable `org-lparse-char-styles' controls how the Org -emphasis markers are interpreted." - (let ((s 0) rpl) - (while (string-match org-emph-re string s) - (if (not (equal - (substring string (match-beginning 3) (1+ (match-beginning 3))) - (substring string (match-beginning 4) (1+ (match-beginning 4))))) - (setq s (match-beginning 0) - rpl - (concat - (match-string 1 string) - (org-lparse-format - 'FONTIFY (match-string 4 string) - (nth 1 (assoc (match-string 3 string) - org-lparse-char-styles))) - (match-string 5 string)) - string (replace-match rpl t t string) - s (+ s (- (length rpl) 2))) - (setq s (1+ s)))) - string)) - -(defun org-lparse-export-list-line (line pos struct prevs) - "Insert list syntax in export buffer. Return LINE, maybe modified. - -POS is the item position or line position the line had before -modifications to buffer. STRUCT is the list structure. PREVS is -the alist of previous items." - (let* ((get-type - (function - ;; Translate type of list containing POS to "d", "o" or - ;; "u". - (lambda (pos struct prevs) - (let ((type (org-list-get-list-type pos struct prevs))) - (cond - ((eq 'ordered type) "o") - ((eq 'descriptive type) "d") - (t "u")))))) - (get-closings - (function - ;; Return list of all items and sublists ending at POS, in - ;; reverse order. - (lambda (pos) - (let (out) - (catch 'exit - (mapc (lambda (e) - (let ((end (nth 6 e)) - (item (car e))) - (cond - ((= end pos) (push item out)) - ((>= item pos) (throw 'exit nil))))) - struct)) - out))))) - ;; First close any previous item, or list, ending at POS. - (mapc (lambda (e) - (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) - (first-item (org-list-get-list-begin e struct prevs)) - (type (funcall get-type first-item struct prevs))) - (org-lparse-end-paragraph) - ;; Ending for every item - (org-lparse-end-list-item-1 type) - ;; We're ending last item of the list: end list. - (when lastp - (org-lparse-end-list type) - (org-lparse-begin-paragraph)))) - (funcall get-closings pos)) - (cond - ;; At an item: insert appropriate tags in export buffer. - ((assq pos struct) - (string-match - (concat "[ \t]*\\(\\S-+[ \t]*\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" - "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" - "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?" - "\\(.*\\)") line) - (let* ((checkbox (match-string 3 line)) - (desc-tag (or (match-string 4 line) "???")) - (body (or (match-string 5 line) "")) - (list-beg (org-list-get-list-begin pos struct prevs)) - (firstp (= list-beg pos)) - ;; Always refer to first item to determine list type, in - ;; case list is ill-formed. - (type (funcall get-type list-beg struct prevs)) - (counter (let ((count-tmp (org-list-get-counter pos struct))) - (cond - ((not count-tmp) nil) - ((string-match "[A-Za-z]" count-tmp) - (- (string-to-char (upcase count-tmp)) 64)) - ((string-match "[0-9]+" count-tmp) - count-tmp))))) - (when firstp - (org-lparse-end-paragraph) - (org-lparse-begin-list type)) - - (let ((arg (cond ((equal type "d") desc-tag) - ((equal type "o") counter)))) - (org-lparse-begin-list-item type arg)) - - ;; If line had a checkbox, some additional modification is required. - (when checkbox - (setq body - (concat - (org-lparse-format - 'FONTIFY (concat - "[" - (cond - ((string-match "X" checkbox) "X") - ((string-match " " checkbox) - (org-lparse-format 'SPACES 1)) - (t "-")) - "]") - 'code) - " " - body))) - ;; Return modified line - body)) - ;; At a list ender: go to next line (side-effects only). - ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil)) - ;; Not at an item: return line unchanged (side-effects only). - (t line)))) - -(defun org-lparse-bind-local-variables (opt-plist) - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars)) - -(defvar org-lparse-table-rowgrp-open) -(defvar org-lparse-table-cur-rowgrp-is-hdr) -(defvar org-lparse-footnote-number) -(defvar org-lparse-footnote-definitions) -(defvar org-lparse-output-buffer nil - "Buffer to which `org-do-lparse' writes to. -This buffer contains the contents of the to-be-created exported -document.") - -(defcustom org-lparse-debug nil - "Enable or Disable logging of `org-lparse' callbacks. -The parameters passed to the backend-registered ENTITY-CONTROL -and ENTITY-FORMAT callbacks are logged as comment strings in the -exported buffer. (org-lparse-format 'COMMENT fmt args) is used -for logging. Customize this variable only if you are an expert -user. Valid values of this variable are: -nil : Disable logging -control : Log all invocations of `org-lparse-begin' and - `org-lparse-end' callbacks. -format : Log invocations of `org-lparse-format' callbacks. -t : Log all invocations of `org-lparse-begin', `org-lparse-end' - and `org-lparse-format' callbacks," - :group 'org-lparse - :type '(choice - (const :tag "Disable" nil) - (const :tag "Format callbacks" format) - (const :tag "Control callbacks" control) - (const :tag "Format and Control callbacks" t))) - -(defun org-lparse-begin (entity &rest args) - "Begin ENTITY in current buffer. ARGS is entity specific. -ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM etc. - -Use (org-lparse-begin 'LIST \"o\") to begin a list in current -buffer. - -See `org-xhtml-entity-control-callbacks-alist' for more -information." - (when (and (member org-lparse-debug '(t control)) - (not (eq entity 'DOCUMENT-CONTENT))) - (insert (org-lparse-format 'COMMENT "%s BEGIN %S" entity args))) - - (let ((f (cadr (assoc entity org-lparse-entity-control-callbacks-alist)))) - (unless f (error "Unknown entity: %s" entity)) - (apply f args))) - -(defun org-lparse-end (entity &rest args) - "Close ENTITY in current buffer. ARGS is entity specific. -ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM -etc. - -Use (org-lparse-end 'LIST \"o\") to close a list in current -buffer. - -See `org-xhtml-entity-control-callbacks-alist' for more -information." - (when (and (member org-lparse-debug '(t control)) - (not (eq entity 'DOCUMENT-CONTENT))) - (insert (org-lparse-format 'COMMENT "%s END %S" entity args))) - - (let ((f (caddr (assoc entity org-lparse-entity-control-callbacks-alist)))) - (unless f (error "Unknown entity: %s" entity)) - (apply f args))) - -(defun org-lparse-begin-paragraph (&optional style) - "Insert

    , but first close previous paragraph if any." - (org-lparse-end-paragraph) - (org-lparse-begin 'PARAGRAPH style) - (setq org-lparse-par-open t)) - -(defun org-lparse-end-paragraph () - "Close paragraph if there is one open." - (when org-lparse-par-open - (org-lparse-end 'PARAGRAPH) - (setq org-lparse-par-open nil))) - -(defun org-lparse-end-list-item-1 (&optional type) - "Close

  • if necessary." - (org-lparse-end-paragraph) - (org-lparse-end-list-item (or type "u"))) - -(define-obsolete-function-alias - 'org-lparse-preprocess-after-blockquote-hook - 'org-lparse-preprocess-after-blockquote - "24.3") - -(defun org-lparse-preprocess-after-blockquote () - "Treat `org-lparse-special-blocks' specially." - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*#\\+\\(begin\\|end\\)_\\(\\S-+\\)[ \t]*\\(.*\\)$" nil t) - (when (member (downcase (match-string 2)) org-lparse-special-blocks) - (replace-match - (if (equal (downcase (match-string 1)) "begin") - (format "ORG-%s-START %s" (upcase (match-string 2)) - (match-string 3)) - (format "ORG-%s-END %s" (upcase (match-string 2)) - (match-string 3))) t t)))) - -(define-obsolete-function-alias - 'org-lparse-strip-experimental-blocks-maybe-hook - 'org-lparse-strip-experimental-blocks-maybe - "24.3") - -(defun org-lparse-strip-experimental-blocks-maybe () - "Strip \"list-table\" and \"annotation\" blocks. -Stripping happens only when the exported backend is not one of -\"odt\" or \"xhtml\"." - (when (not org-lparse-backend) - (message "Stripping following blocks - %S" org-lparse-special-blocks) - (goto-char (point-min)) - (let ((case-fold-search t)) - (while - (re-search-forward - "^[ \t]*#\\+begin_\\(\\S-+\\)\\([ \t]+.*\\)?\n\\([^\000]*?\\)\n[ \t]*#\\+end_\\1\\>.*" - nil t) - (when (member (match-string 1) org-lparse-special-blocks) - (replace-match "" t t)))))) - -(defvar org-lparse-list-table-p nil - "Non-nil if `org-do-lparse' is within a list-table.") - -(defvar org-lparse-dyn-current-environment nil) -(defun org-lparse-begin-environment (style &optional env-options-plist) - (case style - (list-table - (setq org-lparse-list-table-p t)) - (t (setq org-lparse-dyn-current-environment style) - (org-lparse-begin 'ENVIRONMENT style env-options-plist)))) - -(defun org-lparse-end-environment (style &optional env-options-plist) - (case style - (list-table - (setq org-lparse-list-table-p nil)) - (t (org-lparse-end 'ENVIRONMENT style env-options-plist) - (setq org-lparse-dyn-current-environment nil)))) - -(defun org-lparse-current-environment-p (style) - (eq org-lparse-dyn-current-environment style)) - -(defun org-lparse-begin-footnote-definition (n) - (org-lparse-begin-collect) - (setq org-lparse-insert-tag-with-newlines nil) - (org-lparse-begin 'FOOTNOTE-DEFINITION n)) - -(defun org-lparse-end-footnote-definition (n) - (org-lparse-end 'FOOTNOTE-DEFINITION n) - (setq org-lparse-insert-tag-with-newlines 'both) - (let ((footnote-def (org-lparse-end-collect))) - ;; Cleanup newlines in footnote definition. This ensures that a - ;; transcoded line is never (wrongly) broken in to multiple lines. - (let ((pos 0)) - (while (string-match "[\r\n]+" footnote-def pos) - (setq pos (1+ (match-beginning 0))) - (setq footnote-def (replace-match " " t t footnote-def)))) - (push (cons n footnote-def) org-lparse-footnote-definitions))) - -(defvar org-lparse-collect-buffer nil - "An auxiliary buffer named \"*Org Lparse Collect*\". -`org-do-lparse' uses this as output buffer while collecting -footnote definitions and table-cell contents of list-tables. See -`org-lparse-begin-collect' and `org-lparse-end-collect'.") - -(defvar org-lparse-collect-count nil - "Count number of calls to `org-lparse-begin-collect'. -Use this counter to catch chained collections if they ever -happen.") - -(defun org-lparse-begin-collect () - "Temporarily switch to `org-lparse-collect-buffer'. -Also erase it's contents." - (unless (zerop org-lparse-collect-count) - (error "FIXME (org-lparse.el): Encountered chained collections")) - (incf org-lparse-collect-count) - (unless org-lparse-collect-buffer - (setq org-lparse-collect-buffer - (get-buffer-create "*Org Lparse Collect*"))) - (set-buffer org-lparse-collect-buffer) - (erase-buffer)) - -(defun org-lparse-end-collect () - "Switch to `org-lparse-output-buffer'. -Return contents of `org-lparse-collect-buffer' as a `string'." - (assert (> org-lparse-collect-count 0)) - (decf org-lparse-collect-count) - (prog1 (buffer-string) - (erase-buffer) - (set-buffer org-lparse-output-buffer))) - -(defun org-lparse-format (entity &rest args) - "Format ENTITY in backend-specific way and return it. -ARGS is specific to entity being formatted. - -Use (org-lparse-format 'HEADING \"text\" 1) to format text as -level 1 heading. - -See `org-xhtml-entity-format-callbacks-alist' for more information." - (when (and (member org-lparse-debug '(t format)) - (not (equal entity 'COMMENT))) - (insert (org-lparse-format 'COMMENT "%s: %S" entity args))) - (cond - ((consp entity) - (let ((text (pop args))) - (apply 'org-lparse-format 'TAGS entity text args))) - (t - (let ((f (cdr (assoc entity org-lparse-entity-format-callbacks-alist)))) - (unless f (error "Unknown entity: %s" entity)) - (apply f args))))) - -(defun org-lparse-insert (entity &rest args) - (insert (apply 'org-lparse-format entity args))) - -(defun org-lparse-prepare-toc (lines level-offset opt-plist umax-toc) - (let* ((quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) - (org-min-level (org-get-min-level lines level-offset)) - (org-last-level org-min-level) - level) - (with-temp-buffer - (org-lparse-bind-local-variables opt-plist) - (erase-buffer) - (org-lparse-begin 'TOC (nth 3 (plist-get opt-plist :lang-words)) umax-toc) - (setq - lines - (mapcar - #'(lambda (line) - (when (and (string-match org-todo-line-regexp line) - (not (get-text-property 0 'org-protected line)) - (<= (setq level (org-tr-level - (- (match-end 1) (match-beginning 1) - level-offset))) - umax-toc)) - (let ((txt (save-match-data - (org-xml-encode-org-text-skip-links - (org-export-cleanup-toc-line - (match-string 3 line))))) - (todo (and - org-export-mark-todo-in-toc - (or (and (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) - (and (= level umax-toc) - (org-search-todo-below - line lines level))))) - tags) - ;; Check for targets - (while (string-match org-any-target-regexp line) - (setq line - (replace-match - (let ((org-lparse-encode-pending t)) - (org-lparse-format 'FONTIFY - (match-string 1 line) "target")) - t t line))) - (when (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) - (setq tags (match-string 1 txt) - txt (replace-match "" t nil txt))) - (when (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) - (setq txt (replace-match "" t t txt))) - (org-lparse-format - 'TOC-ITEM - (let* ((snumber (org-section-number level)) - (href (replace-regexp-in-string - "\\." "-" (format "sec-%s" snumber))) - (href - (or - (cdr (assoc - href org-export-preferred-target-alist)) - href)) - (href (org-solidify-link-text href))) - (org-lparse-format 'TOC-ENTRY snumber todo txt tags href)) - level org-last-level) - (setq org-last-level level))) - line) - lines)) - (org-lparse-end 'TOC) - (setq org-lparse-toc (buffer-string)))) - lines) - -(defun org-lparse-format-table-row (fields &optional text-for-empty-fields) - (if org-lparse-table-ncols - ;; second and subsequent rows of the table - (when (and org-lparse-list-table-p - (> (length fields) org-lparse-table-ncols)) - (error "Table row has %d columns but header row claims %d columns" - (length fields) org-lparse-table-ncols)) - ;; first row of the table - (setq org-lparse-table-ncols (length fields)) - (when org-lparse-table-is-styled - (setq org-lparse-table-num-numeric-items-per-column - (make-vector org-lparse-table-ncols 0)) - (setq org-lparse-table-colalign-vector - (make-vector org-lparse-table-ncols nil)) - (let ((c -1)) - (while (< (incf c) org-lparse-table-ncols) - (let* ((col-cookie (cdr (assoc (1+ c) org-lparse-table-colalign-info))) - (align (nth 0 col-cookie))) - (setf (aref org-lparse-table-colalign-vector c) - (cond - ((string= align "l") "left") - ((string= align "r") "right") - ((string= align "c") "center")))))))) - (incf org-lparse-table-rownum) - (let ((i -1)) - (org-lparse-format - 'TABLE-ROW - (mapconcat - (lambda (x) - (when (and (string= x "") text-for-empty-fields) - (setq x text-for-empty-fields)) - (incf i) - (let (col-cookie horiz-span) - (when org-lparse-table-is-styled - (when (and (< i org-lparse-table-ncols) - (string-match org-table-number-regexp x)) - (incf (aref org-lparse-table-num-numeric-items-per-column i))) - (setq col-cookie (cdr (assoc (1+ i) org-lparse-table-colalign-info)) - horiz-span (nth 1 col-cookie))) - (org-lparse-format - 'TABLE-CELL x org-lparse-table-rownum i (or horiz-span 0)))) - fields "\n")))) - -(defun org-lparse-get (what &optional opt-plist) - "Query for value of WHAT for the current backend `org-lparse-backend'. -See also `org-lparse-backend-get'." - (if (boundp 'org-lparse-backend) - (org-lparse-backend-get (symbol-name org-lparse-backend) what opt-plist) - (error "org-lparse-backend is not bound yet"))) - -(defun org-lparse-backend-get (backend what &optional opt-plist) - "Query BACKEND for value of WHAT. -Dispatch the call to `org--user-get'. If that throws an -error, dispatch the call to `org--get'. See -`org-xhtml-get' for all known settings queried for by -`org-lparse' during the course of export." - (assert (stringp backend) t) - (unless (org-lparse-backend-is-native-p backend) - (error "Unknown native backend %s" backend)) - (let ((backend-get-method (intern (format "org-%s-get" backend))) - (backend-user-get-method (intern (format "org-%s-user-get" backend)))) - (cond - ((functionp backend-get-method) - (condition-case nil - (funcall backend-user-get-method what opt-plist) - (error (funcall backend-get-method what opt-plist)))) - (t - (error "Native backend %s doesn't define %s" backend backend-get-method))))) - -(defun org-lparse-insert-tag (tag &rest args) - (when (member org-lparse-insert-tag-with-newlines '(lead both)) - (insert "\n")) - (insert (apply 'format tag args)) - (when (member org-lparse-insert-tag-with-newlines '(trail both)) - (insert "\n"))) - -(defun org-lparse-get-targets-from-title (title) - (let* ((target (org-get-text-property-any 0 'target title)) - (extra-targets (assoc target org-export-target-aliases)) - (target (or (cdr (assoc target org-export-preferred-target-alist)) - target))) - (cons target (remove target extra-targets)))) - -(defun org-lparse-suffix-from-snumber (snumber) - (let* ((snu (replace-regexp-in-string "\\." "-" snumber)) - (href (cdr (assoc (concat "sec-" snu) - org-export-preferred-target-alist)))) - (org-solidify-link-text (or href snu)))) - -(defun org-lparse-begin-level (level title umax head-count) - "Insert a new LEVEL in HTML export. -When TITLE is nil, just close all open levels." - (org-lparse-end-level level umax) - (unless title (error "Why is heading nil")) - (let* ((targets (org-lparse-get-targets-from-title title)) - (target (car targets)) (extra-targets (cdr targets)) - (target (and target (org-solidify-link-text target))) - (extra-class (org-get-text-property-any 0 'html-container-class title)) - snumber tags level1 class) - (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) - (setq tags (and org-export-with-tags (match-string 1 title))) - (setq title (replace-match "" t t title))) - (if (> level umax) - (progn - (if (aref org-levels-open (1- level)) - (org-lparse-end-list-item-1) - (aset org-levels-open (1- level) t) - (org-lparse-end-paragraph) - (org-lparse-begin-list 'unordered)) - (org-lparse-begin-list-item - 'unordered target (org-lparse-format - 'HEADLINE title extra-targets tags))) - (aset org-levels-open (1- level) t) - (setq snumber (org-section-number level)) - (setq level1 (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1)) - (unless (= head-count 1) - (org-lparse-end-outline-text-or-outline)) - (org-lparse-begin-outline-and-outline-text - level1 snumber title tags target extra-targets extra-class) - (org-lparse-begin-paragraph)))) - -(defun org-lparse-end-level (level umax) - (org-lparse-end-paragraph) - (loop for l from org-level-max downto level - do (when (aref org-levels-open (1- l)) - ;; Terminate one level in HTML export - (if (<= l umax) - (org-lparse-end-outline-text-or-outline) - (org-lparse-end-list-item-1) - (org-lparse-end-list 'unordered)) - (aset org-levels-open (1- l) nil)))) - -(defvar org-lparse-outline-text-open) -(defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags - target extra-targets - extra-class) - (org-lparse-begin - 'OUTLINE level1 snumber title tags target extra-targets extra-class) - (org-lparse-begin-outline-text level1 snumber extra-class)) - -(defun org-lparse-end-outline-text-or-outline () - (cond - (org-lparse-outline-text-open - (org-lparse-end 'OUTLINE-TEXT) - (setq org-lparse-outline-text-open nil)) - (t (org-lparse-end 'OUTLINE)))) - -(defun org-lparse-begin-outline-text (level1 snumber extra-class) - (assert (not org-lparse-outline-text-open) t) - (setq org-lparse-outline-text-open t) - (org-lparse-begin 'OUTLINE-TEXT level1 snumber extra-class)) - -(defun org-lparse-html-list-type-to-canonical-list-type (ltype) - (cdr (assoc ltype '(("o" . ordered) - ("u" . unordered) - ("d" . description))))) - -;; following vars are bound during `org-do-lparse' -(defvar org-lparse-list-stack) -(defvar org-lparse-list-table:table-row) -(defvar org-lparse-list-table:lines) - -;; Notes on LIST-TABLES -;; ==================== -;; Lists withing "list-table" blocks (as shown below) -;; -;; #+begin_list-table -;; - Row 1 -;; - 1.1 -;; - 1.2 -;; - 1.3 -;; - Row 2 -;; - 2.1 -;; - 2.2 -;; - 2.3 -;; #+end_list-table -;; -;; will be exported as though it were a table as shown below. -;; -;; | Row 1 | 1.1 | 1.2 | 1.3 | -;; | Row 2 | 2.1 | 2.2 | 2.3 | -;; -;; Note that org-tables are NOT multi-line and each line is mapped to -;; a unique row in the exported document. So if an exported table -;; needs to contain a single paragraph (with copious text) it needs to -;; be typed up in a single line. Editing such long lines using the -;; table editor will be a cumbersome task. Furthermore inclusion of -;; multi-paragraph text in a table cell is well-nigh impossible. -;; -;; LIST-TABLEs are meant to circumvent the above problems with -;; org-tables. -;; -;; Note that in the example above the list items could be paragraphs -;; themselves and the list can be arbitrarily deep. -;; -;; Inspired by following thread: -;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html - -(defun org-lparse-begin-list (ltype) - (push ltype org-lparse-list-stack) - (let ((list-level (length org-lparse-list-stack))) - (cond - ((not org-lparse-list-table-p) - (org-lparse-begin 'LIST ltype)) - ;; process LIST-TABLE - ((= 1 list-level) - ;; begin LIST-TABLE - (setq org-lparse-list-table:lines nil) - (setq org-lparse-list-table:table-row nil)) - ((= 2 list-level) - (ignore)) - (t - (org-lparse-begin 'LIST ltype))))) - -(defun org-lparse-end-list (ltype) - (pop org-lparse-list-stack) - (let ((list-level (length org-lparse-list-stack))) - (cond - ((not org-lparse-list-table-p) - (org-lparse-end 'LIST ltype)) - ;; process LIST-TABLE - ((= 0 list-level) - ;; end LIST-TABLE - (insert (org-lparse-format-list-table - (nreverse org-lparse-list-table:lines)))) - ((= 1 list-level) - (ignore)) - (t - (org-lparse-end 'LIST ltype))))) - -(defun org-lparse-begin-list-item (ltype &optional arg headline) - (let ((list-level (length org-lparse-list-stack))) - (cond - ((not org-lparse-list-table-p) - (org-lparse-begin 'LIST-ITEM ltype arg headline)) - ;; process LIST-TABLE - ((= 1 list-level) - ;; begin TABLE-ROW for LIST-TABLE - (setq org-lparse-list-table:table-row nil) - (org-lparse-begin-list-table:table-cell)) - ((= 2 list-level) - ;; begin TABLE-CELL for LIST-TABLE - (org-lparse-begin-list-table:table-cell)) - (t - (org-lparse-begin 'LIST-ITEM ltype arg headline))))) - -(defun org-lparse-end-list-item (ltype) - (let ((list-level (length org-lparse-list-stack))) - (cond - ((not org-lparse-list-table-p) - (org-lparse-end 'LIST-ITEM ltype)) - ;; process LIST-TABLE - ((= 1 list-level) - ;; end TABLE-ROW for LIST-TABLE - (org-lparse-end-list-table:table-cell) - (push (nreverse org-lparse-list-table:table-row) - org-lparse-list-table:lines)) - ((= 2 list-level) - ;; end TABLE-CELL for LIST-TABLE - (org-lparse-end-list-table:table-cell)) - (t - (org-lparse-end 'LIST-ITEM ltype))))) - -(defvar org-lparse-list-table:table-cell-open) -(defun org-lparse-begin-list-table:table-cell () - (org-lparse-end-list-table:table-cell) - (setq org-lparse-list-table:table-cell-open t) - (org-lparse-begin-collect) - (org-lparse-begin-paragraph)) - -(defun org-lparse-end-list-table:table-cell () - (when org-lparse-list-table:table-cell-open - (setq org-lparse-list-table:table-cell-open nil) - (org-lparse-end-paragraph) - (push (org-lparse-end-collect) - org-lparse-list-table:table-row))) - -(defvar org-lparse-table-rowgrp-info) -(defun org-lparse-begin-table-rowgroup (&optional is-header-row) - (push (cons (1+ org-lparse-table-rownum) :start) org-lparse-table-rowgrp-info) - (org-lparse-begin 'TABLE-ROWGROUP is-header-row)) - -(defun org-lparse-end-table () - (when org-lparse-table-is-styled - ;; column groups - (unless (car org-table-colgroup-info) - (setq org-table-colgroup-info - (cons :start (cdr org-table-colgroup-info)))) - - ;; column alignment - (let ((c -1)) - (mapc - (lambda (x) - (incf c) - (setf (aref org-lparse-table-colalign-vector c) - (or (aref org-lparse-table-colalign-vector c) - (if (> (/ (float x) (1+ org-lparse-table-rownum)) - org-table-number-fraction) - "right" "left")))) - org-lparse-table-num-numeric-items-per-column))) - (org-lparse-end 'TABLE)) - -(defvar org-lparse-encode-pending nil) - -(defun org-lparse-format-tags (tag text prefix suffix &rest args) - (cond - ((consp tag) - (concat prefix (apply 'format (car tag) args) text suffix - (format (cdr tag)))) - ((stringp tag) ; singleton tag - (concat prefix (apply 'format tag args) text)))) - -(defun org-xml-fix-class-name (kwd) ; audit callers of this function - "Turn todo keyword into a valid class name. -Replaces invalid characters with \"_\"." - (save-match-data - (while (string-match "[^a-zA-Z0-9_]" kwd) - (setq kwd (replace-match "_" t t kwd)))) - kwd) - -(defun org-lparse-format-todo (todo) - (org-lparse-format 'FONTIFY - (concat - (ignore-errors (org-lparse-get 'TODO-KWD-CLASS-PREFIX)) - (org-xml-fix-class-name todo)) - (list (if (member todo org-done-keywords) "done" "todo") - todo))) - -(defun org-lparse-format-extra-targets (extra-targets) - (if (not extra-targets) "" - (mapconcat (lambda (x) - (setq x (org-solidify-link-text - (if (org-uuidgen-p x) (concat "ID-" x) x))) - (org-lparse-format 'ANCHOR "" x)) - extra-targets ""))) - -(defun org-lparse-format-org-tags (tags) - (if (not tags) "" - (org-lparse-format - 'FONTIFY (mapconcat - (lambda (x) - (org-lparse-format - 'FONTIFY x - (concat - (ignore-errors (org-lparse-get 'TAG-CLASS-PREFIX)) - (org-xml-fix-class-name x)))) - (org-split-string tags ":") - (org-lparse-format 'SPACES 1)) "tag"))) - -(defun org-lparse-format-section-number (&optional snumber level) - (and org-export-with-section-numbers - (not org-lparse-body-only) snumber level - (org-lparse-format 'FONTIFY snumber (format "section-number-%d" level)))) - -(defun org-lparse-warn (msg) - (if (not org-lparse-use-flashy-warning) - (message msg) - (put-text-property 0 (length msg) 'face 'font-lock-warning-face msg) - (message msg) - (sleep-for 3))) - -(defun org-xml-format-href (s) - "Make sure the S is valid as a href reference in an XHTML document." - (save-match-data - (let ((start 0)) - (while (string-match "&" s start) - (setq start (+ (match-beginning 0) 3) - s (replace-match "&" t t s))))) - s) - -(defun org-xml-format-desc (s) - "Make sure the S is valid as a description in a link." - (if (and s (not (get-text-property 1 'org-protected s))) - (save-match-data - (org-xml-encode-org-text s)) - s)) - -(provide 'org-lparse) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-lparse.el ends here diff --git a/lisp/org-macro.el b/lisp/org-macro.el new file mode 100644 index 000000000..0bd0da69a --- /dev/null +++ b/lisp/org-macro.el @@ -0,0 +1,189 @@ +;;; org-macro.el --- Macro Replacement Code for Org Mode + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Macros are expanded with `org-macro-replace-all', which relies +;; internally on `org-macro-expand'. + +;; Default templates for expansion are stored in the buffer-local +;; variable `org-macro-templates'. This variable is updated by +;; `org-macro-initialize-templates', which recursively calls +;; `org-macro--collect-macros' in order to read setup files. + +;; Along with macros defined through #+MACRO: keyword, default +;; templates include the following hard-coded macros: +;; {{{time(format-string)}}}, {{{property(node-property)}}}, +;; {{{input-file}}} and {{{modification-time(format-string)}}}. + +;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}}, +;; {{{email}}} and {{{title}}} macros. + +;;; Code: + +(declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-remove-double-quotes "org" (s)) +(declare-function org-file-contents "org" (file &optional noerror)) +(declare-function org-with-wide-buffer "org-macs" (&rest body)) + +;;; Variables + +(defvar org-macro-templates nil + "Alist containing all macro templates in current buffer. +Associations are in the shape of (NAME . TEMPLATE) where NAME +stands for macro's name and template for its replacement value, +both as strings. This is an internal variable. Do not set it +directly, use instead: + + #+MACRO: name template") +(make-variable-buffer-local 'org-macro-templates) + + +;;; Functions + +(defun org-macro--collect-macros () + "Collect macro definitions in current buffer and setup files. +Return an alist containing all macro templates found." + (let* (collect-macros ; For byte-compiler. + (collect-macros + (lambda (files templates) + ;; Return an alist of macro templates. FILES is a list of + ;; setup files names read so far, used to avoid circular + ;; dependencies. TEMPLATES is the alist collected so far. + (let ((case-fold-search t)) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((val (org-element-property :value element))) + (if (equal (org-element-property :key element) "MACRO") + ;; Install macro in TEMPLATES. + (when (string-match + "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val) + (let* ((name (match-string 1 val)) + (template (or (match-string 2 val) "")) + (old-cell (assoc name templates))) + (if old-cell (setcdr old-cell template) + (push (cons name template) templates)))) + ;; Enter setup file. + (let ((file (expand-file-name + (org-remove-double-quotes val)))) + (unless (member file files) + (with-temp-buffer + (org-mode) + (insert (org-file-contents file 'noerror)) + (setq templates + (funcall collect-macros (cons file files) + templates))))))))))) + templates)))) + (funcall collect-macros nil nil))) + +(defun org-macro-initialize-templates () + "Collect macro templates defined in current buffer. +Templates are stored in buffer-local variable +`org-macro-templates'. In addition to buffer-defined macros, the +function installs the following ones: \"property\", +\"time\". and, if the buffer is associated to a file, +\"input-file\" and \"modification-time\"." + (let* ((templates (org-macro--collect-macros)) + (update-templates + (lambda (cell) + (let ((old-template (assoc (car cell) templates))) + (if old-template (setcdr old-template (cdr cell)) + (push cell templates)))))) + ;; Install hard-coded macros. + (mapc (lambda (cell) (funcall update-templates cell)) + (list (cons "property" "(eval (org-entry-get nil \"$1\" 'selective))") + (cons "time" "(eval (format-time-string \"$1\"))"))) + (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (when (and visited-file (file-exists-p visited-file)) + (mapc (lambda (cell) (funcall update-templates cell)) + (list (cons "input-file" (file-name-nondirectory visited-file)) + (cons "modification-time" + (format "(eval (format-time-string \"$1\" '%s))" + (prin1-to-string + (nth 5 (file-attributes visited-file))))))))) + (setq org-macro-templates templates))) + +(defun org-macro-expand (macro templates) + "Return expanded MACRO, as a string. +MACRO is an object, obtained, for example, with +`org-element-context'. TEMPLATES is an alist of templates used +for expansion. See `org-macro-templates' for a buffer-local +default value. Return nil if no template was found." + (let ((template + ;; Macro names are case-insensitive. + (cdr (assoc-string (org-element-property :key macro) templates t)))) + (when template + (let ((value (replace-regexp-in-string + "\\$[0-9]+" + (lambda (arg) + (or (nth (1- (string-to-number (substring arg 1))) + (org-element-property :args macro)) + ;; No argument: remove place-holder. + "")) + template))) + ;; VALUE starts with "(eval": it is a s-exp, `eval' it. + (when (string-match "\\`(eval\\>" value) + (setq value (eval (read value)))) + ;; Return string. + (format "%s" (or value "")))))) + +(defun org-macro-replace-all (templates) + "Replace all macros in current buffer by their expansion. +TEMPLATES is an alist of templates used for expansion. See +`org-macro-templates' for a buffer-local default value." + (save-excursion + (goto-char (point-min)) + (let (record) + (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) + (let ((object (org-element-context))) + (when (eq (org-element-type object) 'macro) + (let* ((value (org-macro-expand object templates)) + (begin (org-element-property :begin object)) + (signature (list begin + object + (org-element-property :args object)))) + ;; Avoid circular dependencies by checking if the same + ;; macro with the same arguments is expanded at the same + ;; position twice. + (if (member signature record) + (error "Circular macro expansion: %s" + (org-element-property :key object)) + (when value + (push signature record) + (delete-region + begin + ;; Preserve white spaces after the macro. + (progn (goto-char (org-element-property :end object)) + (skip-chars-backward " \t") + (point))) + ;; Leave point before replacement in case of recursive + ;; expansions. + (save-excursion (insert value))))))))))) + + +(provide 'org-macro) +;;; org-macro.el ends here diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 57b2d8a57..cc837d0bb 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -63,14 +63,6 @@ `(interactive-p)))) (def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp))) -(when (and (not (fboundp 'with-silent-modifications)) - (or (< emacs-major-version 23) - (and (= emacs-major-version 23) - (< emacs-minor-version 2)))) - (defmacro with-silent-modifications (&rest body) - `(org-unmodified ,@body)) - (def-edebug-spec with-silent-modifications (body))) - (defmacro org-bound-and-true-p (var) "Return the value of symbol VAR if it is bound, else nil." `(and (boundp (quote ,var)) ,var)) @@ -87,16 +79,6 @@ Otherwise return nil." (and v (not (equal v "nil")) v)) -(defmacro org-unmodified (&rest body) - "Execute body without changing `buffer-modified-p'. -Also, do not record undo information." - `(set-buffer-modified-p - (prog1 (buffer-modified-p) - (let ((buffer-undo-list t) - (inhibit-modification-hooks t)) - ,@body)))) -(def-edebug-spec org-unmodified (body)) - (defun org-substitute-posix-classes (re) "Substitute posix classes in regular expression RE." (let ((ss re)) @@ -126,14 +108,18 @@ Also, do not record undo information." (org-move-to-column ,col))))) (def-edebug-spec org-preserve-lc (body)) -;; Copied from bookmark.el -(defmacro org-with-buffer-modified-unmodified (&rest body) +;; Use `org-with-silent-modifications' to ignore cosmetic changes and +;; `org-unmodified' to ignore real text modifications +(defmacro org-unmodified (&rest body) "Run BODY while preserving the buffer's `buffer-modified-p' state." (org-with-gensyms (was-modified) `(let ((,was-modified (buffer-modified-p))) (unwind-protect - (progn ,@body) - (set-buffer-modified-p ,was-modified))))) + (let ((buffer-undo-list t) + (inhibit-modification-hooks t)) + ,@body) + (set-buffer-modified-p ,was-modified))))) +(def-edebug-spec org-unmodified (body)) (defmacro org-without-partial-completion (&rest body) `(if (and (boundp 'partial-completion-mode) @@ -176,46 +162,17 @@ We use a macro so that the test can happen at compilation time." (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body)) (def-edebug-spec org-no-warnings (body)) -(defmacro org-if-unprotected (&rest body) - "Execute BODY if there is no `org-protected' text property at point." - `(unless (get-text-property (point) 'org-protected) - ,@body)) -(def-edebug-spec org-if-unprotected (body)) - -(defmacro org-if-unprotected-1 (&rest body) - "Execute BODY if there is no `org-protected' text property at point-1." - `(unless (get-text-property (1- (point)) 'org-protected) - ,@body)) -(def-edebug-spec org-if-unprotected-1 (body)) - -(defmacro org-if-unprotected-at (pos &rest body) - "Execute BODY if there is no `org-protected' text property at POS." - `(unless (get-text-property ,pos 'org-protected) - ,@body)) -(def-edebug-spec org-if-unprotected-at (form body)) -(put 'org-if-unprotected-at 'lisp-indent-function 1) - -(defun org-re-search-forward-unprotected (&rest args) - "Like re-search-forward, but stop only in unprotected places." - (catch 'exit - (while t - (unless (apply 're-search-forward args) - (throw 'exit nil)) - (unless (get-text-property (match-beginning 0) 'org-protected) - (throw 'exit (point)))))) - -;; FIXME: Normalize argument names -(defmacro org-with-remote-undo (_buffer &rest _body) +(defmacro org-with-remote-undo (buffer &rest body) "Execute BODY while recording undo information in two buffers." (org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2) `(let ((,cline (org-current-line)) (,cmd this-command) (,buf1 (current-buffer)) - (,buf2 ,_buffer) + (,buf2 ,buffer) (,undo1 buffer-undo-list) - (,undo2 (with-current-buffer ,_buffer buffer-undo-list)) + (,undo2 (with-current-buffer ,buffer buffer-undo-list)) ,c1 ,c2) - ,@_body + ,@body (when org-agenda-allow-remote-undo (setq ,c1 (org-verify-change-for-undo ,undo1 (with-current-buffer ,buf1 buffer-undo-list)) @@ -427,6 +384,13 @@ the value in cdr." (cons (list (car flat) (cadr flat)) (org-make-parameter-alist (cddr flat))))) +;;;###autoload +(defmacro org-load-noerror-mustsuffix (file) + "Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it." + (if (featurep 'xemacs) + `(load ,file 'noerror) + `(load ,file 'noerror nil nil 'mustsuffix))) + (provide 'org-macs) ;;; org-macs.el ends here diff --git a/lisp/org-mew.el b/lisp/org-mew.el deleted file mode 100644 index 820988bdb..000000000 --- a/lisp/org-mew.el +++ /dev/null @@ -1,136 +0,0 @@ -;;; org-mew.el --- Support for links to Mew messages from within Org-mode - -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. - -;; Author: Tokuya Kameshima -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file implements links to Mew messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org) - -(defgroup org-mew nil - "Options concerning the Mew link." - :tag "Org Startup" - :group 'org-link) - -(defcustom org-mew-link-to-refile-destination t - "Create a link to the refile destination if the message is marked as refile." - :group 'org-mew - :type 'boolean) - -;; Declare external functions and variables -(declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit)) -(declare-function mew-case-folder "ext:mew-func" (case folder)) -(declare-function mew-header-get-value "ext:mew-header" - (field &optional as-list)) -(declare-function mew-init "ext:mew" ()) -(declare-function mew-refile-get "ext:mew-refile" (msg)) -(declare-function mew-sinfo-get-case "ext:mew-summary" ()) -(declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay)) -(declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext)) -(declare-function mew-summary-get-mark "ext:mew-mark" ()) -(declare-function mew-summary-message-number2 "ext:mew-syntax" ()) -(declare-function mew-summary-pick-with-mewl "ext:mew-pick" - (pattern folder src-msgs)) -(declare-function mew-summary-search-msg "ext:mew-const" (msg)) -(declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg)) -(declare-function mew-summary-visit-folder "ext:mew-summary4" - (folder &optional goend no-ls)) -(declare-function mew-window-push "ext:mew" ()) -(defvar mew-init-p) -(defvar mew-summary-goto-line-then-display) - -;; Install the link type -(org-add-link-type "mew" 'org-mew-open) -(add-hook 'org-store-link-functions 'org-mew-store-link) - -;; Implementation -(defun org-mew-store-link () - "Store a link to a Mew folder or message." - (when (memq major-mode '(mew-summary-mode mew-virtual-mode)) - (let* ((msgnum (mew-summary-message-number2)) - (mark-info (mew-summary-get-mark)) - (folder-name - (if (and org-mew-link-to-refile-destination - (eq mark-info ?o)) ; marked as refile - (mew-case-folder (mew-sinfo-get-case) - (nth 1 (mew-refile-get msgnum))) - (mew-summary-folder-name))) - message-id from to subject desc link date date-ts date-ts-ia) - (save-window-excursion - (if (fboundp 'mew-summary-set-message-buffer) - (mew-summary-set-message-buffer folder-name msgnum) - (set-buffer (mew-cache-hit folder-name msgnum t))) - (setq message-id (mew-header-get-value "Message-Id:")) - (setq from (mew-header-get-value "From:")) - (setq to (mew-header-get-value "To:")) - (setq date (mew-header-get-value "Date:")) - (setq date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (setq date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) - (setq subject (mew-header-get-value "Subject:"))) - (org-store-link-props :type "mew" :from from :to to - :subject subject :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (setq message-id (org-remove-angle-brackets message-id)) - (setq desc (org-email-link-description)) - (setq link (concat "mew:" folder-name "#" message-id)) - (org-add-link-props :link link :description desc) - link))) - -(defun org-mew-open (path) - "Follow the Mew message link specified by PATH." - (let (folder msgnum) - (cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's - (setq folder (match-string 1 path)) - (setq msgnum (match-string 2 path))) - ((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path) - (setq folder (match-string 1 path)) - (setq msgnum (match-string 4 path))) - (t (error "Error in Mew link"))) - (require 'mew) - (mew-window-push) - (unless mew-init-p (mew-init)) - (mew-summary-visit-folder folder) - (when msgnum - (if (not (string-match "\\`[0-9]+\\'" msgnum)) - (let* ((pattern (concat "message-id=" msgnum)) - (msgs (mew-summary-pick-with-mewl pattern folder nil))) - (setq msgnum (car msgs)))) - (if (mew-summary-search-msg msgnum) - (if mew-summary-goto-line-then-display - (mew-summary-display)) - (error "Message not found"))))) - -(provide 'org-mew) - -;;; org-mew.el ends here diff --git a/lisp/org-mks.el b/lisp/org-mks.el deleted file mode 100644 index c614799db..000000000 --- a/lisp/org-mks.el +++ /dev/null @@ -1,134 +0,0 @@ -;;; org-mks.el --- Multi-key-selection for Org-mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;;; Commentary: -;; - -;;; Code: - -(require 'org) -(eval-when-compile - (require 'cl)) - -(defun org-mks (table title &optional prompt specials) - "Select a member of an alist with multiple keys. -TABLE is the alist which should contain entries where the car is a string. -There should be two types of entries. - -1. prefix descriptions like (\"a\" \"Description\") - This indicates that `a' is a prefix key for multi-letter selection, and - that there are entries following with keys like \"ab\", \"ax\"... - -2. Selectable members must have more than two elements, with the first - being the string of keys that lead to selecting it, and the second a - short description string of the item. - -The command will then make a temporary buffer listing all entries -that can be selected with a single key, and all the single key -prefixes. When you press the key for a single-letter entry, it is selected. -When you press a prefix key, the commands (and maybe further prefixes) -under this key will be shown and offered for selection. - -TITLE will be placed over the selection in the temporary buffer, -PROMPT will be used when prompting for a key. SPECIAL is an alist with -also (\"key\" \"description\") entries. When one of these is selection, -only the bare key is returned." - (setq prompt (or prompt "Select: ")) - (let (tbl orig-table dkey ddesc des-keys allowed-keys - current prefix rtn re pressed buffer (inhibit-quit t)) - (save-window-excursion - (setq buffer (org-switch-to-buffer-other-window "*Org Select*")) - (setq orig-table table) - (catch 'exit - (while t - (erase-buffer) - (insert title "\n\n") - (setq tbl table - des-keys nil - allowed-keys nil) - (setq prefix (if current (concat current " ") "")) - (while tbl - (cond - ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1)) - ;; This is a description on this level - (setq dkey (caar tbl) ddesc (cadar tbl)) - (pop tbl) - (push dkey des-keys) - (push dkey allowed-keys) - (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n") - ;; Skip keys which are below this prefix - (setq re (concat "\\`" (regexp-quote dkey))) - (while (and tbl (string-match re (caar tbl))) (pop tbl))) - ((= 2 (length (car tbl))) - ;; Not yet a usable description, skip it - ) - (t - ;; usable entry on this level - (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n") - (push (caar tbl) allowed-keys) - (pop tbl)))) - (when specials - (insert "-------------------------------------------------------------------------------\n") - (let ((sp specials)) - (while sp - (insert (format "[%s] %s\n" - (caar sp) (nth 1 (car sp)))) - (push (caar sp) allowed-keys) - (pop sp)))) - (push "\C-g" allowed-keys) - (goto-char (point-min)) - (if (not (pos-visible-in-window-p (point-max))) - (org-fit-window-to-buffer)) - (message prompt) - (setq pressed (char-to-string (read-char-exclusive))) - (while (not (member pressed allowed-keys)) - (message "Invalid key `%s'" pressed) (sit-for 1) - (message prompt) - (setq pressed (char-to-string (read-char-exclusive)))) - (when (equal pressed "\C-g") - (kill-buffer buffer) - (error "Abort")) - (when (and (not (assoc pressed table)) - (not (member pressed des-keys)) - (assoc pressed specials)) - (throw 'exit (setq rtn pressed))) - (unless (member pressed des-keys) - (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table)) - orig-table)))) - (setq current (concat current pressed)) - (setq table (mapcar - (lambda (x) - (if (and (> (length (car x)) 1) - (equal (substring (car x) 0 1) pressed)) - (cons (substring (car x) 1) (cdr x)) - nil)) - table)) - (setq table (remove nil table))))) - (when buffer (kill-buffer buffer)) - rtn)) - -(provide 'org-mks) - -;;; org-mks.el ends here diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index 2d976dd8a..7cdaf3445 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -76,6 +76,13 @@ org-agenda-text-search-extra-files :group 'org-mobile :type 'directory) +(defcustom org-mobile-allpriorities "A B C" + "Default set of priority cookies for the index file." + :version "24.4" + :package-version '(Org . "8.0") + :type 'string + :group 'org-mobile) + (defcustom org-mobile-use-encryption nil "Non-nil means keep only encrypted files on the WebDAV server. Encryption uses AES-256, with a password given in @@ -276,7 +283,7 @@ Also exclude files matching `org-mobile-files-exclude-regexp'." (list f)) (t nil))) org-mobile-files))) - (files (delete + (files (delq nil (mapcar (lambda (f) (unless (and (not (string= org-mobile-files-exclude-regexp "")) @@ -300,8 +307,6 @@ Also exclude files matching `org-mobile-files-exclude-regexp'." (push (cons file link-name) rtn))) (nreverse rtn))) -(defvar org-agenda-filter) - ;;;###autoload (defun org-mobile-push () "Push the current state of Org affairs to the target directory. @@ -463,7 +468,7 @@ agenda view showing the flagged items." (setq tags (append def-tags tags nil)) (insert "#+TAGS: " (mapconcat 'identity tags " ") "\n") (insert "#+DRAWERS: " (mapconcat 'identity drawers " ") "\n") - (insert "#+ALLPRIORITIES: A B C" "\n") + (insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n") (when (file-exists-p (expand-file-name org-mobile-directory "agendas.org")) (insert "* [[file:agendas.org][Agenda Views]]\n")) @@ -1061,13 +1066,13 @@ be returned that indicates what went wrong." (t (error "Heading changed in MobileOrg and on the computer"))))) ((eq what 'addheading) - (if (org-on-heading-p) ; if false we are in top-level of file + (if (org-at-heading-p) ; if false we are in top-level of file (progn ;; Workaround a `org-insert-heading-respect-content' bug ;; which prevents correct insertion when point is invisible (org-show-subtree) (end-of-line 1) - (org-insert-heading-respect-content t) + (org-insert-heading-respect-content '(16) t) (org-demote)) (beginning-of-line) (insert "* ")) @@ -1076,7 +1081,7 @@ be returned that indicates what went wrong." ((eq what 'refile) (org-copy-subtree) (org-with-point-at (org-mobile-locate-entry new) - (if (org-on-heading-p) ; if false we are in top-level of file + (if (org-at-heading-p) ; if false we are in top-level of file (progn (setq level (org-get-valid-level (funcall outline-level) 1)) (org-end-of-subtree t t) diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el index fac43e4bc..fbdc7fb85 100644 --- a/lisp/org-mouse.el +++ b/lisp/org-mouse.el @@ -1056,7 +1056,7 @@ This means, between the beginning of line and the point." ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)] "--" - ["Create iCalendar file" org-export-icalendar-combine-agenda-files t]) + ["Create iCalendar file" org-icalendar-combine-agenda-files t]) "--" ["Day View" org-agenda-day-view :active (org-agenda-check-type nil 'agenda) diff --git a/lisp/org-odt.el b/lisp/org-odt.el deleted file mode 100644 index 92228f37e..000000000 --- a/lisp/org-odt.el +++ /dev/null @@ -1,2859 +0,0 @@ -;;; org-odt.el --- OpenDocument Text exporter for Org-mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Jambunathan K -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;;; Code: -(eval-when-compile - (require 'cl)) -(require 'org-lparse) - -(defgroup org-export-odt nil - "Options specific for ODT export of Org-mode files." - :tag "Org Export ODT" - :group 'org-export - :version "24.1") - -(defvar org-lparse-dyn-first-heading-pos) ; let bound during org-do-lparse -(defun org-odt-insert-toc () - (goto-char (point-min)) - (cond - ((re-search-forward - "\\(]*>\\)?\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*\\(\\)?" - nil t) - (replace-match "")) - (t - (goto-char org-lparse-dyn-first-heading-pos))) - (insert (org-odt-format-toc))) - -(defun org-odt-end-export () - (org-odt-insert-toc) - (org-odt-fixup-label-references) - - ;; remove empty paragraphs - (goto-char (point-min)) - (while (re-search-forward - "[ \r\n\t]*" - nil t) - (replace-match "")) - (goto-char (point-min)) - - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end n) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq n (get-text-property beg 'org-whitespace) - end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (format "%s" - (make-string n ?x))))) - - ;; Remove empty lines at the beginning of the file. - (goto-char (point-min)) - (when (looking-at "\\s-+\n") (replace-match "")) - - ;; Remove display properties - (remove-text-properties (point-min) (point-max) '(display t))) - -(defvar org-odt-suppress-xref nil) -(defconst org-export-odt-special-string-regexps - '(("\\\\-" . "­\\1") ; shy - ("---\\([^-]\\)" . "—\\1") ; mdash - ("--\\([^-]\\)" . "–\\1") ; ndash - ("\\.\\.\\." . "…")) ; hellip - "Regular expressions for special string conversion.") - -(defconst org-odt-lib-dir (file-name-directory load-file-name) - "Location of ODT exporter. -Use this to infer values of `org-odt-styles-dir' and -`org-export-odt-schema-dir'.") - -(defvar org-odt-data-dir nil - "Data directory for ODT exporter. -Use this to infer values of `org-odt-styles-dir' and -`org-export-odt-schema-dir'.") - -(defconst org-odt-schema-dir-list - (list - (and org-odt-data-dir - (expand-file-name "./schema/" org-odt-data-dir)) ; bail out - (eval-when-compile - (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install - (expand-file-name "./schema/" org-odt-data-dir)))) - "List of directories to search for OpenDocument schema files. -Use this list to set the default value of -`org-export-odt-schema-dir'. The entries in this list are -populated heuristically based on the values of `org-odt-lib-dir' -and `org-odt-data-dir'.") - -(defcustom org-export-odt-schema-dir - (let* ((schema-dir - (catch 'schema-dir - (message "Debug (org-odt): Searching for OpenDocument schema files...") - (mapc - (lambda (schema-dir) - (when schema-dir - (message "Debug (org-odt): Trying %s..." schema-dir) - (when (and (file-readable-p - (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" - schema-dir)) - (file-readable-p - (expand-file-name "od-schema-v1.2-cs01.rnc" - schema-dir)) - (file-readable-p - (expand-file-name "schemas.xml" schema-dir))) - (message "Debug (org-odt): Using schema files under %s" - schema-dir) - (throw 'schema-dir schema-dir)))) - org-odt-schema-dir-list) - (message "Debug (org-odt): No OpenDocument schema files installed") - nil))) - schema-dir) - "Directory that contains OpenDocument schema files. - -This directory contains: -1. rnc files for OpenDocument schema -2. a \"schemas.xml\" file that specifies locating rules needed - for auto validation of OpenDocument XML files. - -Use the customize interface to set this variable. This ensures -that `rng-schema-locating-files' is updated and auto-validation -of OpenDocument XML takes place based on the value -`rng-nxml-auto-validate-flag'. - -The default value of this variable varies depending on the -version of org in use and is initialized from -`org-odt-schema-dir-list'. The OASIS schema files are available -only in the org's private git repository. It is *not* bundled -with GNU ELPA tar or standard Emacs distribution." - :type '(choice - (const :tag "Not set" nil) - (directory :tag "Schema directory")) - :group 'org-export-odt - :version "24.1" - :set - (lambda (var value) - "Set `org-export-odt-schema-dir'. -Also add it to `rng-schema-locating-files'." - (let ((schema-dir value)) - (set var - (if (and - (file-readable-p - (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" schema-dir)) - (file-readable-p - (expand-file-name "od-schema-v1.2-cs01.rnc" schema-dir)) - (file-readable-p - (expand-file-name "schemas.xml" schema-dir))) - schema-dir - (when value - (message "Error (org-odt): %s has no OpenDocument schema files" - value)) - nil))) - (when org-export-odt-schema-dir - (eval-after-load 'rng-loc - '(add-to-list 'rng-schema-locating-files - (expand-file-name "schemas.xml" - org-export-odt-schema-dir)))))) - -(defconst org-odt-styles-dir-list - (list - (and org-odt-data-dir - (expand-file-name "./styles/" org-odt-data-dir)) ; bail out - (eval-when-compile - (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install - (expand-file-name "./styles/" org-odt-data-dir))) - (expand-file-name "../etc/styles/" org-odt-lib-dir) ; git - (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa - (expand-file-name "./org/" data-directory) ; system - ) - "List of directories to search for OpenDocument styles files. -See `org-odt-styles-dir'. The entries in this list are populated -heuristically based on the values of `org-odt-lib-dir' and -`org-odt-data-dir'.") - -(defconst org-odt-styles-dir - (let* ((styles-dir - (catch 'styles-dir - (message "Debug (org-odt): Searching for OpenDocument styles files...") - (mapc (lambda (styles-dir) - (when styles-dir - (message "Debug (org-odt): Trying %s..." styles-dir) - (when (and (file-readable-p - (expand-file-name - "OrgOdtContentTemplate.xml" styles-dir)) - (file-readable-p - (expand-file-name - "OrgOdtStyles.xml" styles-dir))) - (message "Debug (org-odt): Using styles under %s" - styles-dir) - (throw 'styles-dir styles-dir)))) - org-odt-styles-dir-list) - nil))) - (unless styles-dir - (error "Error (org-odt): Cannot find factory styles files, aborting")) - styles-dir) - "Directory that holds auxiliary XML files used by the ODT exporter. - -This directory contains the following XML files - - \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These - XML files are used as the default values of - `org-export-odt-styles-file' and - `org-export-odt-content-template-file'. - -The default value of this variable varies depending on the -version of org in use and is initialized from -`org-odt-styles-dir-list'. Note that the user could be using org -from one of: org's own private git repository, GNU ELPA tar or -standard Emacs.") - -(defvar org-odt-file-extensions - '(("odt" . "OpenDocument Text") - ("ott" . "OpenDocument Text Template") - ("odm" . "OpenDocument Master Document") - ("ods" . "OpenDocument Spreadsheet") - ("ots" . "OpenDocument Spreadsheet Template") - ("odg" . "OpenDocument Drawing (Graphics)") - ("otg" . "OpenDocument Drawing Template") - ("odp" . "OpenDocument Presentation") - ("otp" . "OpenDocument Presentation Template") - ("odi" . "OpenDocument Image") - ("odf" . "OpenDocument Formula") - ("odc" . "OpenDocument Chart"))) - -(mapc - (lambda (desc) - ;; Let Emacs open all OpenDocument files in archive mode - (add-to-list 'auto-mode-alist - (cons (concat "\\." (car desc) "\\'") 'archive-mode))) - org-odt-file-extensions) - -;; register the odt exporter with the pre-processor -(add-to-list 'org-export-backends 'odt) - -;; register the odt exporter with org-lparse library -(org-lparse-register-backend 'odt) - -(defun org-odt-unload-function () - (org-lparse-unregister-backend 'odt) - (remove-hook 'org-export-preprocess-after-blockquote-hook - 'org-export-odt-preprocess-latex-fragments) - nil) - -(defcustom org-export-odt-content-template-file nil - "Template file for \"content.xml\". -The exporter embeds the exported content just before -\"\" element. - -If unspecified, the file named \"OrgOdtContentTemplate.xml\" -under `org-odt-styles-dir' is used." - :type 'file - :group 'org-export-odt - :version "24.1") - -(defcustom org-export-odt-styles-file nil - "Default styles file for use with ODT export. -Valid values are one of: -1. nil -2. path to a styles.xml file -3. path to a *.odt or a *.ott file -4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2 -...)) - -In case of option 1, an in-built styles.xml is used. See -`org-odt-styles-dir' for more information. - -In case of option 3, the specified file is unzipped and the -styles.xml embedded therein is used. - -In case of option 4, the specified ODT-OR-OTT-FILE is unzipped -and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the -generated odt file. Use relative path for specifying the -FILE-MEMBERS. styles.xml must be specified as one of the -FILE-MEMBERS. - -Use options 1, 2 or 3 only if styles.xml alone suffices for -achieving the desired formatting. Use option 4, if the styles.xml -references additional files like header and footer images for -achieving the desired formatting. - -Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on -a per-file basis. For example, - -#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or -#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))." - :group 'org-export-odt - :version "24.1" - :type - '(choice - (const :tag "Factory settings" nil) - (file :must-match t :tag "styles.xml") - (file :must-match t :tag "ODT or OTT file") - (list :tag "ODT or OTT file + Members" - (file :must-match t :tag "ODF Text or Text Template file") - (cons :tag "Members" - (file :tag " Member" "styles.xml") - (repeat (file :tag "Member")))))) - -(eval-after-load 'org-exp - '(add-to-list 'org-export-inbuffer-options-extra - '("ODT_STYLES_FILE" :odt-styles-file))) - -(defconst org-export-odt-tmpdir-prefix "%s-") -(defconst org-export-odt-bookmark-prefix "OrgXref.") -(defvar org-odt-zip-dir nil - "Temporary directory that holds XML files during export.") - -(defvar org-export-odt-embed-images t - "Should the images be copied in to the odt file or just linked?") - -(defvar org-export-odt-inline-images 'maybe) -(defcustom org-export-odt-inline-image-extensions - '("png" "jpeg" "jpg" "gif") - "Extensions of image files that can be inlined into HTML." - :type '(repeat (string :tag "Extension")) - :group 'org-export-odt - :version "24.1") - -(defcustom org-export-odt-pixels-per-inch display-pixels-per-inch - "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") - -(defcustom org-export-odt-create-custom-styles-for-srcblocks t - "Whether custom styles for colorized source blocks be automatically created. -When this option is turned on, the exporter creates custom styles -for source blocks based on the advice of `htmlfontify'. Creation -of custom styles happen as part of `org-odt-hfy-face-to-css'. - -When this option is turned off exporter does not create such -styles. - -Use the latter option if you do not want the custom styles to be -based on your current display settings. It is necessary that the -styles.xml already contains needed styles for colorizing to work. - -This variable is effective only if -`org-export-odt-fontify-srcblocks' is turned on." - :group 'org-export-odt - :version "24.1" - :type 'boolean) - -(defvar org-export-odt-default-org-styles-alist - '((paragraph . ((default . "Text_20_body") - (fixedwidth . "OrgFixedWidthBlock") - (verse . "OrgVerse") - (quote . "Quotations") - (blockquote . "Quotations") - (center . "OrgCenter") - (left . "OrgLeft") - (right . "OrgRight") - (title . "OrgTitle") - (subtitle . "OrgSubtitle") - (footnote . "Footnote") - (src . "OrgSrcBlock") - (illustration . "Illustration") - (table . "Table") - (definition-term . "Text_20_body_20_bold") - (horizontal-line . "Horizontal_20_Line"))) - (character . ((default . "Default") - (bold . "Bold") - (emphasis . "Emphasis") - (code . "OrgCode") - (verbatim . "OrgCode") - (strike . "Strikethrough") - (underline . "Underline") - (subscript . "OrgSubscript") - (superscript . "OrgSuperscript"))) - (list . ((ordered . "OrgNumberedList") - (unordered . "OrgBulletedList") - (description . "OrgDescriptionList")))) - "Default styles for various entities.") - -(defvar org-export-odt-org-styles-alist org-export-odt-default-org-styles-alist) -(defun org-odt-get-style-name-for-entity (category &optional entity) - (let ((entity (or entity 'default))) - (or - (cdr (assoc entity (cdr (assoc category - org-export-odt-org-styles-alist)))) - (cdr (assoc entity (cdr (assoc category - org-export-odt-default-org-styles-alist)))) - (error "Cannot determine style name for entity %s of type %s" - entity category)))) - -(defcustom org-export-odt-preferred-output-format nil - "Automatically post-process to this format after exporting to \"odt\". -Interactive commands `org-export-as-odt' and -`org-export-as-odt-and-open' export first to \"odt\" format and -then use `org-export-odt-convert-process' to convert the -resulting document to this format. During customization of this -variable, the list of valid values are populated based on -`org-export-odt-convert-capabilities'. - -You can set this option on per-file basis using file local -values. See Info node `(emacs) File Variables'." - :group 'org-export-odt - :version "24.1" - :type '(choice :convert-widget - (lambda (w) - (apply 'widget-convert (widget-type w) - (eval (car (widget-get w :args))))) - `((const :tag "None" nil) - ,@(mapcar (lambda (c) - `(const :tag ,c ,c)) - (org-lparse-reachable-formats "odt"))))) -;;;###autoload -(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp) - -(defmacro org-odt-cleanup-xml-buffers (&rest body) - `(let ((org-odt-zip-dir - (make-temp-file - (format org-export-odt-tmpdir-prefix "odf") t)) - (--cleanup-xml-buffers - (function - (lambda nil - (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml" - "meta.xml" "styles.xml"))) - ;; kill all xml buffers - (mapc (lambda (file) - (with-current-buffer - (find-file-noselect - (expand-file-name file org-odt-zip-dir) t) - (set-buffer-modified-p nil) - (kill-buffer))) - xml-files)) - ;; delete temporary directory. - (org-delete-directory org-odt-zip-dir t))))) - (condition-case err - (prog1 (progn ,@body) - (funcall --cleanup-xml-buffers)) - ((quit error) - (funcall --cleanup-xml-buffers) - (message "OpenDocument export failed: %s" - (error-message-string err)))))) - -;;;###autoload -(defun org-export-as-odt-and-open (arg) - "Export the outline as ODT and immediately open it with a browser. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted lists." - (interactive "P") - (org-odt-cleanup-xml-buffers - (org-lparse-and-open - (or org-export-odt-preferred-output-format "odt") "odt" arg))) - -;;;###autoload -(defun org-export-as-odt-batch () - "Call the function `org-lparse-batch'. -This function can be used in batch processing as: -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-export-as-odt-batch" - (org-odt-cleanup-xml-buffers (org-lparse-batch "odt"))) - -;;; org-export-as-odt -;;;###autoload -(defun org-export-as-odt (arg &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the outline as a OpenDocumentText file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted -lists. HIDDEN is obsolete and does nothing. -EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local -settings. When TO-BUFFER is non-nil, create a buffer with that -name and export to that buffer. If TO-BUFFER is the symbol -`string', don't leave any buffer behind but just return the -resulting XML as a string. When BODY-ONLY is set, don't produce -the file header and footer, simply return the content of -..., without even the body tags themselves. When -PUB-DIR is set, use this as the publishing directory." - (interactive "P") - (org-odt-cleanup-xml-buffers - (org-lparse (or org-export-odt-preferred-output-format "odt") - "odt" arg hidden ext-plist to-buffer body-only pub-dir))) - -(defvar org-odt-entity-control-callbacks-alist - `((EXPORT - . (org-odt-begin-export org-odt-end-export)) - (DOCUMENT-CONTENT - . (org-odt-begin-document-content org-odt-end-document-content)) - (DOCUMENT-BODY - . (org-odt-begin-document-body org-odt-end-document-body)) - (TOC - . (org-odt-begin-toc org-odt-end-toc)) - (ENVIRONMENT - . (org-odt-begin-environment org-odt-end-environment)) - (FOOTNOTE-DEFINITION - . (org-odt-begin-footnote-definition org-odt-end-footnote-definition)) - (TABLE - . (org-odt-begin-table org-odt-end-table)) - (TABLE-ROWGROUP - . (org-odt-begin-table-rowgroup org-odt-end-table-rowgroup)) - (LIST - . (org-odt-begin-list org-odt-end-list)) - (LIST-ITEM - . (org-odt-begin-list-item org-odt-end-list-item)) - (OUTLINE - . (org-odt-begin-outline org-odt-end-outline)) - (OUTLINE-TEXT - . (org-odt-begin-outline-text org-odt-end-outline-text)) - (PARAGRAPH - . (org-odt-begin-paragraph org-odt-end-paragraph))) - "") - -(defvar org-odt-entity-format-callbacks-alist - `((EXTRA-TARGETS . org-lparse-format-extra-targets) - (ORG-TAGS . org-lparse-format-org-tags) - (SECTION-NUMBER . org-lparse-format-section-number) - (HEADLINE . org-odt-format-headline) - (TOC-ENTRY . org-odt-format-toc-entry) - (TOC-ITEM . org-odt-format-toc-item) - (TAGS . org-odt-format-tags) - (SPACES . org-odt-format-spaces) - (TABS . org-odt-format-tabs) - (LINE-BREAK . org-odt-format-line-break) - (FONTIFY . org-odt-format-fontify) - (TODO . org-lparse-format-todo) - (LINK . org-odt-format-link) - (INLINE-IMAGE . org-odt-format-inline-image) - (ORG-LINK . org-odt-format-org-link) - (HEADING . org-odt-format-heading) - (ANCHOR . org-odt-format-anchor) - (TABLE . org-lparse-format-table) - (TABLE-ROW . org-odt-format-table-row) - (TABLE-CELL . org-odt-format-table-cell) - (FOOTNOTES-SECTION . ignore) - (FOOTNOTE-REFERENCE . org-odt-format-footnote-reference) - (HORIZONTAL-LINE . org-odt-format-horizontal-line) - (COMMENT . org-odt-format-comment) - (LINE . org-odt-format-line) - (ORG-ENTITY . org-odt-format-org-entity)) - "") - -;;;_. callbacks -;;;_. control callbacks -;;;_ , document body -(defun org-odt-begin-office-body () - ;; automatic styles - (insert-file-contents - (or org-export-odt-content-template-file - (expand-file-name "OrgOdtContentTemplate.xml" - org-odt-styles-dir))) - (goto-char (point-min)) - (re-search-forward "" nil nil) - (delete-region (match-beginning 0) (point-max))) - -;; Following variable is let bound when `org-do-lparse' is in -;; progress. See org-html.el. -(defvar org-lparse-toc) -(defun org-odt-format-toc () - (if (not org-lparse-toc) "" (concat "\n" org-lparse-toc "\n"))) - -(defun org-odt-format-preamble (opt-plist) - (let* ((title (plist-get opt-plist :title)) - (author (plist-get opt-plist :author)) - (date (plist-get opt-plist :date)) - (iso-date (org-odt-format-date date)) - (date (org-odt-format-date date "%d %b %Y")) - (email (plist-get opt-plist :email)) - ;; switch on or off above vars based on user settings - (author (and (plist-get opt-plist :author-info) (or author email))) - (email (and (plist-get opt-plist :email-info) email)) - (date (and (plist-get opt-plist :time-stamp-file) date))) - (concat - ;; title - (when title - (concat - (org-odt-format-stylized-paragraph - 'title (org-odt-format-tags - '("" . "") title)) - ;; separator - "")) - (cond - ((and author (not email)) - ;; author only - (concat - (org-odt-format-stylized-paragraph - 'subtitle - (org-odt-format-tags - '("" . "") - author)) - ;; separator - "")) - ((and author email) - ;; author and email - (concat - (org-odt-format-stylized-paragraph - 'subtitle - (org-odt-format-link - (org-odt-format-tags - '("" . "") - author) (concat "mailto:" email))) - ;; separator - ""))) - ;; date - (when date - (concat - (org-odt-format-stylized-paragraph - 'subtitle - (org-odt-format-tags - '("" - . "") date "N75" iso-date)) - ;; separator - ""))))) - -(defun org-odt-begin-document-body (opt-plist) - (org-odt-begin-office-body) - (insert (org-odt-format-preamble opt-plist)) - (setq org-lparse-dyn-first-heading-pos (point))) - -(defvar org-lparse-body-only) ; let bound during org-do-lparse -(defvar org-lparse-to-buffer) ; let bound during org-do-lparse -(defun org-odt-end-document-body (opt-plist) - (unless org-lparse-body-only - (org-lparse-insert-tag "") - (org-lparse-insert-tag ""))) - -(defun org-odt-begin-document-content (opt-plist) - (ignore)) - -(defun org-odt-end-document-content () - (org-lparse-insert-tag "")) - -(defun org-odt-begin-outline (level1 snumber title tags - target extra-targets class) - (org-lparse-insert - 'HEADING (org-lparse-format - 'HEADLINE title extra-targets tags snumber level1) - level1 target)) - -(defun org-odt-end-outline () - (ignore)) - -(defun org-odt-begin-outline-text (level1 snumber class) - (ignore)) - -(defun org-odt-end-outline-text () - (ignore)) - -(defun org-odt-begin-section (style &optional name) - (let ((default-name (car (org-odt-add-automatic-style "Section")))) - (org-lparse-insert-tag - "" - style (or name default-name)))) - -(defun org-odt-end-section () - (org-lparse-insert-tag "")) - -(defun org-odt-begin-paragraph (&optional style) - (org-lparse-insert-tag - "" (org-odt-get-extra-attrs-for-paragraph-style style))) - -(defun org-odt-end-paragraph () - (org-lparse-insert-tag "")) - -(defun org-odt-get-extra-attrs-for-paragraph-style (style) - (let (style-name) - (setq style-name - (cond - ((stringp style) style) - ((symbolp style) (org-odt-get-style-name-for-entity - 'paragraph style)))) - (unless style-name - (error "Don't know how to handle paragraph style %s" style)) - (format " text:style-name=\"%s\"" style-name))) - -(defun org-odt-format-stylized-paragraph (style text) - (org-odt-format-tags - '("" . "") text - (org-odt-get-extra-attrs-for-paragraph-style style))) - -(defvar org-lparse-opt-plist) ; bound during org-do-lparse -(defun org-odt-format-author (&optional author) - (when (setq author (or author (plist-get org-lparse-opt-plist :author))) - (org-odt-format-tags '("" . "") author))) - -(defun org-odt-format-date (&optional org-ts fmt) - (save-match-data - (let* ((time - (and (stringp org-ts) - (string-match org-ts-regexp0 org-ts) - (apply 'encode-time - (org-fix-decoded-time - (org-parse-time-string (match-string 0 org-ts) t))))) - date) - (cond - (fmt (format-time-string fmt time)) - (t (setq date (format-time-string "%Y-%m-%dT%H:%M:%S%z" time)) - (format "%s:%s" (substring date 0 -2) (substring date -2))))))) - -(defun org-odt-begin-annotation (&optional author date) - (org-lparse-insert-tag "") - (when (setq author (org-odt-format-author author)) - (insert author)) - (insert (org-odt-format-tags - '("" . "") - (org-odt-format-date - (or date (plist-get org-lparse-opt-plist :date))))) - (org-lparse-begin-paragraph)) - -(defun org-odt-end-annotation () - (org-lparse-insert-tag "")) - -(defun org-odt-begin-environment (style env-options-plist) - (case style - (annotation - (org-lparse-stash-save-paragraph-state) - (org-odt-begin-annotation (plist-get env-options-plist 'author) - (plist-get env-options-plist 'date))) - ((blockquote verse center quote) - (org-lparse-begin-paragraph style) - (list)) - ((fixedwidth native) - (org-lparse-end-paragraph) - (list)) - (t (error "Unknown environment %s" style)))) - -(defun org-odt-end-environment (style env-options-plist) - (case style - (annotation - (org-lparse-end-paragraph) - (org-odt-end-annotation) - (org-lparse-stash-pop-paragraph-state)) - ((blockquote verse center quote) - (org-lparse-end-paragraph) - (list)) - ((fixedwidth native) - (org-lparse-begin-paragraph) - (list)) - (t (error "Unknown environment %s" style)))) - -(defvar org-lparse-list-stack) ; dynamically bound in org-do-lparse -(defvar org-odt-list-stack-stashed) -(defun org-odt-begin-list (ltype) - (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype) - ltype)) - (let* ((style-name (org-odt-get-style-name-for-entity 'list ltype)) - (extra (concat (if (or org-lparse-list-table-p - (and (= 1 (length org-lparse-list-stack)) - (null org-odt-list-stack-stashed))) - " text:continue-numbering=\"false\"" - " text:continue-numbering=\"true\"") - (when style-name - (format " text:style-name=\"%s\"" style-name))))) - (case ltype - ((ordered unordered description) - (org-lparse-end-paragraph) - (org-lparse-insert-tag "" extra)) - (t (error "Unknown list type: %s" ltype))))) - -(defun org-odt-end-list (ltype) - (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype) - ltype)) - (if ltype - (org-lparse-insert-tag "") - (error "Unknown list type: %s" ltype))) - -(defun org-odt-begin-list-item (ltype &optional arg headline) - (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype) - ltype)) - (case ltype - (ordered - (assert (not headline) t) - (let* ((counter arg) (extra "")) - (org-lparse-insert-tag (if (= (length org-lparse-list-stack) - (length org-odt-list-stack-stashed)) - "" "")) - (org-lparse-begin-paragraph))) - (unordered - (let* ((id arg) (extra "")) - (org-lparse-insert-tag (if (= (length org-lparse-list-stack) - (length org-odt-list-stack-stashed)) - "" "")) - (org-lparse-begin-paragraph) - (insert (if headline (org-odt-format-target headline id) - (org-odt-format-bookmark "" id))))) - (description - (assert (not headline) t) - (let ((term (or arg "(no term)"))) - (insert - (org-odt-format-tags - '("" . "") - (org-odt-format-stylized-paragraph 'definition-term term))) - (org-lparse-begin-list-item 'unordered) - (org-lparse-begin-list 'description) - (org-lparse-begin-list-item 'unordered))) - (t (error "Unknown list type")))) - -(defun org-odt-end-list-item (ltype) - (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype) - ltype)) - (case ltype - ((ordered unordered) - (org-lparse-insert-tag (if (= (length org-lparse-list-stack) - (length org-odt-list-stack-stashed)) - (prog1 "" - (setq org-odt-list-stack-stashed nil)) - ""))) - (description - (org-lparse-end-list-item-1) - (org-lparse-end-list 'description) - (org-lparse-end-list-item-1)) - (t (error "Unknown list type")))) - -(defun org-odt-discontinue-list () - (let ((stashed-stack org-lparse-list-stack)) - (loop for list-type in stashed-stack - do (org-lparse-end-list-item-1 list-type) - (org-lparse-end-list list-type)) - (setq org-odt-list-stack-stashed stashed-stack))) - -(defun org-odt-continue-list () - (setq org-odt-list-stack-stashed (nreverse org-odt-list-stack-stashed)) - (loop for list-type in org-odt-list-stack-stashed - do (org-lparse-begin-list list-type) - (org-lparse-begin-list-item list-type))) - -;; Following variables are let bound when table emission is in -;; progress. See org-lparse.el. -(defvar org-lparse-table-begin-marker) -(defvar org-lparse-table-ncols) -(defvar org-lparse-table-rowgrp-open) -(defvar org-lparse-table-rownum) -(defvar org-lparse-table-cur-rowgrp-is-hdr) -(defvar org-lparse-table-is-styled) -(defvar org-lparse-table-rowgrp-info) -(defvar org-lparse-table-colalign-vector) - -(defvar org-odt-table-style nil - "Table style specified by \"#+ATTR_ODT: \" line. -This is set during `org-odt-begin-table'.") - -(defvar org-odt-table-style-spec nil - "Entry for `org-odt-table-style' in `org-export-odt-table-styles'.") - -(defcustom org-export-odt-table-styles - '(("OrgEquation" "OrgEquation" - ((use-first-column-styles . t) - (use-last-column-styles . t)))) - "Specify how Table Styles should be derived from a Table Template. -This is a list where each element is of the -form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS). - -TABLE-STYLE-NAME is the style associated with the table through -`org-odt-table-style'. - -TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic -TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined -below) that is included in -`org-export-odt-content-template-file'. - -TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + - \"TableCell\" -PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + - \"TableParagraph\" -TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" | - \"FirstRow\" | \"LastRow\" | - \"EvenRow\" | \"OddRow\" | - \"EvenColumn\" | \"OddColumn\" | \"\" -where \"+\" above denotes string concatenation. - -TABLE-CELL-OPTIONS is an alist where each element is of the -form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF). -TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' | - `use-last-row-styles' | - `use-first-column-styles' | - `use-last-column-styles' | - `use-banding-rows-styles' | - `use-banding-columns-styles' | - `use-first-row-styles' -ON-OR-OFF := `t' | `nil' - -For example, with the following configuration - -\(setq org-export-odt-table-styles - '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\" - \(\(use-first-row-styles . t\) - \(use-first-column-styles . t\)\)\) - \(\"TableWithHeaderColumns\" \"Custom\" - \(\(use-first-column-styles . t\)\)\)\)\) - -1. A table associated with \"TableWithHeaderRowsAndColumns\" - style will use the following table-cell styles - - \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\", - \"CustomTableCell\" and the following paragraph styles - \"CustomFirstRowTableParagraph\", - \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" - as appropriate. - -2. A table associated with \"TableWithHeaderColumns\" style will - use the following table-cell styles - - \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the - following paragraph styles - \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" - as appropriate.. - -Note that TABLE-TEMPLATE-NAME corresponds to the -\"\" elements contained within -\"\". The entries (TABLE-STYLE-NAME -TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to -\"table:template-name\" and \"table:use-first-row-styles\" etc -attributes of \"\" element. Refer ODF-1.2 -specification for more information. Also consult the -implementation filed under `org-odt-get-table-cell-styles'. - -The TABLE-STYLE-NAME \"OrgEquation\" is used internally for -formatting of numbered display equations. Do not delete this -style from the list." - :group 'org-export-odt - :version "24.1" - :type '(choice - (const :tag "None" nil) - (repeat :tag "Table Styles" - (list :tag "Table Style Specification" - (string :tag "Table Style Name") - (string :tag "Table Template Name") - (alist :options (use-first-row-styles - use-last-row-styles - use-first-column-styles - use-last-column-styles - use-banding-rows-styles - use-banding-columns-styles) - :key-type symbol - :value-type (const :tag "True" t)))))) - -(defvar org-odt-table-style-format - " - - - -" - "Template for auto-generated Table styles.") - -(defvar org-odt-automatic-styles '() - "Registry of automatic styles for various OBJECT-TYPEs. -The variable has the following form: -\(\(OBJECT-TYPE-A - \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\) - \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\) - \(OBJECT-TYPE-B - \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\) - \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\) - ...\). - -OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc. -OBJECT-PROPS is (typically) a plist created by passing -\"#+ATTR_ODT: \" option to `org-lparse-get-block-params'. - -Use `org-odt-add-automatic-style' to add update this variable.'") - -(defvar org-odt-object-counters nil - "Running counters for various OBJECT-TYPEs. -Use this to generate automatic names and style-names. See -`org-odt-add-automatic-style'.") - -(defun org-odt-write-automatic-styles () - "Write automatic styles to \"content.xml\"." - (with-current-buffer - (find-file-noselect (expand-file-name "content.xml") t) - ;; position the cursor - (goto-char (point-min)) - (re-search-forward " " nil t) - (goto-char (match-beginning 0)) - ;; write automatic table styles - (loop for (style-name props) in - (plist-get org-odt-automatic-styles 'Table) do - (when (setq props (or (plist-get props :rel-width) 96)) - (insert (format org-odt-table-style-format style-name props)))))) - -(defun org-odt-add-automatic-style (object-type &optional object-props) - "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS. -OBJECT-PROPS is (typically) a plist created by passing -\"#+ATTR_ODT: \" option of the object in question to -`org-lparse-get-block-params'. - -Use `org-odt-object-counters' to generate an automatic -OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a -new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME -. STYLE-NAME)." - (assert (stringp object-type)) - (let* ((object (intern object-type)) - (seqvar object) - (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0))) - (object-name (format "%s%d" object-type seqno)) style-name) - (setq org-odt-object-counters - (plist-put org-odt-object-counters seqvar seqno)) - (when object-props - (setq style-name (format "Org%s" object-name)) - (setq org-odt-automatic-styles - (plist-put org-odt-automatic-styles object - (append (list (list style-name object-props)) - (plist-get org-odt-automatic-styles object))))) - (cons object-name style-name))) - -(defvar org-odt-table-indentedp nil) -(defun org-odt-begin-table (caption label attributes short-caption) - (setq org-odt-table-indentedp (not (null org-lparse-list-stack))) - (when org-odt-table-indentedp - ;; Within the Org file, the table is appearing within a list item. - ;; OpenDocument doesn't allow table to appear within list items. - ;; Temporarily terminate the list, emit the table and then - ;; re-continue the list. - (org-odt-discontinue-list) - ;; Put the Table in an indented section. - (let ((level (length org-odt-list-stack-stashed))) - (org-odt-begin-section (format "OrgIndentedSection-Level-%d" level)))) - (setq attributes (org-lparse-get-block-params attributes)) - (setq org-odt-table-style (plist-get attributes :style)) - (setq org-odt-table-style-spec - (assoc org-odt-table-style org-export-odt-table-styles)) - (when (or label caption) - (insert - (org-odt-format-stylized-paragraph - 'table (org-odt-format-entity-caption label caption "__Table__")))) - (let ((automatic-name (org-odt-add-automatic-style "Table" attributes))) - (org-lparse-insert-tag - "" - (or short-caption (car automatic-name)) - (or (nth 1 org-odt-table-style-spec) - (cdr automatic-name) "OrgTable"))) - (setq org-lparse-table-begin-marker (point))) - -(defvar org-lparse-table-colalign-info) -(defun org-odt-end-table () - (goto-char org-lparse-table-begin-marker) - (loop for level from 0 below org-lparse-table-ncols - do (let* ((col-cookie (and org-lparse-table-is-styled - (cdr (assoc (1+ level) - org-lparse-table-colalign-info)))) - (extra-columns (or (nth 1 col-cookie) 0))) - (dotimes (i (1+ extra-columns)) - (insert - (org-odt-format-tags - "" - "" (or (nth 1 org-odt-table-style-spec) "OrgTable")))) - (insert "\n"))) - ;; fill style attributes for table cells - (when org-lparse-table-is-styled - (while (re-search-forward "@@\\(table-cell:p\\|table-cell:style-name\\)@@\\([0-9]+\\)@@\\([0-9]+\\)@@" nil t) - (let* ((spec (match-string 1)) - (r (string-to-number (match-string 2))) - (c (string-to-number (match-string 3))) - (cell-styles (org-odt-get-table-cell-styles - r c org-odt-table-style-spec)) - (table-cell-style (car cell-styles)) - (table-cell-paragraph-style (cdr cell-styles))) - (cond - ((equal spec "table-cell:p") - (replace-match table-cell-paragraph-style t t)) - ((equal spec "table-cell:style-name") - (replace-match table-cell-style t t)))))) - (goto-char (point-max)) - (org-lparse-insert-tag "") - (when org-odt-table-indentedp - (org-odt-end-section) - (org-odt-continue-list))) - -(defun org-odt-begin-table-rowgroup (&optional is-header-row) - (when org-lparse-table-rowgrp-open - (org-lparse-end 'TABLE-ROWGROUP)) - (org-lparse-insert-tag (if is-header-row - "" - "")) - (setq org-lparse-table-rowgrp-open t) - (setq org-lparse-table-cur-rowgrp-is-hdr is-header-row)) - -(defun org-odt-end-table-rowgroup () - (when org-lparse-table-rowgrp-open - (setq org-lparse-table-rowgrp-open nil) - (org-lparse-insert-tag - (if org-lparse-table-cur-rowgrp-is-hdr - "" "")))) - -(defun org-odt-format-table-row (row) - (org-odt-format-tags - '("" . "") row)) - -(defun org-odt-get-table-cell-styles (r c &optional style-spec) - "Retrieve styles applicable to a table cell. -R and C are (zero-based) row and column numbers of the table -cell. STYLE-SPEC is an entry in `org-export-odt-table-styles' -applicable to the current table. It is `nil' if the table is not -associated with any style attributes. - -Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME). - -When STYLE-SPEC is nil, style the table cell the conventional way -- choose cell borders based on row and column groupings and -choose paragraph alignment based on `org-col-cookies' text -property. See also -`org-odt-get-paragraph-style-cookie-for-table-cell'. - -When STYLE-SPEC is non-nil, ignore the above cookie and return -styles congruent with the ODF-1.2 specification." - (cond - (style-spec - - ;; LibreOffice - particularly the Writer - honors neither table - ;; templates nor custom table-cell styles. Inorder to retain - ;; inter-operability with LibreOffice, only automatic styles are - ;; used for styling of table-cells. The current implementation is - ;; congruent with ODF-1.2 specification and hence is - ;; future-compatible. - - ;; Additional Note: LibreOffice's AutoFormat facility for tables - - ;; which recognizes as many as 16 different cell types - is much - ;; richer. Unfortunately it is NOT amenable to easy configuration - ;; by hand. - - (let* ((template-name (nth 1 style-spec)) - (cell-style-selectors (nth 2 style-spec)) - (cell-type - (cond - ((and (cdr (assoc 'use-first-column-styles cell-style-selectors)) - (= c 0)) "FirstColumn") - ((and (cdr (assoc 'use-last-column-styles cell-style-selectors)) - (= c (1- org-lparse-table-ncols))) "LastColumn") - ((and (cdr (assoc 'use-first-row-styles cell-style-selectors)) - (= r 0)) "FirstRow") - ((and (cdr (assoc 'use-last-row-styles cell-style-selectors)) - (= r org-lparse-table-rownum)) - "LastRow") - ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) - (= (% r 2) 1)) "EvenRow") - ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) - (= (% r 2) 0)) "OddRow") - ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) - (= (% c 2) 1)) "EvenColumn") - ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) - (= (% c 2) 0)) "OddColumn") - (t "")))) - (cons - (concat template-name cell-type "TableCell") - (concat template-name cell-type "TableParagraph")))) - (t - (cons - (concat - "OrgTblCell" - (cond - ((= r 0) "T") - ((eq (cdr (assoc r org-lparse-table-rowgrp-info)) :start) "T") - (t "")) - (when (= r org-lparse-table-rownum) "B") - (cond - ((= c 0) "") - ((or (memq (nth c org-table-colgroup-info) '(:start :startend)) - (memq (nth (1- c) org-table-colgroup-info) '(:end :startend))) "L") - (t ""))) - (capitalize (aref org-lparse-table-colalign-vector c)))))) - -(defun org-odt-get-paragraph-style-cookie-for-table-cell (r c) - (concat - (and (not org-odt-table-style-spec) - (cond - (org-lparse-table-cur-rowgrp-is-hdr "OrgTableHeading") - ((and (= c 0) (org-lparse-get 'TABLE-FIRST-COLUMN-AS-LABELS)) - "OrgTableHeading") - (t "OrgTableContents"))) - (and org-lparse-table-is-styled - (format "@@table-cell:p@@%03d@@%03d@@" r c)))) - -(defun org-odt-get-style-name-cookie-for-table-cell (r c) - (when org-lparse-table-is-styled - (format "@@table-cell:style-name@@%03d@@%03d@@" r c))) - -(defun org-odt-format-table-cell (data r c horiz-span) - (concat - (let* ((paragraph-style-cookie - (org-odt-get-paragraph-style-cookie-for-table-cell r c)) - (style-name-cookie - (org-odt-get-style-name-cookie-for-table-cell r c)) - (extra (and style-name-cookie - (format " table:style-name=\"%s\"" style-name-cookie))) - (extra (concat extra - (and (> horiz-span 0) - (format " table:number-columns-spanned=\"%d\"" - (1+ horiz-span)))))) - (org-odt-format-tags - '("" . "") - (if org-lparse-list-table-p data - (org-odt-format-stylized-paragraph paragraph-style-cookie data)) extra)) - (let (s) - (dotimes (i horiz-span) - (setq s (concat s "\n"))) s) - "\n")) - -(defun org-odt-begin-footnote-definition (n) - (org-lparse-begin-paragraph 'footnote)) - -(defun org-odt-end-footnote-definition (n) - (org-lparse-end-paragraph)) - -(defun org-odt-begin-toc (lang-specific-heading max-level) - ;; Strings in `org-export-language-setup' can contain named html - ;; entities. Replace those with utf-8 equivalents. - (let ((i 0) entity rpl) - (while (string-match "&\\([^#].*?\\);" lang-specific-heading i) - (setq entity (match-string 1 lang-specific-heading)) - (if (not (setq rpl (org-entity-get-representation entity 'utf8))) - (setq i (match-end 0)) - (setq i (+ (match-beginning 0) (length rpl))) - (setq lang-specific-heading - (replace-match rpl t t lang-specific-heading))))) - (insert - (format " - - - %s -" max-level lang-specific-heading)) - (loop for level from 1 upto 10 - do (insert (format - " - - - - - - -" level level))) - - (insert - (format " - - - - - %s - -" lang-specific-heading))) - -(defun org-odt-end-toc () - (insert " - - -")) - -(defun org-odt-format-toc-entry (snumber todo headline tags href) - (setq headline (concat - (and org-export-with-section-numbers - (concat snumber ". ")) - headline - (and tags - (concat - (org-lparse-format 'SPACES 3) - (org-lparse-format 'FONTIFY tags "tag"))))) - (when todo - (setq headline (org-lparse-format 'FONTIFY headline "todo"))) - - (let ((org-odt-suppress-xref t)) - (org-odt-format-link headline (concat "#" href)))) - -(defun org-odt-format-toc-item (toc-entry level org-last-level) - (let ((style (format "Contents_20_%d" - (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1)))) - (insert "\n" (org-odt-format-stylized-paragraph style toc-entry) "\n"))) - -;; Following variable is let bound during 'ORG-LINK callback. See -;; org-html.el -(defvar org-lparse-link-description-is-image nil) -(defun org-odt-format-link (desc href &optional attr) - (cond - ((and (= (string-to-char href) ?#) (not org-odt-suppress-xref)) - (setq href (substring href 1)) - (let ((xref-format "text")) - (when (numberp desc) - (setq desc (format "%d" desc) xref-format "number")) - (when (listp desc) - (setq desc (mapconcat 'identity desc ".") xref-format "chapter")) - (setq href (concat org-export-odt-bookmark-prefix href)) - (org-odt-format-tags - '("" . - "") - desc xref-format href))) - (org-lparse-link-description-is-image - (org-odt-format-tags - '("" . "") - desc href (or attr ""))) - (t - (org-odt-format-tags - '("" . "") - desc href (or attr ""))))) - -(defun org-odt-format-spaces (n) - (cond - ((= n 1) " ") - ((> n 1) (concat - " " (org-odt-format-tags "" "" (1- n)))) - (t ""))) - -(defun org-odt-format-tabs (&optional n) - (let ((tab "") - (n (or n 1))) - (insert tab))) - -(defun org-odt-format-line-break () - (org-odt-format-tags "" "")) - -(defun org-odt-format-horizontal-line () - (org-odt-format-stylized-paragraph 'horizontal-line "")) - -(defun org-odt-encode-plain-text (line &optional no-whitespace-filling) - (setq line (org-xml-encode-plain-text line)) - (if no-whitespace-filling line - (org-odt-fill-tabs-and-spaces line))) - -(defun org-odt-format-line (line) - (case org-lparse-dyn-current-environment - (fixedwidth (concat - (org-odt-format-stylized-paragraph - 'fixedwidth (org-odt-encode-plain-text line)) "\n")) - (t (concat line "\n")))) - -(defun org-odt-format-comment (fmt &rest args) - (let ((comment (apply 'format fmt args))) - (format "\n\n" comment))) - -(defun org-odt-format-org-entity (wd) - (org-entity-get-representation wd 'utf8)) - -(defun org-odt-fill-tabs-and-spaces (line) - (replace-regexp-in-string - "\\([\t]\\|\\([ ]+\\)\\)" (lambda (s) - (cond - ((string= s "\t") (org-odt-format-tabs)) - (t (org-odt-format-spaces (length s))))) line)) - -(defcustom org-export-odt-fontify-srcblocks t - "Specify whether or not source blocks need to be fontified. -Turn this option on if you want to colorize the source code -blocks in the exported file. For colorization to work, you need -to make available an enhanced version of `htmlfontify' library." - :type 'boolean - :group 'org-export-odt - :version "24.1") - -(defun org-odt-format-source-line-with-line-number-and-label - (line rpllbl num fontifier par-style) - - (let ((keep-label (not (numberp rpllbl))) - (ref (org-find-text-property-in-string 'org-coderef line))) - (setq line (concat line (and keep-label ref (format "(%s)" ref)))) - (setq line (funcall fontifier line)) - (when ref - (setq line (org-odt-format-target line (concat "coderef-" ref)))) - (setq line (org-odt-format-stylized-paragraph par-style line)) - (if (not num) line - (org-odt-format-tags '("" . "") line)))) - -(defun org-odt-format-source-code-or-example-plain - (lines lang caption textareap cols rows num cont rpllbl fmt) - "Format source or example blocks much like fixedwidth blocks. -Use this when `org-export-odt-fontify-srcblocks' option is turned -off." - (let* ((lines (org-split-string lines "[\r\n]")) - (line-count (length lines)) - (i 0)) - (mapconcat - (lambda (line) - (incf i) - (org-odt-format-source-line-with-line-number-and-label - line rpllbl num 'org-odt-encode-plain-text - (if (= i line-count) "OrgFixedWidthBlockLastLine" - "OrgFixedWidthBlock"))) - lines "\n"))) - -(defvar org-src-block-paragraph-format - " - - - - - " - "Custom paragraph style for colorized source and example blocks. -This style is much the same as that of \"OrgFixedWidthBlock\" -except that the foreground and background colors are set -according to the default face identified by the `htmlfontify'.") - -(defvar hfy-optimisations) -(declare-function hfy-face-to-style "htmlfontify" (fn)) -(declare-function hfy-face-or-def-to-name "htmlfontify" (fn)) - -(defun org-odt-hfy-face-to-css (fn) - "Create custom style for face FN. -When FN is the default face, use it's foreground and background -properties to create \"OrgSrcBlock\" paragraph style. Otherwise -use it's color attribute to create a character style whose name -is obtained from FN. Currently all attributes of FN other than -color are ignored. - -The style name for a face FN is derived using the following -operations on the face name in that order - de-dash, CamelCase -and prefix with \"OrgSrc\". For example, -`font-lock-function-name-face' is associated with -\"OrgSrcFontLockFunctionNameFace\"." - (let* ((css-list (hfy-face-to-style fn)) - (style-name ((lambda (fn) - (concat "OrgSrc" - (mapconcat - 'capitalize (split-string - (hfy-face-or-def-to-name fn) "-") - ""))) fn)) - (color-val (cdr (assoc "color" css-list))) - (background-color-val (cdr (assoc "background" css-list))) - (style (and org-export-odt-create-custom-styles-for-srcblocks - (cond - ((eq fn 'default) - (format org-src-block-paragraph-format - background-color-val color-val)) - (t - (format - " - - - " style-name color-val)))))) - (cons style-name style))) - -(defun org-odt-insert-custom-styles-for-srcblocks (styles) - "Save STYLES used for colorizing of source blocks. -Update styles.xml with styles that were collected as part of -`org-odt-hfy-face-to-css' callbacks." - (when styles - (with-current-buffer - (find-file-noselect (expand-file-name "styles.xml") t) - (goto-char (point-min)) - (when (re-search-forward "" nil t) - (goto-char (match-beginning 0)) - (insert "\n\n" styles "\n"))))) - -(defun org-odt-format-source-code-or-example-colored - (lines lang caption textareap cols rows num cont rpllbl fmt) - "Format source or example blocks using `htmlfontify-string'. -Use this routine when `org-export-odt-fontify-srcblocks' option -is turned on." - (let* ((lang-m (and lang (or (cdr (assoc lang org-src-lang-modes)) lang))) - (mode (and lang-m (intern (concat (if (symbolp lang-m) - (symbol-name lang-m) - lang-m) "-mode")))) - (org-inhibit-startup t) - (org-startup-folded nil) - (lines (with-temp-buffer - (insert lines) - (if (functionp mode) (funcall mode) (fundamental-mode)) - (font-lock-fontify-buffer) - (buffer-string))) - (hfy-html-quote-regex "\\([<\"&> ]\\)") - (hfy-html-quote-map '(("\"" """) - ("<" "<") - ("&" "&") - (">" ">") - (" " "") - (" " ""))) - (hfy-face-to-css 'org-odt-hfy-face-to-css) - (hfy-optimisations-1 (copy-sequence hfy-optimisations)) - (hfy-optimisations (add-to-list 'hfy-optimisations-1 - 'body-text-only)) - (hfy-begin-span-handler - (lambda (style text-block text-id text-begins-block-p) - (insert (format "" style)))) - (hfy-end-span-handler (lambda nil (insert "")))) - (when (fboundp 'htmlfontify-string) - (let* ((lines (org-split-string lines "[\r\n]")) - (line-count (length lines)) - (i 0)) - (mapconcat - (lambda (line) - (incf i) - (org-odt-format-source-line-with-line-number-and-label - line rpllbl num 'htmlfontify-string - (if (= i line-count) "OrgSrcBlockLastLine" "OrgSrcBlock"))) - lines "\n"))))) - -(defun org-odt-format-source-code-or-example (lines lang caption textareap - cols rows num cont - rpllbl fmt) - "Format source or example blocks for export. -Use `org-odt-format-source-code-or-example-plain' or -`org-odt-format-source-code-or-example-colored' depending on the -value of `org-export-odt-fontify-srcblocks." - (setq lines (org-export-number-lines - lines 0 0 num cont rpllbl fmt 'preprocess) - lines (funcall - (or (and org-export-odt-fontify-srcblocks - (or (featurep 'htmlfontify) - ;; htmlfontify.el was introduced in Emacs 23.2 - ;; So load it with some caution - (require 'htmlfontify nil t)) - (fboundp 'htmlfontify-string) - 'org-odt-format-source-code-or-example-colored) - 'org-odt-format-source-code-or-example-plain) - lines lang caption textareap cols rows num cont rpllbl fmt)) - (if (not num) lines - (let ((extra (format " text:continue-numbering=\"%s\"" - (if cont "true" "false")))) - (org-odt-format-tags - '("" - . "") lines extra)))) - -(defun org-odt-remap-stylenames (style-name) - (or - (cdr (assoc style-name '(("timestamp-wrapper" . "OrgTimestampWrapper") - ("timestamp" . "OrgTimestamp") - ("timestamp-kwd" . "OrgTimestampKeyword") - ("tag" . "OrgTag") - ("todo" . "OrgTodo") - ("done" . "OrgDone") - ("target" . "OrgTarget")))) - style-name)) - -(defun org-odt-format-fontify (text style &optional id) - (let* ((style-name - (cond - ((stringp style) - (org-odt-remap-stylenames style)) - ((symbolp style) - (org-odt-get-style-name-for-entity 'character style)) - ((listp style) - (assert (< 1 (length style))) - (let ((parent-style (pop style))) - (mapconcat (lambda (s) - ;; (assert (stringp s) t) - (org-odt-remap-stylenames s)) style "") - (org-odt-remap-stylenames parent-style))) - (t (error "Don't how to handle style %s" style))))) - (org-odt-format-tags - '("" . "") - text style-name))) - -(defun org-odt-relocate-relative-path (path dir) - (if (file-name-absolute-p path) path - (file-relative-name (expand-file-name path dir) - (expand-file-name "eyecandy" dir)))) - -(defun org-odt-format-inline-image (thefile) - (let* ((thelink (if (file-name-absolute-p thefile) thefile - (org-xml-format-href - (org-odt-relocate-relative-path - thefile org-current-export-file)))) - (href - (org-odt-format-tags - "" "" - (if org-export-odt-embed-images - (org-odt-copy-image-file thefile) thelink)))) - (org-export-odt-format-image thefile href))) - -(defvar org-odt-entity-labels-alist nil - "Associate Labels with the Labeled entities. -Each element of the alist is of the form (LABEL-NAME -CATEGORY-NAME SEQNO LABEL-STYLE-NAME). LABEL-NAME is same as -that specified by \"#+LABEL: ...\" line. CATEGORY-NAME is the -type of the entity that LABEL-NAME is attached to. CATEGORY-NAME -can be one of \"Table\", \"Figure\" or \"Equation\". SEQNO is -the unique number assigned to the referenced entity on a -per-CATEGORY basis. It is generated sequentially and is 1-based. -LABEL-STYLE-NAME is a key `org-odt-label-styles'. - -See `org-odt-add-label-definition' and -`org-odt-fixup-label-references'.") - -(defun org-export-odt-format-formula (src href) - (save-match-data - (let* ((caption (org-find-text-property-in-string 'org-caption src)) - (short-caption - (or (org-find-text-property-in-string 'org-caption-shortn src) - caption)) - (caption (and caption (org-xml-format-desc caption))) - (short-caption (and short-caption - (org-xml-encode-plain-text short-caption))) - (label (org-find-text-property-in-string 'org-label src)) - (latex-frag (org-find-text-property-in-string 'org-latex-src src)) - (embed-as (or (and latex-frag - (org-find-text-property-in-string - 'org-latex-src-embed-type src)) - (if (or caption label) 'paragraph 'character))) - width height) - (when latex-frag - (setq href (org-propertize href :title "LaTeX Fragment" - :description latex-frag))) - (cond - ((eq embed-as 'character) - (org-odt-format-entity "InlineFormula" href width height)) - (t - (org-lparse-end-paragraph) - (org-lparse-insert-list-table - `((,(org-odt-format-entity - (if (not (or caption label)) "DisplayFormula" - "CaptionedDisplayFormula") - href width height :caption caption :label label - :short-caption short-caption) - ,(if (not (or caption label)) "" - (let* ((label-props (car org-odt-entity-labels-alist))) - (setcar (last label-props) "math-label") - (apply 'org-odt-format-label-definition - caption label-props))))) - nil nil nil ":style \"OrgEquation\"" nil '((1 "c" 8) (2 "c" 1))) - (throw 'nextline nil)))))) - -(defvar org-odt-embedded-formulas-count 0) -(defun org-odt-copy-formula-file (path) - "Returns the internal name of the file" - (let* ((src-file (expand-file-name - path (file-name-directory org-current-export-file))) - (target-dir (format "Formula-%04d/" - (incf org-odt-embedded-formulas-count))) - (target-file (concat target-dir "content.xml"))) - (when (not org-lparse-to-buffer) - (message "Embedding %s as %s ..." - (substring-no-properties path) target-file) - - (make-directory target-dir) - (org-odt-create-manifest-file-entry - "application/vnd.oasis.opendocument.formula" target-dir "1.2") - - (case (org-odt-is-formula-link-p src-file) - (mathml - (copy-file src-file target-file 'overwrite)) - (odf - (org-odt-zip-extract-one src-file "content.xml" target-dir)) - (t - (error "%s is not a formula file" src-file))) - - (org-odt-create-manifest-file-entry "text/xml" target-file)) - target-file)) - -(defun org-odt-format-inline-formula (thefile) - (let* ((thelink (if (file-name-absolute-p thefile) thefile - (org-xml-format-href - (org-odt-relocate-relative-path - thefile org-current-export-file)))) - (href - (org-odt-format-tags - "" "" - (file-name-directory (org-odt-copy-formula-file thefile))))) - (org-export-odt-format-formula thefile href))) - -(defun org-odt-is-formula-link-p (file) - (let ((case-fold-search nil)) - (cond - ((string-match "\\.\\(mathml\\|mml\\)\\'" file) - 'mathml) - ((string-match "\\.odf\\'" file) - 'odf)))) - -(defun org-odt-format-org-link (opt-plist type-1 path fragment desc attr - descp) - "Make a OpenDocument link. -OPT-PLIST is an options list. -TYPE-1 is the device-type of the link (THIS://foo.html). -PATH is the path of the link (http://THIS#location). -FRAGMENT is the fragment part of the link, if any (foo.html#THIS). -DESC is the link description, if any. -ATTR is a string of other attributes of the a element." - (declare (special org-lparse-par-open)) - (save-match-data - (let* ((may-inline-p - (and (member type-1 '("http" "https" "file")) - (org-lparse-should-inline-p path descp) - (not fragment))) - (type (if (equal type-1 "id") "file" type-1)) - (filename path) - (thefile path) - sec-frag sec-nos) - (cond - ;; check for inlined images - ((and (member type '("file")) - (not fragment) - (org-file-image-p - filename org-export-odt-inline-image-extensions) - (or (eq t org-export-odt-inline-images) - (and org-export-odt-inline-images (not descp)))) - (org-odt-format-inline-image thefile)) - ;; check for embedded formulas - ((and (member type '("file")) - (not fragment) - (org-odt-is-formula-link-p filename) - (or (not descp))) - (org-odt-format-inline-formula thefile)) - ;; code references - ((string= type "coderef") - (let* ((ref fragment) - (lineno-or-ref (cdr (assoc ref org-export-code-refs))) - (desc (and descp desc)) - (org-odt-suppress-xref nil) - (href (org-xml-format-href (concat "#coderef-" ref)))) - (cond - ((and (numberp lineno-or-ref) (not desc)) - (org-odt-format-link lineno-or-ref href)) - ((and (numberp lineno-or-ref) desc - (string-match (regexp-quote (concat "(" ref ")")) desc)) - (format (replace-match "%s" t t desc) - (org-odt-format-link lineno-or-ref href))) - (t - (setq desc (format - (if (and desc (string-match - (regexp-quote (concat "(" ref ")")) - desc)) - (replace-match "%s" t t desc) - (or desc "%s")) - lineno-or-ref)) - (org-odt-format-link (org-xml-format-desc desc) href))))) - ;; links to headlines - ((and (string= type "") - (or (not thefile) (string= thefile "")) - (plist-get org-lparse-opt-plist :section-numbers) - (get-text-property 0 'org-no-description fragment) - (setq sec-frag fragment) - (or (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag) - (and (setq sec-frag - (loop for alias in org-export-target-aliases do - (when (member fragment (cdr alias)) - (return (car alias))))) - (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag))) - (setq sec-nos (org-split-string (match-string 1 sec-frag) "-")) - (<= (length sec-nos) (plist-get org-lparse-opt-plist - :headline-levels))) - (let ((org-odt-suppress-xref nil)) - (org-odt-format-link sec-nos (concat "#" sec-frag) attr))) - (t - (when (string= type "file") - (setq thefile - (cond - ((file-name-absolute-p path) - (concat "file://" (expand-file-name path))) - (t (org-odt-relocate-relative-path - thefile org-current-export-file))))) - - (when (and (member type '("" "http" "https" "file")) fragment) - (setq thefile (concat thefile "#" fragment))) - - (setq thefile (org-xml-format-href thefile)) - - (when (not (member type '("" "file"))) - (setq thefile (concat type ":" thefile))) - - (let ((org-odt-suppress-xref - ;; Typeset link to headlines with description, as a - ;; regular hyperlink. - (and (string= type "") - (not (get-text-property 0 'org-no-description fragment))))) - (org-odt-format-link - (org-xml-format-desc desc) thefile attr))))))) - -(defun org-odt-format-heading (text level &optional id) - (let* ((text (if id (org-odt-format-target text id) text))) - (org-odt-format-tags - '("" . - "") text level level))) - -(defun org-odt-format-headline (title extra-targets tags - &optional snumber level) - (concat - (org-lparse-format 'EXTRA-TARGETS extra-targets) - - ;; No need to generate section numbers. They are auto-generated by - ;; the application - - ;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ") - title - (and tags (concat (org-lparse-format 'SPACES 3) - (org-lparse-format 'ORG-TAGS tags))))) - -(defun org-odt-format-anchor (text name &optional class) - (org-odt-format-target text name)) - -(defun org-odt-format-bookmark (text id) - (if id - (org-odt-format-tags "" text id) - text)) - -(defun org-odt-format-target (text id) - (let ((name (concat org-export-odt-bookmark-prefix id))) - (concat - (and id (org-odt-format-tags - "" "" name)) - (org-odt-format-bookmark text id) - (and id (org-odt-format-tags - "" "" name))))) - -(defun org-odt-format-footnote (n def) - (let ((id (concat "fn" n)) - (note-class "footnote") - (par-style "Footnote")) - (org-odt-format-tags - '("" . - "") - (concat - (org-odt-format-tags - '("" . "") - n) - (org-odt-format-tags - '("" . "") - def)) - id note-class))) - -(defun org-odt-format-footnote-reference (n def refcnt) - (if (= refcnt 1) - (org-odt-format-footnote n def) - (org-odt-format-footnote-ref n))) - -(defun org-odt-format-footnote-ref (n) - (let ((note-class "footnote") - (ref-format "text") - (ref-name (concat "fn" n))) - (org-odt-format-tags - '("" . "") - (org-odt-format-tags - '("" . "") - n note-class ref-format ref-name) - "OrgSuperscript"))) - -(defun org-odt-get-image-name (file-name) - (require 'sha1) - (file-relative-name - (expand-file-name - (concat (sha1 file-name) "." (file-name-extension file-name)) "Pictures"))) - -(defun org-export-odt-format-image (src href) - "Create image tag with source and attributes." - (save-match-data - (let* ((caption (org-find-text-property-in-string 'org-caption src)) - (short-caption - (or (org-find-text-property-in-string 'org-caption-shortn src) - caption)) - (caption (and caption (org-xml-format-desc caption))) - (short-caption (and short-caption - (org-xml-encode-plain-text short-caption))) - (attr (org-find-text-property-in-string 'org-attributes src)) - (label (org-find-text-property-in-string 'org-label src)) - (latex-frag (org-find-text-property-in-string - 'org-latex-src src)) - (category (and latex-frag "__DvipngImage__")) - (attr-plist (org-lparse-get-block-params attr)) - (user-frame-anchor - (car (assoc-string (plist-get attr-plist :anchor) - '(("as-char") ("paragraph") ("page")) t))) - (user-frame-style - (and user-frame-anchor (plist-get attr-plist :style))) - (user-frame-attrs - (and user-frame-anchor (plist-get attr-plist :attributes))) - (user-frame-params - (list user-frame-style user-frame-attrs user-frame-anchor)) - (embed-as (cond - (latex-frag - (symbol-name - (case (org-find-text-property-in-string - 'org-latex-src-embed-type src) - (paragraph 'paragraph) - (t 'as-char)))) - (user-frame-anchor) - (t "paragraph"))) - (size (org-odt-image-size-from-file - src (plist-get attr-plist :width) - (plist-get attr-plist :height) - (plist-get attr-plist :scale) nil embed-as)) - (width (car size)) (height (cdr size))) - (when latex-frag - (setq href (org-propertize href :title "LaTeX Fragment" - :description latex-frag))) - (let ((frame-style-handle (concat (and (or caption label) "Captioned") - embed-as "Image"))) - (org-odt-format-entity - frame-style-handle href width height - :caption caption :label label :category category - :short-caption short-caption - :user-frame-params user-frame-params))))) - -(defun org-odt-format-object-description (title description) - (concat (and title (org-odt-format-tags - '("" . "") - (org-odt-encode-plain-text title t))) - (and description (org-odt-format-tags - '("" . "") - (org-odt-encode-plain-text description t))))) - -(defun org-odt-format-frame (text width height style &optional - extra anchor-type) - (let ((frame-attrs - (concat - (if width (format " svg:width=\"%0.2fcm\"" width) "") - (if height (format " svg:height=\"%0.2fcm\"" height) "") - extra - (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph"))))) - (org-odt-format-tags - '("" . "") - (concat text (org-odt-format-object-description - (get-text-property 0 :title text) - (get-text-property 0 :description text))) - style frame-attrs))) - -(defun org-odt-format-textbox (text width height style &optional - extra anchor-type) - (org-odt-format-frame - (org-odt-format-tags - '("" . "") - text (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2)) - (unless width - (format " fo:min-width=\"%0.2fcm\"" (or width .2))))) - width nil style extra anchor-type)) - -(defun org-odt-format-inlinetask (heading content - &optional todo priority tags) - (org-odt-format-stylized-paragraph - nil (org-odt-format-textbox - (concat (org-odt-format-stylized-paragraph - "OrgInlineTaskHeading" - (org-lparse-format - 'HEADLINE (concat (org-lparse-format-todo todo) " " heading) - nil tags)) - content) nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\""))) - -(defvar org-odt-entity-frame-styles - '(("As-CharImage" "__Figure__" ("OrgInlineImage" nil "as-char")) - ("ParagraphImage" "__Figure__" ("OrgDisplayImage" nil "paragraph")) - ("PageImage" "__Figure__" ("OrgPageImage" nil "page")) - ("CaptionedAs-CharImage" "__Figure__" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgInlineImage" nil "as-char")) - ("CaptionedParagraphImage" "__Figure__" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgImageCaptionFrame" nil "paragraph")) - ("CaptionedPageImage" "__Figure__" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgPageImageCaptionFrame" nil "page")) - ("InlineFormula" "__MathFormula__" ("OrgInlineFormula" nil "as-char")) - ("DisplayFormula" "__MathFormula__" ("OrgDisplayFormula" nil "as-char")) - ("CaptionedDisplayFormula" "__MathFormula__" - ("OrgCaptionedFormula" nil "paragraph") - ("OrgFormulaCaptionFrame" nil "as-char")))) - -(defun org-odt-merge-frame-params(default-frame-params user-frame-params) - (if (not user-frame-params) default-frame-params - (assert (= (length default-frame-params) 3)) - (assert (= (length user-frame-params) 3)) - (loop for user-frame-param in user-frame-params - for default-frame-param in default-frame-params - collect (or user-frame-param default-frame-param)))) - -(defun* org-odt-format-entity (entity href width height - &key caption label category - user-frame-params short-caption) - (let* ((entity-style (assoc-string entity org-odt-entity-frame-styles t)) - default-frame-params frame-params) - (cond - ((not (or caption label)) - (setq default-frame-params (nth 2 entity-style)) - (setq frame-params (org-odt-merge-frame-params - default-frame-params user-frame-params)) - (apply 'org-odt-format-frame href width height frame-params)) - (t - (setq default-frame-params (nth 3 entity-style)) - (setq frame-params (org-odt-merge-frame-params - default-frame-params user-frame-params)) - (apply 'org-odt-format-textbox - (org-odt-format-stylized-paragraph - 'illustration - (concat - (apply 'org-odt-format-frame href width height - (let ((entity-style-1 (copy-sequence - (nth 2 entity-style)))) - (setcar (cdr entity-style-1) - (concat - (cadr entity-style-1) - (and short-caption - (format " draw:name=\"%s\" " - short-caption)))) - - entity-style-1)) - (org-odt-format-entity-caption - label caption (or category (nth 1 entity-style))))) - width height frame-params))))) - -(defvar org-odt-embedded-images-count 0) -(defun org-odt-copy-image-file (path) - "Returns the internal name of the file" - (let* ((image-type (file-name-extension path)) - (media-type (format "image/%s" image-type)) - (src-file (expand-file-name - path (file-name-directory org-current-export-file))) - (target-dir "Images/") - (target-file - (format "%s%04d.%s" target-dir - (incf org-odt-embedded-images-count) image-type))) - (when (not org-lparse-to-buffer) - (message "Embedding %s as %s ..." - (substring-no-properties path) target-file) - - (when (= 1 org-odt-embedded-images-count) - (make-directory target-dir) - (org-odt-create-manifest-file-entry "" target-dir)) - - (copy-file src-file target-file 'overwrite) - (org-odt-create-manifest-file-entry media-type target-file)) - target-file)) - -(defvar org-export-odt-image-size-probe-method - (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675 - '(emacs fixed)) - "Ordered list of methods for determining image sizes.") - -(defvar org-export-odt-default-image-sizes-alist - '(("as-char" . (5 . 0.4)) - ("paragraph" . (5 . 5))) - "Hardcoded image dimensions one for each of the anchor - methods.") - -;; A4 page size is 21.0 by 29.7 cms -;; The default page settings has 2cm margin on each of the sides. So -;; the effective text area is 17.0 by 25.7 cm -(defvar org-export-odt-max-image-size '(17.0 . 20.0) - "Limiting dimensions for an embedded image.") - -(defun org-odt-do-image-size (probe-method file &optional dpi anchor-type) - (let* ((dpi (or dpi org-export-odt-pixels-per-inch)) - (anchor-type (or anchor-type "paragraph")) - (--pixels-to-cms - (function - (lambda (pixels dpi) - (let* ((cms-per-inch 2.54) - (inches (/ pixels dpi))) - (* cms-per-inch inches))))) - (--size-in-cms - (function - (lambda (size-in-pixels dpi) - (and size-in-pixels - (cons (funcall --pixels-to-cms (car size-in-pixels) dpi) - (funcall --pixels-to-cms (cdr size-in-pixels) dpi))))))) - (case probe-method - (emacs - (let ((size-in-pixels - (ignore-errors ; Emacs could be in batch mode - (clear-image-cache) - (image-size (create-image file) 'pixels)))) - (funcall --size-in-cms size-in-pixels dpi))) - (imagemagick - (let ((size-in-pixels - (let ((dim (shell-command-to-string - (format "identify -format \"%%w:%%h\" \"%s\"" file)))) - (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim) - (cons (string-to-number (match-string 1 dim)) - (string-to-number (match-string 2 dim))))))) - (funcall --size-in-cms size-in-pixels dpi))) - (t (cdr (assoc-string anchor-type - org-export-odt-default-image-sizes-alist)))))) - -(defun org-odt-image-size-from-file (file &optional user-width - user-height scale dpi embed-as) - (unless (file-name-absolute-p file) - (setq file (expand-file-name - file (file-name-directory org-current-export-file)))) - (let* (size width height) - (unless (and user-height user-width) - (loop for probe-method in org-export-odt-image-size-probe-method - until size - do (setq size (org-odt-do-image-size - probe-method file dpi embed-as))) - (or size (error "Cannot determine image size, aborting")) - (setq width (car size) height (cdr size))) - (cond - (scale - (setq width (* width scale) height (* height scale))) - ((and user-height user-width) - (setq width user-width height user-height)) - (user-height - (setq width (* user-height (/ width height)) height user-height)) - (user-width - (setq height (* user-width (/ height width)) width user-width)) - (t (ignore))) - ;; ensure that an embedded image fits comfortably within a page - (let ((max-width (car org-export-odt-max-image-size)) - (max-height (cdr org-export-odt-max-image-size))) - (when (or (> width max-width) (> height max-height)) - (let* ((scale1 (/ max-width width)) - (scale2 (/ max-height height)) - (scale (min scale1 scale2))) - (setq width (* scale width) height (* scale height))))) - (cons width height))) - -(defvar org-odt-entity-counts-plist nil - "Plist of running counters of SEQNOs for each of the CATEGORY-NAMEs. -See `org-odt-entity-labels-alist' for known CATEGORY-NAMEs.") - -(defvar org-odt-label-styles - '(("math-formula" "%c" "text" "(%n)") - ("math-label" "(%n)" "text" "(%n)") - ("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 -\" SEQNO \". %c is replaced -with CAPTION. See `org-odt-format-label-definition'. - -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 -specifiers - %e and %n. %e is replaced with the CATEGORY-NAME. -%n is replaced with SEQNO. See -`org-odt-format-label-reference'.") - -(defcustom org-export-odt-category-strings - '(("en" "Table" "Figure" "Equation" "Equation")) - "Specify category strings for various captionable entities. -Captionable entity can be one of a Table, an Embedded Image, a -LaTeX fragment (generated with dvipng) or a Math Formula. - -For example, when `org-export-default-language' is \"en\", an -embedded image will be captioned as \"Figure 1: Orgmode Logo\". -If you want the images to be captioned instead as \"Illustration -1: Orgmode Logo\", then modify the entry for \"en\" as shown -below. - - \(setq org-export-odt-category-strings - '\(\(\"en\" \"Table\" \"Illustration\" - \"Equation\" \"Equation\"\)\)\)" - :group 'org-export-odt - :version "24.1" - :type '(repeat (list (string :tag "Language tag") - (choice :tag "Table" - (const :tag "Use Default" nil) - (string :tag "Category string")) - (choice :tag "Figure" - (const :tag "Use Default" nil) - (string :tag "Category string")) - (choice :tag "Math Formula" - (const :tag "Use Default" nil) - (string :tag "Category string")) - (choice :tag "Dvipng Image" - (const :tag "Use Default" nil) - (string :tag "Category string"))))) - -(defvar org-odt-category-map-alist - '(("__Table__" "Table" "value") - ("__Figure__" "Illustration" "value") - ("__MathFormula__" "Text" "math-formula") - ("__DvipngImage__" "Equation" "value") - ;; ("__Table__" "Table" "category-and-value") - ;; ("__Figure__" "Figure" "category-and-value") - ;; ("__DvipngImage__" "Equation" "category-and-value") - ) - "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_HANDLE identifies the -captionable entity in question. OD-VARIABLE is the OpenDocument -sequence counter associated with the entity. These counters are -declared within -\"...\" block of -`org-export-odt-content-template-file'. LABEL-STYLE is a key -into `org-odt-label-styles' and specifies how a given entity -should be captioned and referenced. - -The position of a CATEGORY-HANDLE in this list is used as an -index in to per-language entry for -`org-export-odt-category-strings' to retrieve a CATEGORY-NAME. -This CATEGORY-NAME is then used for qualifying the user-specified -captions on export.") - -(defun org-odt-add-label-definition (label default-category) - "Create an entry in `org-odt-entity-labels-alist' and return it." - (let* ((label-props (assoc default-category org-odt-category-map-alist)) - ;; identify the sequence number - (counter (nth 1 label-props)) - (sequence-var (intern counter)) - (seqno (1+ (or (plist-get org-odt-entity-counts-plist sequence-var) - 0))) - ;; assign an internal label, if user has not provided one - (label (if label (substring-no-properties label) - (format "%s-%s" default-category seqno))) - ;; identify label style - (label-style (nth 2 label-props)) - ;; grok language setting - (en-strings (assoc-default "en" org-export-odt-category-strings)) - (lang (plist-get org-lparse-opt-plist :language)) - (lang-strings (assoc-default lang org-export-odt-category-strings)) - ;; retrieve localized category sting - (pos (- (length org-odt-category-map-alist) - (length (memq label-props org-odt-category-map-alist)))) - (category (or (nth pos lang-strings) (nth pos en-strings))) - (label-props (list label category counter seqno label-style))) - ;; synchronize internal counters - (setq org-odt-entity-counts-plist - (plist-put org-odt-entity-counts-plist sequence-var seqno)) - ;; stash label properties for later retrieval - (push label-props org-odt-entity-labels-alist) - label-props)) - -(defun org-odt-format-label-definition (caption label category counter - seqno label-style) - (assert label) - (format-spec - (cadr (assoc-string label-style org-odt-label-styles t)) - `((?e . ,category) - (?n . ,(org-odt-format-tags - '("" . "") - (format "%d" seqno) label counter counter)) - (?c . ,(or caption ""))))) - -(defun org-odt-format-label-reference (label category counter - seqno label-style) - (assert label) - (save-match-data - (let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t))) - (fmt1 (car fmt)) - (fmt2 (cadr fmt))) - (org-odt-format-tags - '("" - . "") - (format-spec fmt2 `((?e . ,category) - (?n . ,(format "%d" seqno)))) fmt1 label)))) - -(defun org-odt-fixup-label-references () - (goto-char (point-min)) - (while (re-search-forward - "[ \t\n]*" - nil t) - (let* ((label (match-string 1)) - (label-def (assoc label org-odt-entity-labels-alist)) - (rpl (and label-def - (apply 'org-odt-format-label-reference label-def)))) - (if rpl (replace-match rpl t t) - (org-lparse-warn - (format "Unable to resolve reference to label \"%s\"" label)))))) - -(defun org-odt-format-entity-caption (label caption category) - (if (not (or label caption)) "" - (apply 'org-odt-format-label-definition caption - (org-odt-add-label-definition label category)))) - -(defun org-odt-format-tags (tag text &rest args) - (let ((prefix (when org-lparse-encode-pending "@")) - (suffix (when org-lparse-encode-pending "@"))) - (apply 'org-lparse-format-tags tag text prefix suffix args))) - -(defvar org-odt-manifest-file-entries nil) -(defun org-odt-init-outfile (filename) - (unless (executable-find "zip") - ;; Not at all OSes ship with zip by default - (error "Executable \"zip\" needed for creating OpenDocument files")) - - (let* ((content-file (expand-file-name "content.xml" org-odt-zip-dir))) - ;; init conten.xml - (require 'nxml-mode) - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect content-file t)) - - ;; reset variables - (setq org-odt-manifest-file-entries nil - org-odt-embedded-images-count 0 - org-odt-embedded-formulas-count 0 - org-odt-entity-labels-alist nil - org-odt-list-stack-stashed nil - org-odt-automatic-styles nil - org-odt-object-counters nil - org-odt-entity-counts-plist nil) - content-file)) - -(defcustom org-export-odt-prettify-xml nil - "Specify whether or not the xml output should be prettified. -When this option is turned on, `indent-region' is run on all -component xml buffers before they are saved. Turn this off for -regular use. Turn this on if you need to examine the xml -visually." - :group 'org-export-odt - :version "24.1" - :type 'boolean) - -(defvar hfy-user-sheet-assoc) ; bound during org-do-lparse -(defun org-odt-save-as-outfile (target opt-plist) - ;; write automatic styles - (org-odt-write-automatic-styles) - - ;; write meta file - (org-odt-update-meta-file opt-plist) - - ;; write styles file - (when (equal org-lparse-backend 'odt) - (org-odt-update-styles-file opt-plist)) - - ;; create mimetype file - (let ((mimetype (org-odt-write-mimetype-file org-lparse-backend))) - (org-odt-create-manifest-file-entry mimetype "/" "1.2")) - - ;; create a manifest entry for content.xml - (org-odt-create-manifest-file-entry "text/xml" "content.xml") - - ;; write out the manifest entries before zipping - (org-odt-write-manifest-file) - - (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml" - "meta.xml"))) - (when (equal org-lparse-backend 'odt) - (push "styles.xml" xml-files)) - - ;; save all xml files - (mapc (lambda (file) - (with-current-buffer - (find-file-noselect (expand-file-name file) t) - ;; prettify output if needed - (when org-export-odt-prettify-xml - (indent-region (point-min) (point-max))) - (save-buffer 0))) - xml-files) - - (let* ((target-name (file-name-nondirectory target)) - (target-dir (file-name-directory target)) - (cmds `(("zip" "-mX0" ,target-name "mimetype") - ("zip" "-rmTq" ,target-name ".")))) - (when (file-exists-p target) - ;; FIXME: If the file is locked this throws a cryptic error - (delete-file target)) - - (let ((coding-system-for-write 'no-conversion) exitcode err-string) - (message "Creating odt file...") - (mapc - (lambda (cmd) - (message "Running %s" (mapconcat 'identity cmd " ")) - (setq err-string - (with-output-to-string - (setq exitcode - (apply 'call-process (car cmd) - nil standard-output nil (cdr cmd))))) - (or (zerop exitcode) - (ignore (message "%s" err-string)) - (error "Unable to create odt file (%S)" exitcode))) - cmds)) - - ;; move the file from outdir to target-dir - (rename-file target-name target-dir))) - - (message "Created %s" target) - (set-buffer (find-file-noselect target t))) - -(defconst org-odt-manifest-file-entry-tag - " -") - -(defun org-odt-create-manifest-file-entry (&rest args) - (push args org-odt-manifest-file-entries)) - -(defun org-odt-write-manifest-file () - (make-directory "META-INF") - (let ((manifest-file (expand-file-name "META-INF/manifest.xml"))) - (with-current-buffer - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect manifest-file t)) - (insert - " - \n") - (mapc - (lambda (file-entry) - (let* ((version (nth 2 file-entry)) - (extra (if version - (format " manifest:version=\"%s\"" version) - ""))) - (insert - (format org-odt-manifest-file-entry-tag - (nth 0 file-entry) (nth 1 file-entry) extra)))) - org-odt-manifest-file-entries) - (insert "\n")))) - -(defun org-odt-update-meta-file (opt-plist) - (let ((date (org-odt-format-date (plist-get opt-plist :date))) - (author (or (plist-get opt-plist :author) "")) - (email (plist-get opt-plist :email)) - (keywords (plist-get opt-plist :keywords)) - (description (plist-get opt-plist :description)) - (title (plist-get opt-plist :title))) - (write-region - (concat - " - - " "\n" - (org-odt-format-author) - (org-odt-format-tags - '("\n" . "") author) - (org-odt-format-tags '("\n" . "") date) - (org-odt-format-tags - '("\n" . "") date) - (org-odt-format-tags '("\n" . "") - (when org-export-creator-info - (format "Org-%s/Emacs-%s" - (org-version) - emacs-version))) - (org-odt-format-tags '("\n" . "") keywords) - (org-odt-format-tags '("\n" . "") description) - (org-odt-format-tags '("\n" . "") title) - "\n" - " " "") - nil (expand-file-name "meta.xml"))) - - ;; create a manifest entry for meta.xml - (org-odt-create-manifest-file-entry "text/xml" "meta.xml")) - -(defun org-odt-update-styles-file (opt-plist) - ;; write styles file - (let ((styles-file (plist-get opt-plist :odt-styles-file))) - (org-odt-copy-styles-file (and styles-file - (read (org-trim styles-file))))) - - ;; Update styles.xml - take care of outline numbering - (with-current-buffer - (find-file-noselect (expand-file-name "styles.xml") t) - ;; Don't make automatic backup of styles.xml file. This setting - ;; prevents the backed-up styles.xml file from being zipped in to - ;; odt file. This is more of a hackish fix. Better alternative - ;; would be to fix the zip command so that the output odt file - ;; includes only the needed files and excludes any auto-generated - ;; extra files like backups and auto-saves etc etc. Note that - ;; currently the zip command zips up the entire temp directory so - ;; that any auto-generated files created under the hood ends up in - ;; the resulting odt file. - (set (make-local-variable 'backup-inhibited) t) - - ;; Import local setting of `org-export-with-section-numbers' - (org-lparse-bind-local-variables opt-plist) - (org-odt-configure-outline-numbering - (if org-export-with-section-numbers org-export-headline-levels 0))) - - ;; Write custom styles for source blocks - (org-odt-insert-custom-styles-for-srcblocks - (mapconcat - (lambda (style) - (format " %s\n" (cddr style))) - hfy-user-sheet-assoc ""))) - -(defun org-odt-write-mimetype-file (format) - ;; create mimetype file - (let ((mimetype - (case format - (odt "application/vnd.oasis.opendocument.text") - (odf "application/vnd.oasis.opendocument.formula") - (t (error "Unknown OpenDocument backend %S" org-lparse-backend))))) - (write-region mimetype nil (expand-file-name "mimetype")) - mimetype)) - -(defun org-odt-finalize-outfile () - (org-odt-delete-empty-paragraphs)) - -(defun org-odt-delete-empty-paragraphs () - (goto-char (point-min)) - (let ((open "]*>") - (close "")) - (while (re-search-forward (format "%s[ \r\n\t]*%s" open close) nil t) - (replace-match "")))) - -(defcustom org-export-odt-convert-processes - '(("LibreOffice" - "soffice --headless --convert-to %f%x --outdir %d %i") - ("unoconv" - "unoconv -f %f -o %d %i")) - "Specify a list of document converters and their usage. -The converters in this list are offered as choices while -customizing `org-export-odt-convert-process'. - -This variable is a list where each element is of the -form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name -of the converter. CONVERTER-CMD is the shell command for the -converter and can contain format specifiers. These format -specifiers are interpreted as below: - -%i input file name in full -%I input file name as a URL -%f format of the output file -%o output file name in full -%O output file name as a URL -%d output dir in full -%D output dir as a URL. -%x extra options as set in `org-export-odt-convert-capabilities'." - :group 'org-export-odt - :version "24.1" - :type - '(choice - (const :tag "None" nil) - (alist :tag "Converters" - :key-type (string :tag "Converter Name") - :value-type (group (string :tag "Command line"))))) - -(defcustom org-export-odt-convert-process "LibreOffice" - "Use this converter to convert from \"odt\" format to other formats. -During customization, the list of converter names are populated -from `org-export-odt-convert-processes'." - :group 'org-export-odt - :version "24.1" - :type '(choice :convert-widget - (lambda (w) - (apply 'widget-convert (widget-type w) - (eval (car (widget-get w :args))))) - `((const :tag "None" nil) - ,@(mapcar (lambda (c) - `(const :tag ,(car c) ,(car c))) - org-export-odt-convert-processes)))) - -(defcustom org-export-odt-convert-capabilities - '(("Text" - ("odt" "ott" "doc" "rtf" "docx") - (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott") - ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html"))) - ("Web" - ("html") - (("pdf" "pdf") ("odt" "odt") ("html" "html"))) - ("Spreadsheet" - ("ods" "ots" "xls" "csv" "xlsx") - (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods") - ("xls" "xls") ("xlsx" "xlsx"))) - ("Presentation" - ("odp" "otp" "ppt" "pptx") - (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt") - ("pptx" "pptx") ("odg" "odg")))) - "Specify input and output formats of `org-export-odt-convert-process'. -More correctly, specify the set of input and output formats that -the user is actually interested in. - -This variable is an alist where each element is of the -form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST). -INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an -alist where each element is of the form (OUTPUT-FMT -OUTPUT-FILE-EXTENSION EXTRA-OPTIONS). - -The variable is interpreted as follows: -`org-export-odt-convert-process' can take any document that is in -INPUT-FMT-LIST and produce any document that is in the -OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have -OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT -serves dual purposes: -- It is used for populating completion candidates during - `org-export-odt-convert' commands. -- It is used as the value of \"%f\" specifier in - `org-export-odt-convert-process'. - -EXTRA-OPTIONS is used as the value of \"%x\" specifier in -`org-export-odt-convert-process'. - -DOCUMENT-CLASS is used to group a set of file formats in -INPUT-FMT-LIST in to a single class. - -Note that this variable inherently captures how LibreOffice based -converters work. LibreOffice maps documents of various formats -to classes like Text, Web, Spreadsheet, Presentation etc and -allow document of a given class (irrespective of it's source -format) to be converted to any of the export formats associated -with that class. - -See default setting of this variable for an typical -configuration." - :group 'org-export-odt - :version "24.1" - :type - '(choice - (const :tag "None" nil) - (alist :tag "Capabilities" - :key-type (string :tag "Document Class") - :value-type - (group (repeat :tag "Input formats" (string :tag "Input format")) - (alist :tag "Output formats" - :key-type (string :tag "Output format") - :value-type - (group (string :tag "Output file extension") - (choice - (const :tag "None" nil) - (string :tag "Extra options")))))))) - -(declare-function org-create-math-formula "org" - (latex-frag &optional mathml-file)) - -;;;###autoload -(defun org-export-odt-convert (&optional in-file out-fmt prefix-arg) - "Convert IN-FILE to format OUT-FMT using a command line converter. -IN-FILE is the file to be converted. If unspecified, it defaults -to variable `buffer-file-name'. OUT-FMT is the desired output -format. Use `org-export-odt-convert-process' as the converter. -If PREFIX-ARG is non-nil then the newly converted file is opened -using `org-open-file'." - (interactive - (append (org-lparse-convert-read-params) current-prefix-arg)) - (org-lparse-do-convert in-file out-fmt prefix-arg)) - -(defun org-odt-get (what &optional opt-plist) - (case what - (BACKEND 'odt) - (EXPORT-DIR (org-export-directory :html opt-plist)) - (FILE-NAME-EXTENSION "odt") - (EXPORT-BUFFER-NAME "*Org ODT Export*") - (ENTITY-CONTROL org-odt-entity-control-callbacks-alist) - (ENTITY-FORMAT org-odt-entity-format-callbacks-alist) - (INIT-METHOD 'org-odt-init-outfile) - (FINAL-METHOD 'org-odt-finalize-outfile) - (SAVE-METHOD 'org-odt-save-as-outfile) - (CONVERT-METHOD - (and org-export-odt-convert-process - (cadr (assoc-string org-export-odt-convert-process - org-export-odt-convert-processes t)))) - (CONVERT-CAPABILITIES - (and org-export-odt-convert-process - (cadr (assoc-string org-export-odt-convert-process - org-export-odt-convert-processes t)) - org-export-odt-convert-capabilities)) - (TOPLEVEL-HLEVEL 1) - (SPECIAL-STRING-REGEXPS org-export-odt-special-string-regexps) - (INLINE-IMAGES 'maybe) - (INLINE-IMAGE-EXTENSIONS '("png" "jpeg" "jpg" "gif" "svg")) - (PLAIN-TEXT-MAP '(("&" . "&") ("<" . "<") (">" . ">"))) - (TABLE-FIRST-COLUMN-AS-LABELS nil) - (FOOTNOTE-SEPARATOR (org-lparse-format 'FONTIFY "," 'superscript)) - (CODING-SYSTEM-FOR-WRITE 'utf-8) - (CODING-SYSTEM-FOR-SAVE 'utf-8) - (t (error "Unknown property: %s" what)))) - -(defvar org-lparse-latex-fragment-fallback) ; set by org-do-lparse -(defun org-export-odt-do-preprocess-latex-fragments () - "Convert LaTeX fragments to images." - (let* ((latex-frag-opt (plist-get org-lparse-opt-plist :LaTeX-fragments)) - (latex-frag-opt ; massage the options - (or (and (member latex-frag-opt '(mathjax t)) - (not (and (fboundp 'org-format-latex-mathml-available-p) - (org-format-latex-mathml-available-p))) - (prog1 org-lparse-latex-fragment-fallback - (org-lparse-warn - (concat - "LaTeX to MathML converter not available. " - (format "Using %S instead." - org-lparse-latex-fragment-fallback))))) - latex-frag-opt)) - cache-dir display-msg) - (cond - ((eq latex-frag-opt 'dvipng) - (setq cache-dir org-latex-preview-ltxpng-directory) - (setq display-msg "Creating LaTeX image %s")) - ((member latex-frag-opt '(mathjax t)) - (setq latex-frag-opt 'mathml) - (setq cache-dir "ltxmathml/") - (setq display-msg "Creating MathML formula %s"))) - (when (and org-current-export-file) - (org-format-latex - (concat cache-dir (file-name-sans-extension - (file-name-nondirectory org-current-export-file))) - org-current-export-dir nil display-msg - nil nil latex-frag-opt)))) - -(defadvice org-format-latex-as-mathml - (after org-odt-protect-latex-fragment activate) - "Encode LaTeX fragment as XML. -Do this when translation to MathML fails." - (when (or (not (> (length ad-return-value) 0)) - (get-text-property 0 'org-protected ad-return-value)) - (setq ad-return-value - (org-propertize (org-odt-encode-plain-text (ad-get-arg 0)) - 'org-protected t)))) - -(defun org-export-odt-preprocess-latex-fragments () - (when (equal org-export-current-backend 'odt) - (org-export-odt-do-preprocess-latex-fragments))) - -(defun org-export-odt-preprocess-label-references () - (goto-char (point-min)) - (let (label label-components category value pretty-label) - (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t) - (org-if-unprotected-at (match-beginning 1) - (replace-match - (let ((org-lparse-encode-pending t) - (label (match-string 1))) - ;; markup generated below is mostly an eye-candy. At - ;; pre-processing stage, there is no information on which - ;; entity a label reference points to. The actual markup - ;; is generated as part of `org-odt-fixup-label-references' - ;; which gets called at the fag end of export. By this - ;; time we would have seen and collected all the label - ;; definitions in `org-odt-entity-labels-alist'. - (org-odt-format-tags - '("" . - "") - "" (org-add-props label '(org-protected t)))) t t))))) - -;; process latex fragments as part of -;; `org-export-preprocess-after-blockquote-hook'. Note that this hook -;; is the one that is closest and well before the call to -;; `org-export-attach-captions-and-attributes' in -;; `org-export-preprocess-string'. The above arrangement permits -;; captions, labels and attributes to be attached to png images -;; generated out of latex equations. -(add-hook 'org-export-preprocess-after-blockquote-hook - 'org-export-odt-preprocess-latex-fragments) - -(defun org-export-odt-preprocess (parameters) - (org-export-odt-preprocess-label-references)) - -(declare-function archive-zip-extract "arc-mode" (archive name)) -(defun org-odt-zip-extract-one (archive member &optional target) - (require 'arc-mode) - (let* ((target (or target default-directory)) - (archive (expand-file-name archive)) - (archive-zip-extract - (list "unzip" "-qq" "-o" "-d" target)) - exit-code command-output) - (setq command-output - (with-temp-buffer - (setq exit-code (archive-zip-extract archive member)) - (buffer-string))) - (unless (zerop exit-code) - (message command-output) - (error "Extraction failed")))) - -(defun org-odt-zip-extract (archive members &optional target) - (when (atom members) (setq members (list members))) - (mapc (lambda (member) - (org-odt-zip-extract-one archive member target)) - members)) - -(defun org-odt-copy-styles-file (&optional styles-file) - ;; Non-availability of styles.xml is not a critical error. For now - ;; throw an error purely for aesthetic reasons. - (setq styles-file (or styles-file - org-export-odt-styles-file - (expand-file-name "OrgOdtStyles.xml" - org-odt-styles-dir) - (error "org-odt: Missing styles file?"))) - (cond - ((listp styles-file) - (let ((archive (nth 0 styles-file)) - (members (nth 1 styles-file))) - (org-odt-zip-extract archive members) - (mapc - (lambda (member) - (when (org-file-image-p member) - (let* ((image-type (file-name-extension member)) - (media-type (format "image/%s" image-type))) - (org-odt-create-manifest-file-entry media-type member)))) - members))) - ((and (stringp styles-file) (file-exists-p styles-file)) - (let ((styles-file-type (file-name-extension styles-file))) - (cond - ((string= styles-file-type "xml") - (copy-file styles-file "styles.xml" t)) - ((member styles-file-type '("odt" "ott")) - (org-odt-zip-extract styles-file "styles.xml"))))) - (t - (error (format "Invalid specification of styles.xml file: %S" - org-export-odt-styles-file)))) - - ;; create a manifest entry for styles.xml - (org-odt-create-manifest-file-entry "text/xml" "styles.xml")) - -(defun org-odt-configure-outline-numbering (level) - "Outline numbering is retained only upto LEVEL. -To disable outline numbering pass a LEVEL of 0." - (goto-char (point-min)) - (let ((regex - "]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>") - (replacement - "")) - (while (re-search-forward regex nil t) - (when (> (string-to-number (match-string 2)) level) - (replace-match replacement t nil)))) - (save-buffer 0)) - -;;;###autoload -(defun org-export-as-odf (latex-frag &optional odf-file) - "Export LATEX-FRAG as OpenDocument formula file ODF-FILE. -Use `org-create-math-formula' to convert LATEX-FRAG first to -MathML. When invoked as an interactive command, use -`org-latex-regexps' to infer LATEX-FRAG from currently active -region. If no LaTeX fragments are found, prompt for it. Push -MathML source to kill ring, if `org-export-copy-to-kill-ring' is -non-nil." - (interactive - `(,(let (frag) - (setq frag (and (setq frag (and (org-region-active-p) - (buffer-substring (region-beginning) - (region-end)))) - (loop for e in org-latex-regexps - thereis (when (string-match (nth 1 e) frag) - (match-string (nth 2 e) frag))))) - (read-string "LaTeX Fragment: " frag nil frag)) - ,(let ((odf-filename (expand-file-name - (concat - (file-name-sans-extension - (or (file-name-nondirectory buffer-file-name))) - "." "odf") - (file-name-directory buffer-file-name)))) - (read-file-name "ODF filename: " nil odf-filename nil - (file-name-nondirectory odf-filename))))) - (org-odt-cleanup-xml-buffers - (let* ((org-lparse-backend 'odf) - org-lparse-opt-plist - (filename (or odf-file - (expand-file-name - (concat - (file-name-sans-extension - (or (file-name-nondirectory buffer-file-name))) - "." "odf") - (file-name-directory buffer-file-name)))) - (buffer (find-file-noselect (org-odt-init-outfile filename))) - (coding-system-for-write 'utf-8) - (save-buffer-coding-system 'utf-8)) - (set-buffer buffer) - (set-buffer-file-coding-system coding-system-for-write) - (let ((mathml (org-create-math-formula latex-frag))) - (unless mathml (error "No Math formula created")) - (insert mathml) - (or (org-export-push-to-kill-ring - (upcase (symbol-name org-lparse-backend))) - (message "Exporting... done"))) - (org-odt-save-as-outfile filename nil)))) - -;;;###autoload -(defun org-export-as-odf-and-open () - "Export LaTeX fragment as OpenDocument formula and immediately open it. -Use `org-export-as-odf' to read LaTeX fragment and OpenDocument -formula file." - (interactive) - (org-lparse-and-open - nil nil nil (call-interactively 'org-export-as-odf))) - -(provide 'org-odt) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-odt.el ends here diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el index e2b5dd9fb..43b5f46fe 100644 --- a/lisp/org-pcomplete.el +++ b/lisp/org-pcomplete.el @@ -35,7 +35,6 @@ (require 'pcomplete) (declare-function org-split-string "org" (string &optional separators)) -(declare-function org-get-current-options "org-exp" ()) (declare-function org-make-org-heading-search-string "org" (&optional string heading)) (declare-function org-get-buffer-tags "org" ()) @@ -109,11 +108,11 @@ When completing for #+STARTUP, for example, this function returns (let ((thing (org-thing-at-point))) (cond ((string= "file-option" (car thing)) - (concat (car thing) "/" (downcase (cdr thing)))) + (concat (car thing) + (and (cdr thing) (concat "/" (downcase (cdr thing)))))) ((string= "block-option" (car thing)) (concat (car thing) "/" (downcase (cdr thing)))) - (t - (car thing))))) + (t (car thing))))) (defun org-parse-arguments () "Parse whitespace separated arguments in the current region." @@ -140,21 +139,83 @@ When completing for #+STARTUP, for example, this function returns (car (org-thing-at-point))) pcomplete-default-completion-function)))) -(defvar org-options-keywords) ; From org.el -(defvar org-additional-option-like-keywords) ; From org.el +(defvar org-options-keywords) ; From org.el +(defvar org-element-block-name-alist) ; From org-element.el +(defvar org-element-affiliated-keywords) ; From org-element.el +(declare-function org-get-export-keywords "org" ()) (defun pcomplete/org-mode/file-option () "Complete against all valid file options." - (require 'org-exp) + (require 'org-element) (pcomplete-here (org-pcomplete-case-double - (mapcar (lambda (x) - (if (= ?: (aref x (1- (length x)))) - (concat x " ") - x)) - (append org-options-keywords - org-additional-option-like-keywords))) + (append (mapcar (lambda (keyword) (concat keyword " ")) + org-options-keywords) + (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) + (mapcar (lambda (keyword) (concat keyword ": ")) + (org-get-export-keywords)))) (substring pcomplete-stub 2))) +(defun pcomplete/org-mode/file-option/author () + "Complete arguments for the #+AUTHOR file option." + (pcomplete-here (list user-full-name))) + +(defvar org-time-stamp-formats) +(defun pcomplete/org-mode/file-option/date () + "Complete arguments for the #+DATE file option." + (pcomplete-here (list (format-time-string (car org-time-stamp-formats))))) + +(defun pcomplete/org-mode/file-option/email () + "Complete arguments for the #+EMAIL file option." + (pcomplete-here (list user-mail-address))) + +(defvar org-export-exclude-tags) +(defun pcomplete/org-mode/file-option/exclude_tags () + "Complete arguments for the #+EXCLUDE_TAGS file option." + (require 'ox) + (pcomplete-here + (and org-export-exclude-tags + (list (mapconcat 'identity org-export-exclude-tags " "))))) + +(defvar org-file-tags) +(defun pcomplete/org-mode/file-option/filetags () + "Complete arguments for the #+FILETAGS file option." + (pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " ")))) + +(defvar org-export-default-language) +(defun pcomplete/org-mode/file-option/language () + "Complete arguments for the #+LANGUAGE file option." + (require 'ox) + (pcomplete-here + (pcomplete-uniqify-list + (list org-export-default-language "en")))) + +(defvar org-default-priority) +(defvar org-highest-priority) +(defvar org-lowest-priority) +(defun pcomplete/org-mode/file-option/priorities () + "Complete arguments for the #+PRIORITIES file option." + (pcomplete-here (list (format "%c %c %c" + org-highest-priority + org-lowest-priority + org-default-priority)))) + +(defvar org-export-select-tags) +(defun pcomplete/org-mode/file-option/select_tags () + "Complete arguments for the #+SELECT_TAGS file option." + (require 'ox) + (pcomplete-here + (and org-export-select-tags + (list (mapconcat 'identity org-export-select-tags " "))))) + (defvar org-startup-options) (defun pcomplete/org-mode/file-option/startup () "Complete arguments for the #+STARTUP file option." @@ -169,37 +230,55 @@ When completing for #+STARTUP, for example, this function returns (setq opts (delete "showstars" opts))))) opts)))) -(defmacro pcomplete/org-mode/file-option/x (option) - "Complete arguments for OPTION." - `(while - (pcomplete-here - (pcomplete-uniqify-list - (delq nil - (mapcar (lambda(o) - (when (string-match (concat "^[ \t]*#\\+" - ,option ":[ \t]+\\(.*\\)[ \t]*$") o) - (match-string 1 o))) - (split-string (org-get-current-options) "\n"))))))) - -(defun pcomplete/org-mode/file-option/options () - "Complete arguments for the #+OPTIONS file option." - (pcomplete/org-mode/file-option/x "OPTIONS")) +(defvar org-tag-alist) +(defun pcomplete/org-mode/file-option/tags () + "Complete arguments for the #+TAGS file option." + (pcomplete-here + (list + (mapconcat (lambda (x) + (cond + ((eq :startgroup (car x)) "{") + ((eq :endgroup (car x)) "}") + ((eq :grouptags (car x)) ":") + ((eq :newline (car x)) "\\n") + ((cdr x) (format "%s(%c)" (car x) (cdr x))) + (t (car x)))) + org-tag-alist " ")))) (defun pcomplete/org-mode/file-option/title () "Complete arguments for the #+TITLE file option." - (pcomplete/org-mode/file-option/x "TITLE")) + (pcomplete-here + (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (list (or (and visited-file + (file-name-sans-extension + (file-name-nondirectory visited-file))) + (buffer-name (buffer-base-buffer))))))) -(defun pcomplete/org-mode/file-option/author () - "Complete arguments for the #+AUTHOR file option." - (pcomplete/org-mode/file-option/x "AUTHOR")) +(defun pcomplete/org-mode/file-option/options () + "Complete arguments for the #+OPTIONS file option." + (while (pcomplete-here + (pcomplete-uniqify-list + (append + ;; Hard-coded OPTION items always available. + '("H:" "\\n:" "num:" "timestamp:" "arch:" "author:" "c:" + "creator:" "date:" "d:" "email:" "*:" "e:" "::" "f:" + "inline:" "tex:" "p:" "pri:" "':" "-:" "stat:" "^:" "toc:" + "|:" "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)) + (let ((item (nth 2 option))) + (when item (push (concat item ":") items))))) + items)))))) -(defun pcomplete/org-mode/file-option/email () - "Complete arguments for the #+EMAIL file option." - (pcomplete/org-mode/file-option/x "EMAIL")) - -(defun pcomplete/org-mode/file-option/date () - "Complete arguments for the #+DATE file option." - (pcomplete/org-mode/file-option/x "DATE")) +(defun pcomplete/org-mode/file-option/infojs_opt () + "Complete arguments for the #+INFOJS_OPT file option." + (while (pcomplete-here + (pcomplete-uniqify-list + (mapcar (lambda (item) (format "%s:" (car item))) + (org-bound-and-true-p org-html-infojs-opts-table)))))) (defun pcomplete/org-mode/file-option/bind () "Complete arguments for the #+BIND file option, which are variable names." @@ -290,7 +369,7 @@ This needs more work, to handle headings with lots of spaces in them." (cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers))) (pcomplete-here cpllist (substring pcomplete-stub 1) - (unless (or (not (delete + (unless (or (not (delq nil (mapcar (lambda(x) (string-match (substring pcomplete-stub 1) x)) @@ -316,12 +395,12 @@ Complete a language in the first field, the header arguments and switches." (defun pcomplete/org-mode/block-option/clocktable () "Complete keywords in a clocktable line." - (while (pcomplete-here '(":maxlevel" ":scope" + (while (pcomplete-here '(":maxlevel" ":scope" ":lang" ":tstart" ":tend" ":block" ":step" ":stepskip0" ":fileskip0" ":emphasize" ":link" ":narrow" ":indent" ":tcolumns" ":level" ":compact" ":timestamp" - ":formula" ":formatter")))) + ":formula" ":formatter" ":wstart" ":mstart")))) (defun org-pcomplete-case-double (list) "Return list with both upcase and downcase version of all strings in LIST." diff --git a/lisp/org-plot.el b/lisp/org-plot.el index 02d747d54..384a6f684 100644 --- a/lisp/org-plot.el +++ b/lisp/org-plot.el @@ -30,7 +30,6 @@ ;;; Code: (require 'org) -(require 'org-exp) (require 'org-table) (eval-when-compile (require 'cl)) diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el index 18c6d6d70..d676c3933 100644 --- a/lisp/org-protocol.el +++ b/lisp/org-protocol.el @@ -91,11 +91,6 @@ ;; Org-link of which the page title will be the description part. If text ;; was select in the browser, that text will be the body of the entry. ;; -;; * Call `org-protocol-remember' by using the sub-protocol \"remember\". -;; This is provided for backward compatibility. -;; You may read `org-capture' as `org-remember' throughout this file if -;; you still use `org-remember'. -;; ;; You may use the same bookmark URL for all those standard handlers and just ;; adjust the sub-protocol used: ;; @@ -155,8 +150,7 @@ for `org-protocol-the-protocol' and sub-protocols defined in ;;; Variables: (defconst org-protocol-protocol-alist-default - '(("org-remember" :protocol "remember" :function org-protocol-remember :kill-client t) - ("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t) + '(("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t) ("org-store-link" :protocol "store-link" :function org-protocol-store-link) ("org-open-source" :protocol "open-source" :function org-protocol-open-source)) "Default protocols to use. @@ -273,10 +267,12 @@ string with two characters." :group 'org-protocol :type 'string) -(defcustom org-protocol-data-separator "/+" +(defcustom org-protocol-data-separator "/+\\|\\?" "The default data separator to use. This should be a single regexp string." :group 'org-protocol + :version "24.4" + :package-version '(Org . "8.0") :type 'string) ;;; Helper functions: @@ -297,7 +293,7 @@ nil, assume \"/+\". The results of that splitting are returned as a list. If UNHEXIFY is non-nil, hex-decode each split part. If UNHEXIFY is a function, use that function to decode each split part." - (let* ((sep (or separator "/+")) + (let* ((sep (or separator "/+\\|\\?")) (split-parts (split-string data sep))) (if unhexify (if (fboundp unhexify) @@ -391,32 +387,14 @@ The sub-protocol used to reach this function is set in uri)) nil) -(defun org-protocol-remember (info) - "Process an org-protocol://remember:// style url. - -The location for a browser's bookmark has to look like this: - - javascript:location.href='org-protocol://remember://'+ \\ - encodeURIComponent(location.href)+'/' \\ - encodeURIComponent(document.title)+'/'+ \\ - encodeURIComponent(window.getSelection()) - -See the docs for `org-protocol-capture' for more information." - - (if (and (boundp 'org-stored-links) - (fboundp 'org-capture) - (org-protocol-do-capture info 'org-remember)) - (message "Item remembered.")) - nil) - (defun org-protocol-capture (info) "Process an org-protocol://capture:// style url. The sub-protocol used to reach this function is set in `org-protocol-protocol-alist'. -This function detects an URL, title and optional text, separated by '/' -The location for a browser's bookmark has to look like this: +This function detects an URL, title and optional text, separated +by '/'. The location for a browser's bookmark looks like this: javascript:location.href='org-protocol://capture://'+ \\ encodeURIComponent(location.href)+'/' \\ @@ -431,14 +409,20 @@ But you may prepend the encoded URL with a character and a slash like so: Now template ?b will be used." (if (and (boundp 'org-stored-links) - (fboundp 'org-capture) - (org-protocol-do-capture info 'org-capture)) + (org-protocol-do-capture info)) (message "Item captured.")) nil) -(defun org-protocol-do-capture (info capture-func) - "Support `org-capture' and `org-remember' alike. -CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." +(defun org-protocol-convert-query-to-plist (query) + "Convert query string that is part of url to property list." + (if query + (apply 'append (mapcar (lambda (x) + (let ((c (split-string x "="))) + (list (intern (concat ":" (car c))) (cadr c)))) + (split-string query "&"))))) + +(defun org-protocol-do-capture (info) + "Support `org-capture'." (let* ((parts (org-protocol-split-data info t org-protocol-data-separator)) (template (or (and (>= 2 (length (car parts))) (pop parts)) org-protocol-default-template-key)) @@ -449,8 +433,8 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." (region (or (caddr parts) "")) (orglink (org-make-link-string url (if (string-match "[^[:space:]]" title) title url))) - (org-capture-link-is-already-stored t) ;; avoid call to org-store-link - remember-annotation-functions) + (query (or (org-protocol-convert-query-to-plist (cadddr parts)) "")) + (org-capture-link-is-already-stored t)) ;; avoid call to org-store-link (setq org-stored-links (cons (list url title) org-stored-links)) (kill-new orglink) @@ -458,9 +442,10 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." :link url :description title :annotation orglink - :initial region) + :initial region + :query query) (raise-frame) - (funcall capture-func nil template))) + (funcall 'org-capture nil template))) (defun org-protocol-open-source (fname) "Process an org-protocol://open-source:// style url. @@ -588,9 +573,9 @@ as filename." (defun org-protocol-create-for-org () "Create a org-protocol project for the current file's Org-mode project. -This works, if the file visited is part of a publishing project in -`org-publish-project-alist'. This function calls `org-protocol-create' to do -most of the work." +The visited file needs to be part of a publishing project in +`org-publish-project-alist' for this to work. The function +delegates most of the work to `org-protocol-create'." (interactive) (require 'org-publish) (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) @@ -600,10 +585,11 @@ most of the work." (defun org-protocol-create (&optional project-plist) "Create a new org-protocol project interactively. -An org-protocol project is an entry in `org-protocol-project-alist' -which is used by `org-protocol-open-source'. -Optionally use project-plist to initialize the defaults for this project. If -project-plist is the CDR of an element in `org-publish-project-alist', reuse +An org-protocol project is an entry in +`org-protocol-project-alist' which is used by +`org-protocol-open-source'. Optionally use PROJECT-PLIST to +initialize the defaults for this project. If PROJECT-PLIST is +the cdr of an element in `org-publish-project-alist', reuse :base-directory, :html-extension and :base-extension." (interactive) (let ((working-dir (expand-file-name diff --git a/lisp/org-publish.el b/lisp/org-publish.el deleted file mode 100644 index 20c6a6860..000000000 --- a/lisp/org-publish.el +++ /dev/null @@ -1,1198 +0,0 @@ -;;; org-publish.el --- publish related org-mode files as a website -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. - -;; Author: David O'Toole -;; Maintainer: Carsten Dominik -;; Keywords: hypermedia, outlines, wp - -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This program allow configurable publishing of related sets of -;; Org-mode files as a complete website. -;; -;; org-publish.el can do the following: -;; -;; + Publish all one's org-files to HTML or PDF -;; + Upload HTML, images, attachments and other files to a web server -;; + Exclude selected private pages from publishing -;; + Publish a clickable sitemap of pages -;; + Manage local timestamps for publishing only changed files -;; + Accept plugin functions to extend range of publishable content -;; -;; Documentation for publishing is in the manual. - -;;; Code: - - -(eval-when-compile - (require 'cl)) -(require 'org) -(require 'org-exp) -(require 'format-spec) - -(eval-and-compile - (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly)))) - -(defvar org-publish-initial-buffer nil - "The buffer `org-publish' has been called from.") - -(defvar org-publish-temp-files nil - "Temporary list of files to be published.") - -;; Here, so you find the variable right before it's used the first time: -(defvar org-publish-cache nil - "This will cache timestamps and titles for files in publishing projects. -Blocks could hash sha1 values here.") - -(defgroup org-publish nil - "Options for publishing a set of Org-mode and related files." - :tag "Org Publishing" - :group 'org) - -(defcustom org-publish-project-alist nil - "Association list to control publishing behavior. -Each element of the alist is a publishing 'project.' The CAR of -each element is a string, uniquely identifying the project. The -CDR of each element is in one of the following forms: - -1. A well-formed property list with an even number of elements, alternating - keys and values, specifying parameters for the publishing process. - - (:property value :property value ... ) - -2. A meta-project definition, specifying of a list of sub-projects: - - (:components (\"project-1\" \"project-2\" ...)) - -When the CDR of an element of org-publish-project-alist is in -this second form, the elements of the list after :components are -taken to be components of the project, which group together files -requiring different publishing options. When you publish such a -project with \\[org-publish], the components all publish. - -When a property is given a value in org-publish-project-alist, its -setting overrides the value of the corresponding user variable -\(if any) during publishing. However, options set within a file -override everything. - -Most properties are optional, but some should always be set: - - :base-directory Directory containing publishing source files - :base-extension Extension (without the dot!) of source files. - This can be a regular expression. If not given, - \"org\" will be used as default extension. - :publishing-directory Directory (possibly remote) where output - files will be published - -The :exclude property may be used to prevent certain files from -being published. Its value may be a string or regexp matching -file names you don't want to be published. - -The :include property may be used to include extra files. Its -value may be a list of filenames to include. The filenames are -considered relative to the base directory. - -When both :include and :exclude properties are given values, the -exclusion step happens first. - -One special property controls which back-end function to use for -publishing files in the project. This can be used to extend the -set of file types publishable by org-publish, as well as the set -of output formats. - - :publishing-function Function to publish file. The default is - `org-publish-org-to-html', but other - values are possible. May also be a - list of functions, in which case - each function in the list is invoked - in turn. - -Another property allows you to insert code that prepares a -project for publishing. For example, you could call GNU Make on a -certain makefile, to ensure published files are built up to date. - - :preparation-function Function to be called before publishing - this project. This may also be a list - of functions. - :completion-function Function to be called after publishing - this project. This may also be a list - of functions. - -Some properties control details of the Org publishing process, -and are equivalent to the corresponding user variables listed in -the right column. See the documentation for those variables to -learn more about their use and default values. - - :language `org-export-default-language' - :headline-levels `org-export-headline-levels' - :section-numbers `org-export-with-section-numbers' - :table-of-contents `org-export-with-toc' - :emphasize `org-export-with-emphasize' - :sub-superscript `org-export-with-sub-superscripts' - :TeX-macros `org-export-with-TeX-macros' - :fixed-width `org-export-with-fixed-width' - :tables `org-export-with-tables' - :table-auto-headline `org-export-highlight-first-table-line' - :style `org-export-html-style' - :convert-org-links `org-export-html-link-org-files-as-html' - :inline-images `org-export-html-inline-images' - :expand-quoted-html `org-export-html-expand' - :timestamp `org-export-html-with-timestamp' - :publishing-directory `org-export-publishing-directory' - :html-preamble `org-export-html-preamble' - :html-postamble `org-export-html-postamble' - :author `user-full-name' - :email `user-mail-address' - -The following properties may be used to control publishing of a -sitemap of files or summary page for a given project. - - :auto-sitemap Whether to publish a sitemap during - `org-publish-current-project' or `org-publish-all'. - :sitemap-filename Filename for output of sitemap. Defaults - to 'sitemap.org' (which becomes 'sitemap.html'). - :sitemap-title Title of sitemap page. Defaults to name of file. - :sitemap-function Plugin function to use for generation of sitemap. - Defaults to `org-publish-org-sitemap', which - generates a plain list of links to all files - in the project. - :sitemap-style Can be `list' (sitemap is just an itemized list - of the titles of the files involved) or - `tree' (the directory structure of the source - files is reflected in the sitemap). Defaults to - `tree'. - :sitemap-sans-extension Remove extension from sitemap's - filenames. Useful to have cool - URIs (see - http://www.w3.org/Provider/Style/URI). - Defaults to nil. - - If you create a sitemap file, adjust the sorting like this: - - :sitemap-sort-folders Where folders should appear in the sitemap. - Set this to `first' (default) or `last' to - display folders first or last, respectively. - Any other value will mix files and folders. - :sitemap-sort-files The site map is normally sorted alphabetically. - You can change this behaviour setting this to - `chronologically', `anti-chronologically' or nil. - :sitemap-ignore-case Should sorting be case-sensitive? Default nil. - -The following properties control the creation of a concept index. - - :makeindex Create a concept index. - -Other properties affecting publication. - - :body-only Set this to 't' to publish only the body of the - documents, excluding everything outside and - including the tags in HTML, or - \begin{document}..\end{document} in LaTeX." - :group 'org-publish - :type 'alist) - -(defcustom org-publish-use-timestamps-flag t - "Non-nil means use timestamp checking to publish only changed files. -When nil, do no timestamp checking and always publish all files." - :group 'org-publish - :type 'boolean) - -(defcustom org-publish-timestamp-directory (convert-standard-filename - "~/.org-timestamps/") - "Name of directory in which to store publishing timestamps." - :group 'org-publish - :type 'directory) - -(defcustom org-publish-list-skipped-files t - "Non-nil means show message about files *not* published." - :group 'org-publish - :type 'boolean) - -(defcustom org-publish-before-export-hook nil - "Hook run before export on the Org file. -The hook may modify the file in arbitrary ways before publishing happens. -The original version of the buffer will be restored after publishing." - :group 'org-publish - :type 'hook) - -(defcustom org-publish-after-export-hook nil - "Hook run after export on the exported buffer. -Any changes made by this hook will be saved." - :group 'org-publish - :type 'hook) - -(defcustom org-publish-sitemap-sort-files 'alphabetically - "How sitemaps files should be sorted by default? -Possible values are `alphabetically', `chronologically', `anti-chronologically' and nil. -If `alphabetically', files will be sorted alphabetically. -If `chronologically', files will be sorted with older modification time first. -If `anti-chronologically', files will be sorted with newer modification time first. -nil won't sort files. - -You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-sort-files'." - :group 'org-publish - :version "24.1" - :type 'symbol) - -(defcustom org-publish-sitemap-sort-folders 'first - "A symbol, denoting if folders are sorted first in sitemaps. -Possible values are `first', `last', and nil. -If `first', folders will be sorted before files. -If `last', folders are sorted to the end after the files. -Any other value will not mix files and folders. - -You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-sort-folders'." - :group 'org-publish - :version "24.1" - :type 'symbol) - -(defcustom org-publish-sitemap-sort-ignore-case nil - "Sort sitemaps case insensitively by default? - -You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-ignore-case'." - :group 'org-publish - :version "24.1" - :type 'boolean) - -(defcustom org-publish-sitemap-date-format "%Y-%m-%d" - "Format for `format-time-string' which is used to print a date -in the sitemap." - :group 'org-publish - :version "24.1" - :type 'string) - -(defcustom org-publish-sitemap-file-entry-format "%t" - "How a sitemap file entry is formatted. -You could use brackets to delimit on what part the link will be. - -%t is the title. -%a is the author. -%d is the date formatted using `org-publish-sitemap-date-format'." - :group 'org-publish - :version "24.1" - :type 'string) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Sanitize-plist (FIXME why?) - -(defun org-publish-sanitize-plist (plist) - ;; FIXME document - (mapcar (lambda (x) - (or (cdr (assq x '((:index-filename . :sitemap-filename) - (:index-title . :sitemap-title) - (:index-function . :sitemap-function) - (:index-style . :sitemap-style) - (:auto-index . :auto-sitemap)))) - x)) - plist)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Timestamp-related functions - -(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func) - "Return path to timestamp file for filename FILENAME." - (setq filename (concat filename "::" (or pub-dir "") "::" - (format "%s" (or pub-func "")))) - (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) - -(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir base-dir) - "Return t if FILENAME should be published in PUB-DIR using PUB-FUNC. -TRUE-PUB-DIR is where the file will truly end up. Currently we are not using -this - maybe it can eventually be used to check if the file is present at -the target location, and how old it is. Right now we cannot do this, because -we do not know under what file name the file will be stored - the publishing -function can still decide about that independently." - (let ((rtn - (if org-publish-use-timestamps-flag - (org-publish-cache-file-needs-publishing - filename pub-dir pub-func base-dir) - ;; don't use timestamps, always return t - t))) - (if rtn - (message "Publishing file %s using `%s'" filename pub-func) - (when org-publish-list-skipped-files - (message "Skipping unmodified file %s" filename))) - rtn)) - -(defun org-publish-update-timestamp (filename &optional pub-dir pub-func base-dir) - "Update publishing timestamp for file FILENAME. -If there is no timestamp, create one." - (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) - (stamp (org-publish-cache-ctime-of-src filename))) - (org-publish-cache-set key stamp))) - -(defun org-publish-remove-all-timestamps () - "Remove all files in the timestamp directory." - (let ((dir org-publish-timestamp-directory) - files) - (when (and (file-exists-p dir) - (file-directory-p dir)) - (mapc 'delete-file (directory-files dir 'full "[^.]\\'")) - (org-publish-reset-cache)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Compatibility aliases - -;; Delete-dups is not in Emacs <22 -(if (fboundp 'delete-dups) - (defalias 'org-publish-delete-dups 'delete-dups) - (defun org-publish-delete-dups (list) - "Destructively remove `equal' duplicates from LIST. -Store the result in LIST and return it. LIST must be a proper list. -Of several `equal' occurrences of an element in LIST, the first -one is kept. - -This is a compatibility function for Emacsen without `delete-dups'." - ;; Code from `subr.el' in Emacs 22: - (let ((tail list)) - (while tail - (setcdr tail (delete (car tail) (cdr tail))) - (setq tail (cdr tail)))) - list)) - -(declare-function org-publish-delete-dups "org-publish" (list)) -(declare-function find-lisp-find-files "find-lisp" (directory regexp)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Getting project information out of org-publish-project-alist - -(defun org-publish-expand-projects (projects-alist) - "Expand projects in PROJECTS-ALIST. -This splices all the components into the list." - (let ((rest projects-alist) rtn p components) - (while (setq p (pop rest)) - (if (setq components (plist-get (cdr p) :components)) - (setq rest (append - (mapcar (lambda (x) (assoc x org-publish-project-alist)) - components) - rest)) - (push p rtn))) - (nreverse (org-publish-delete-dups (delq nil rtn))))) - -(defvar org-sitemap-sort-files) -(defvar org-sitemap-sort-folders) -(defvar org-sitemap-ignore-case) -(defvar org-sitemap-requested) -(defvar org-sitemap-date-format) -(defvar org-sitemap-file-entry-format) -(defun org-publish-compare-directory-files (a b) - "Predicate for `sort', that sorts folders and files for sitemap." - (let ((retval t)) - (when (or org-sitemap-sort-files org-sitemap-sort-folders) - ;; First we sort files: - (when org-sitemap-sort-files - (cond ((equal org-sitemap-sort-files 'alphabetically) - (let* ((adir (file-directory-p a)) - (aorg (and (string-match "\\.org$" a) (not adir))) - (bdir (file-directory-p b)) - (borg (and (string-match "\\.org$" b) (not bdir))) - (A (if aorg - (concat (file-name-directory a) - (org-publish-find-title a)) a)) - (B (if borg - (concat (file-name-directory b) - (org-publish-find-title b)) b))) - (setq retval (if org-sitemap-ignore-case - (not (string-lessp (upcase B) (upcase A))) - (not (string-lessp B A)))))) - ((or (equal org-sitemap-sort-files 'chronologically) - (equal org-sitemap-sort-files 'anti-chronologically)) - (let* ((adate (org-publish-find-date a)) - (bdate (org-publish-find-date b)) - (A (+ (lsh (car adate) 16) (cadr adate))) - (B (+ (lsh (car bdate) 16) (cadr bdate)))) - (setq retval (if (equal org-sitemap-sort-files 'chronologically) - (<= A B) - (>= A B))))))) - ;; Directory-wise wins: - (when org-sitemap-sort-folders - ;; a is directory, b not: - (cond - ((and (file-directory-p a) (not (file-directory-p b))) - (setq retval (equal org-sitemap-sort-folders 'first))) - ;; a is not a directory, but b is: - ((and (not (file-directory-p a)) (file-directory-p b)) - (setq retval (equal org-sitemap-sort-folders 'last)))))) - retval)) - -(defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir) - "Set `org-publish-temp-files' with files from BASE-DIR directory. -If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is -non-nil, restrict this list to the files matching the regexp -MATCH. If SKIP-FILE is non-nil, skip file matching the regexp -SKIP-FILE. If SKIP-DIR is non-nil, don't check directories -matching the regexp SKIP-DIR when recursing through BASE-DIR." - (mapc (lambda (f) - (let ((fd-p (file-directory-p f)) - (fnd (file-name-nondirectory f))) - (if (and fd-p recurse - (not (string-match "^\\.+$" fnd)) - (if skip-dir (not (string-match skip-dir fnd)) t)) - (org-publish-get-base-files-1 f recurse match skip-file skip-dir) - (unless (or fd-p ;; this is a directory - (and skip-file (string-match skip-file fnd)) - (not (file-exists-p (file-truename f))) - (not (string-match match fnd))) - - (pushnew f org-publish-temp-files))))) - (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))))) - -(defun org-publish-get-base-files (project &optional exclude-regexp) - "Return a list of all files in PROJECT. -If EXCLUDE-REGEXP is set, this will be used to filter out -matching filenames." - (let* ((project-plist (cdr project)) - (base-dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (include-list (plist-get project-plist :include)) - (recurse (plist-get project-plist :recursive)) - (extension (or (plist-get project-plist :base-extension) "org")) - ;; sitemap-... variables are dynamically scoped for - ;; org-publish-compare-directory-files: - (org-sitemap-requested - (plist-get project-plist :auto-sitemap)) - (sitemap-filename - (or (plist-get project-plist :sitemap-filename) - "sitemap.org")) - (org-sitemap-sort-folders - (if (plist-member project-plist :sitemap-sort-folders) - (plist-get project-plist :sitemap-sort-folders) - org-publish-sitemap-sort-folders)) - (org-sitemap-sort-files - (cond ((plist-member project-plist :sitemap-sort-files) - (plist-get project-plist :sitemap-sort-files)) - ;; For backward compatibility: - ((plist-member project-plist :sitemap-alphabetically) - (if (plist-get project-plist :sitemap-alphabetically) - 'alphabetically nil)) - (t org-publish-sitemap-sort-files))) - (org-sitemap-ignore-case - (if (plist-member project-plist :sitemap-ignore-case) - (plist-get project-plist :sitemap-ignore-case) - org-publish-sitemap-sort-ignore-case)) - (match (if (eq extension 'any) - "^[^\\.]" - (concat "^[^\\.].*\\.\\(" extension "\\)$")))) - ;; Make sure `org-sitemap-sort-folders' has an accepted value - (unless (memq org-sitemap-sort-folders '(first last)) - (setq org-sitemap-sort-folders nil)) - - (setq org-publish-temp-files nil) - (if org-sitemap-requested - (pushnew (expand-file-name (concat base-dir sitemap-filename)) - org-publish-temp-files)) - (org-publish-get-base-files-1 base-dir recurse match - ;; FIXME distinguish exclude regexp - ;; for skip-file and skip-dir? - exclude-regexp exclude-regexp) - (mapc (lambda (f) - (pushnew - (expand-file-name (concat base-dir f)) - org-publish-temp-files)) - include-list) - org-publish-temp-files)) - -(defun org-publish-get-project-from-filename (filename &optional up) - "Return the project that FILENAME belongs to." - (let* ((filename (expand-file-name filename)) - project-name) - - (catch 'p-found - (dolist (prj org-publish-project-alist) - (unless (plist-get (cdr prj) :components) - ;; [[info:org:Selecting%20files]] shows how this is supposed to work: - (let* ((r (plist-get (cdr prj) :recursive)) - (b (expand-file-name (file-name-as-directory - (plist-get (cdr prj) :base-directory)))) - (x (or (plist-get (cdr prj) :base-extension) "org")) - (e (plist-get (cdr prj) :exclude)) - (i (plist-get (cdr prj) :include)) - (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) - (when - (or - (and - i (member filename - (mapcar - (lambda (file) (expand-file-name file b)) - i))) - (and - (not (and e (string-match e filename))) - (string-match xm filename))) - (setq project-name (car prj)) - (throw 'p-found project-name)))))) - (when up - (dolist (prj org-publish-project-alist) - (if (member project-name (plist-get (cdr prj) :components)) - (setq project-name (car prj))))) - (assoc project-name org-publish-project-alist))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Pluggable publishing back-end functions - -(defun org-publish-org-to (format plist filename pub-dir) - "Publish an org file to FORMAT. -PLIST is the property list for the given project. -FILENAME is the filename of the org file to be published. -PUB-DIR is the publishing directory." - (require 'org) - (unless (file-exists-p pub-dir) - (make-directory pub-dir t)) - (let ((visiting (find-buffer-visiting filename))) - (save-excursion - (org-pop-to-buffer-same-window (or visiting (find-file filename))) - (let* ((plist (cons :buffer-will-be-killed (cons t plist))) - (init-buf (current-buffer)) - (init-point (point)) - (init-buf-string (buffer-string)) - export-buf-or-file) - ;; run hooks before exporting - (run-hooks 'org-publish-before-export-hook) - ;; export the possibly modified buffer - (setq export-buf-or-file - (funcall (intern (concat "org-export-as-" format)) - (plist-get plist :headline-levels) - plist nil - (plist-get plist :body-only) - pub-dir)) - (when (and (bufferp export-buf-or-file) - (buffer-live-p export-buf-or-file)) - (set-buffer export-buf-or-file) - ;; run hooks after export and save export - (progn (run-hooks 'org-publish-after-export-hook) - (if (buffer-modified-p) (save-buffer))) - (kill-buffer export-buf-or-file)) - ;; maybe restore buffer's content - (set-buffer init-buf) - (when (buffer-modified-p init-buf) - (erase-buffer) - (insert init-buf-string) - (save-buffer) - (goto-char init-point)) - (unless visiting - (kill-buffer init-buf)))))) - -(defmacro org-publish-with-aux-preprocess-maybe (&rest body) - "Execute BODY with a modified hook to preprocess for index." - `(let ((org-export-preprocess-after-headline-targets-hook - (if (plist-get project-plist :makeindex) - (cons 'org-publish-aux-preprocess - org-export-preprocess-after-headline-targets-hook) - org-export-preprocess-after-headline-targets-hook))) - ,@body)) -(def-edebug-spec org-publish-with-aux-preprocess-maybe (body)) - -(defvar project-plist) -(defun org-publish-org-to-latex (plist filename pub-dir) - "Publish an org file to LaTeX. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "latex" plist filename pub-dir))) - -(defun org-publish-org-to-pdf (plist filename pub-dir) - "Publish an org file to PDF (via LaTeX). -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "pdf" plist filename pub-dir))) - -(defun org-publish-org-to-html (plist filename pub-dir) - "Publish an org file to HTML. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "html" plist filename pub-dir))) - -(defun org-publish-org-to-org (plist filename pub-dir) - "Publish an org file to HTML. -See `org-publish-org-to' to the list of arguments." - (org-publish-org-to "org" plist filename pub-dir)) - -(defun org-publish-org-to-ascii (plist filename pub-dir) - "Publish an org file to ASCII. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "ascii" plist filename pub-dir))) - -(defun org-publish-org-to-latin1 (plist filename pub-dir) - "Publish an org file to Latin-1. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "latin1" plist filename pub-dir))) - -(defun org-publish-org-to-utf8 (plist filename pub-dir) - "Publish an org file to UTF-8. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "utf8" plist filename pub-dir))) - -(defun org-publish-attachment (plist filename pub-dir) - "Publish a file with no transformation of any kind. -See `org-publish-org-to' to the list of arguments." - ;; make sure eshell/cp code is loaded - (unless (file-directory-p pub-dir) - (make-directory pub-dir t)) - (or (equal (expand-file-name (file-name-directory filename)) - (file-name-as-directory (expand-file-name pub-dir))) - (copy-file filename - (expand-file-name (file-name-nondirectory filename) pub-dir) - t))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Publishing files, sets of files, and indices - -(defun org-publish-file (filename &optional project no-cache) - "Publish file FILENAME from PROJECT. -If NO-CACHE is not nil, do not initialize org-publish-cache and -write it to disk. This is needed, since this function is used to -publish single files, when entire projects are published. -See `org-publish-projects'." - (let* ((project - (or project - (or (org-publish-get-project-from-filename filename) - (error "File %s not part of any known project" - (abbreviate-file-name filename))))) - (project-plist (cdr project)) - (ftname (expand-file-name filename)) - (publishing-function - (or (plist-get project-plist :publishing-function) - 'org-publish-org-to-html)) - (base-dir - (file-name-as-directory - (expand-file-name - (or (plist-get project-plist :base-directory) - (error "Project %s does not have :base-directory defined" - (car project)))))) - (pub-dir - (file-name-as-directory - (file-truename - (or (eval (plist-get project-plist :publishing-directory)) - (error "Project %s does not have :publishing-directory defined" - (car project)))))) - tmp-pub-dir) - - (unless no-cache - (org-publish-initialize-cache (car project))) - - (setq tmp-pub-dir - (file-name-directory - (concat pub-dir - (and (string-match (regexp-quote base-dir) ftname) - (substring ftname (match-end 0)))))) - (if (listp publishing-function) - ;; allow chain of publishing functions - (mapc (lambda (f) - (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir) - (funcall f project-plist filename tmp-pub-dir) - (org-publish-update-timestamp filename pub-dir f base-dir))) - publishing-function) - (when (org-publish-needed-p filename pub-dir publishing-function tmp-pub-dir base-dir) - (funcall publishing-function project-plist filename tmp-pub-dir) - (org-publish-update-timestamp - filename pub-dir publishing-function base-dir))) - (unless no-cache (org-publish-write-cache-file)))) - -(defun org-publish-projects (projects) - "Publish all files belonging to the PROJECTS alist. -If :auto-sitemap is set, publish the sitemap too. -If :makeindex is set, also produce a file theindex.org." - (mapc - (lambda (project) - ;; Each project uses its own cache file: - (org-publish-initialize-cache (car project)) - (let* - ((project-plist (cdr project)) - (exclude-regexp (plist-get project-plist :exclude)) - (sitemap-p (plist-get project-plist :auto-sitemap)) - (sitemap-filename (or (plist-get project-plist :sitemap-filename) - "sitemap.org")) - (sitemap-function (or (plist-get project-plist :sitemap-function) - 'org-publish-org-sitemap)) - (org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format) - org-publish-sitemap-date-format)) - (org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format) - org-publish-sitemap-file-entry-format)) - (preparation-function (plist-get project-plist :preparation-function)) - (completion-function (plist-get project-plist :completion-function)) - (files (org-publish-get-base-files project exclude-regexp)) file) - (when preparation-function (run-hooks 'preparation-function)) - (if sitemap-p (funcall sitemap-function project sitemap-filename)) - (while (setq file (pop files)) - (org-publish-file file project t)) - (when (plist-get project-plist :makeindex) - (org-publish-index-generate-theindex - (plist-get project-plist :base-directory)) - (org-publish-file (expand-file-name - "theindex.org" - (plist-get project-plist :base-directory)) - project t)) - (when completion-function (run-hooks 'completion-function)) - (org-publish-write-cache-file))) - (org-publish-expand-projects projects))) - -(defun org-publish-org-sitemap (project &optional sitemap-filename) - "Create a sitemap of pages in set defined by PROJECT. -Optionally set the filename of the sitemap with SITEMAP-FILENAME. -Default for SITEMAP-FILENAME is 'sitemap.org'." - (let* ((project-plist (cdr project)) - (dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (localdir (file-name-directory dir)) - (indent-str (make-string 2 ?\ )) - (exclude-regexp (plist-get project-plist :exclude)) - (files (nreverse (org-publish-get-base-files project exclude-regexp))) - (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) - (sitemap-title (or (plist-get project-plist :sitemap-title) - (concat "Sitemap for project " (car project)))) - (sitemap-style (or (plist-get project-plist :sitemap-style) - 'tree)) - (sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension)) - (visiting (find-buffer-visiting sitemap-filename)) - (ifn (file-name-nondirectory sitemap-filename)) - file sitemap-buffer) - (with-current-buffer (setq sitemap-buffer - (or visiting (find-file sitemap-filename))) - (erase-buffer) - (insert (concat "#+TITLE: " sitemap-title "\n\n")) - (while (setq file (pop files)) - (let ((fn (file-name-nondirectory file)) - (link (file-relative-name file dir)) - (oldlocal localdir)) - (when sitemap-sans-extension - (setq link (file-name-sans-extension link))) - ;; sitemap shouldn't list itself - (unless (equal (file-truename sitemap-filename) - (file-truename file)) - (if (eq sitemap-style 'list) - (message "Generating list-style sitemap for %s" sitemap-title) - (message "Generating tree-style sitemap for %s" sitemap-title) - (setq localdir (concat (file-name-as-directory dir) - (file-name-directory link))) - (unless (string= localdir oldlocal) - (if (string= localdir dir) - (setq indent-str (make-string 2 ?\ )) - (let ((subdirs - (split-string - (directory-file-name - (file-name-directory - (file-relative-name localdir dir))) "/")) - (subdir "") - (old-subdirs (split-string - (file-relative-name oldlocal dir) "/"))) - (setq indent-str (make-string 2 ?\ )) - (while (string= (car old-subdirs) (car subdirs)) - (setq indent-str (concat indent-str (make-string 2 ?\ ))) - (pop old-subdirs) - (pop subdirs)) - (dolist (d subdirs) - (setq subdir (concat subdir d "/")) - (insert (concat indent-str " + " d "\n")) - (setq indent-str (make-string - (+ (length indent-str) 2) ?\ ))))))) - ;; This is common to 'flat and 'tree - (let ((entry - (org-publish-format-file-entry org-sitemap-file-entry-format - file project-plist)) - (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) - (cond ((string-match-p regexp entry) - (string-match regexp entry) - (insert (concat indent-str " + " (match-string 1 entry) - "[[file:" link "][" - (match-string 2 entry) - "]]" (match-string 3 entry) "\n"))) - (t - (insert (concat indent-str " + [[file:" link "][" - entry - "]]\n")))))))) - (save-buffer)) - (or visiting (kill-buffer sitemap-buffer)))) - -(defun org-publish-format-file-entry (fmt file project-plist) - (format-spec fmt - `((?t . ,(org-publish-find-title file t)) - (?d . ,(format-time-string org-sitemap-date-format - (org-publish-find-date file))) - (?a . ,(or (plist-get project-plist :author) user-full-name))))) - -(defun org-publish-find-title (file &optional reset) - "Find the title of FILE in project." - (or - (and (not reset) (org-publish-cache-get-file-property file :title nil t)) - (let* ((visiting (find-buffer-visiting file)) - (buffer (or visiting (find-file-noselect file))) - title) - (with-current-buffer buffer - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist)))) - (setq title - (or (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (file-name-nondirectory (file-name-sans-extension file)))))) - (unless visiting - (kill-buffer buffer)) - (org-publish-cache-set-file-property file :title title) - title))) - -(defun org-publish-find-date (file) - "Find the date of FILE in project. -If FILE provides a #+date keyword use it else use the file -system's modification time. - -It returns time in `current-time' format." - (let ((visiting (find-buffer-visiting file))) - (save-excursion - (org-pop-to-buffer-same-window (or visiting (find-file-noselect file nil t))) - (let* ((plist (org-infile-export-plist)) - (date (plist-get plist :date))) - (unless visiting - (kill-buffer (current-buffer))) - (if date - (org-time-string-to-time date) - (when (file-exists-p file) - (nth 5 (file-attributes file)))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Interactive publishing functions - -;;;###autoload -(defalias 'org-publish-project 'org-publish) - -;;;###autoload -(defun org-publish (project &optional force) - "Publish PROJECT." - (interactive - (list - (assoc (org-icompleting-read - "Publish project: " - org-publish-project-alist nil t) - org-publish-project-alist) - current-prefix-arg)) - (setq org-publish-initial-buffer (current-buffer)) - (save-window-excursion - (let* ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects - (if (stringp project) - ;; If this function is called in batch mode, - ;; project is still a string here. - (list (assoc project org-publish-project-alist)) - (list project)))))) - -;;;###autoload -(defun org-publish-all (&optional force) - "Publish all projects. -With prefix argument, remove all files in the timestamp -directory and force publishing all files." - (interactive "P") - (when force - (org-publish-remove-all-timestamps)) - (save-window-excursion - (let ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects org-publish-project-alist)))) - -;;;###autoload -(defun org-publish-current-file (&optional force) - "Publish the current file. -With prefix argument, force publish the file." - (interactive "P") - (save-window-excursion - (let ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-file (buffer-file-name))))) - -;;;###autoload -(defun org-publish-current-project (&optional force) - "Publish the project associated with the current file. -With a prefix argument, force publishing of all files in -the project." - (interactive "P") - (save-window-excursion - (let ((project (org-publish-get-project-from-filename (buffer-file-name) 'up)) - (org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (if (not project) - (error "File %s is not part of any known project" (buffer-file-name))) - ;; FIXME: force is not used here? - (org-publish project)))) - - -;;; Index generation - -(defun org-publish-aux-preprocess () - "Find index entries and write them to an .orgx file." - (let ((case-fold-search t) - entry index target) - (goto-char (point-min)) - (while - (and - (re-search-forward "^[ \t]*#\\+index:[ \t]*\\(.*?\\)[ \t]*$" nil t) - (> (match-end 1) (match-beginning 1))) - (setq entry (match-string 1)) - (when (eq org-export-current-backend 'latex) - (replace-match (format "\\index{%s}" entry) t t)) - (save-excursion - (ignore-errors (org-back-to-heading t)) - (setq target (get-text-property (point) 'target)) - (setq target (or (cdr (assoc target org-export-preferred-target-alist)) - (cdr (assoc target org-export-id-target-alist)) - target "")) - (push (cons entry target) index))) - (with-temp-file - (concat - (file-name-directory org-current-export-file) "." - (file-name-sans-extension - (file-name-nondirectory org-current-export-file)) ".orgx") - (dolist (entry (nreverse index)) - (insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry))))))) - -(defun org-publish-index-generate-theindex (directory) - "Generate the index from all .orgx files in DIRECTORY." - (require 'find-lisp) - (let* ((fulldir (file-name-as-directory - (expand-file-name directory))) - (full-files (find-lisp-find-files directory "\\.orgx\\'")) - (re (concat "\\`" fulldir)) - (files (mapcar (lambda (f) (if (string-match re f) - (substring f (match-end 0)) - f)) - full-files)) - (default-directory directory) - index origfile buf target entry ibuffer - main last-main letter last-letter file sub link tgext) - ;; `files' contains the list of relative file names - (dolist (file files) - (setq origfile - (concat (file-name-directory file) - (substring (file-name-nondirectory file) 1 -1))) - (setq buf (find-file-noselect file)) - (with-current-buffer buf - (goto-char (point-min)) - (while (re-search-forward "^INDEX: (\\(.*?\\)) \\(.*\\)" nil t) - (setq target (match-string 1) - entry (match-string 2)) - (push (list entry origfile target) index))) - (kill-buffer buf)) - (setq index (sort index (lambda (a b) (string< (downcase (car a)) - (downcase (car b)))))) - (setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory))) - (with-current-buffer ibuffer - (erase-buffer) - (insert "* Index\n") - (setq last-letter nil) - (dolist (idx index) - (setq entry (car idx) file (nth 1 idx) target (nth 2 idx)) - (if (and (stringp target) (string-match "\\S-" target)) - (setq tgext (concat "::#" target)) - (setq tgext "")) - (setq letter (upcase (substring entry 0 1))) - (when (not (equal letter last-letter)) - (insert "** " letter "\n") - (setq last-letter letter)) - (if (string-match "!" entry) - (setq main (substring entry 0 (match-beginning 0)) - sub (substring entry (match-end 0))) - (setq main nil sub nil last-main nil)) - (when (and main (not (equal main last-main))) - (insert " - " main "\n") - (setq last-main main)) - (setq link (concat "[[file:" file tgext "]" - "[" (or sub entry) "]]")) - (if (and main sub) - (insert " - " link "\n") - (insert " - " link "\n"))) - (save-buffer)) - (kill-buffer ibuffer) - ;; Create theindex.org if it doesn't exist already - (let ((index-file (expand-file-name "theindex.org" directory))) - (unless (file-exists-p index-file) - (setq ibuffer (find-file-noselect index-file)) - (with-current-buffer ibuffer - (erase-buffer) - (insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n") - (save-buffer)) - (kill-buffer ibuffer))))) - -;; Caching functions: - -(defun org-publish-write-cache-file (&optional free-cache) - "Write `org-publish-cache' to file. -If FREE-CACHE, empty the cache." - (or org-publish-cache - (error "`org-publish-write-cache-file' called, but no cache present")) - - (let ((cache-file (org-publish-cache-get ":cache-file:"))) - (or cache-file - (error "Cannot find cache-file name in `org-publish-write-cache-file'")) - (with-temp-file cache-file - (let ((print-level nil) - (print-length nil)) - (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n") - (maphash (lambda (k v) - (insert - (format (concat "(puthash %S " - (if (or (listp v) (symbolp v)) - "'" "") - "%S org-publish-cache)\n") k v))) - org-publish-cache))) - (when free-cache (org-publish-reset-cache)))) - -(defun org-publish-initialize-cache (project-name) - "Initialize the projects cache if not initialized yet and return it." - - (or project-name - (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'")) - - (unless (file-exists-p org-publish-timestamp-directory) - (make-directory org-publish-timestamp-directory t)) - (if (not (file-directory-p org-publish-timestamp-directory)) - (error "Org publish timestamp: %s is not a directory" - org-publish-timestamp-directory)) - - (unless (and org-publish-cache - (string= (org-publish-cache-get ":project:") project-name)) - (let* ((cache-file (concat - (expand-file-name org-publish-timestamp-directory) - project-name - ".cache")) - (cexists (file-exists-p cache-file))) - - (when org-publish-cache - (org-publish-reset-cache)) - - (if cexists - (load-file cache-file) - (setq org-publish-cache - (make-hash-table :test 'equal :weakness nil :size 100)) - (org-publish-cache-set ":project:" project-name) - (org-publish-cache-set ":cache-file:" cache-file)) - (unless cexists (org-publish-write-cache-file nil)))) - org-publish-cache) - -(defun org-publish-reset-cache () - "Empty org-publish-cache and reset it nil." - (message "%s" "Resetting org-publish-cache") - (if (hash-table-p org-publish-cache) - (clrhash org-publish-cache)) - (setq org-publish-cache nil)) - -(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func base-dir) - "Check the timestamp of the last publishing of FILENAME. -Return `t', if the file needs publishing. The function also -checks if any included files have been more recently published, -so that the file including them will be republished as well." - (or org-publish-cache - (error "`org-publish-cache-file-needs-publishing' called, but no cache present")) - (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func)) - (pstamp (org-publish-cache-get key)) - (visiting (find-buffer-visiting filename)) - (case-fold-search t) - included-files-ctime buf) - - (when (equal (file-name-extension filename) "org") - (setq buf (find-file (expand-file-name filename))) - (with-current-buffer buf - (goto-char (point-min)) - (while (re-search-forward "^#\\+include:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t) - (let* ((included-file (expand-file-name (match-string 1)))) - (add-to-list 'included-files-ctime - (org-publish-cache-ctime-of-src included-file) t)))) - ;; FIXME don't kill current buffer - (unless visiting (kill-buffer buf))) - (if (null pstamp) - t - (let ((ctime (org-publish-cache-ctime-of-src filename))) - (or (< pstamp ctime) - (when included-files-ctime - (not (null (delq nil (mapcar (lambda(ct) (< ctime ct)) - included-files-ctime)))))))))) - -(defun org-publish-cache-set-file-property (filename property value &optional project-name) - "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE. -Use cache file of PROJECT-NAME. If the entry does not exist, it will be -created. Return VALUE." - ;; Evtl. load the requested cache file: - (if project-name (org-publish-initialize-cache project-name)) - (let ((pl (org-publish-cache-get filename))) - (if pl - (progn - (plist-put pl property value) - value) - (org-publish-cache-get-file-property - filename property value nil project-name)))) - -(defun org-publish-cache-get-file-property - (filename property &optional default no-create project-name) - "Return the value for a PROPERTY of file FILENAME in publishing cache. -Use cache file of PROJECT-NAME. Return the value of that PROPERTY or -DEFAULT, if the value does not yet exist. -If the entry will be created, unless NO-CREATE is not nil." - ;; Evtl. load the requested cache file: - (if project-name (org-publish-initialize-cache project-name)) - (let ((pl (org-publish-cache-get filename)) - (retval nil)) - (if pl - (if (plist-member pl property) - (setq retval (plist-get pl property)) - (setq retval default)) - ;; no pl yet: - (unless no-create - (org-publish-cache-set filename (list property default))) - (setq retval default)) - retval)) - -(defun org-publish-cache-get (key) - "Return the value stored in `org-publish-cache' for key KEY. -Returns nil, if no value or nil is found, or the cache does not -exist." - (or org-publish-cache - (error "`org-publish-cache-get' called, but no cache present")) - (gethash key org-publish-cache)) - -(defun org-publish-cache-set (key value) - "Store KEY VALUE pair in `org-publish-cache'. -Returns value on success, else nil." - (or org-publish-cache - (error "`org-publish-cache-set' called, but no cache present")) - (puthash key value org-publish-cache)) - -(defun org-publish-cache-ctime-of-src (file) - "Get the ctime of filename F as an integer." - (let ((attr (file-attributes - (expand-file-name (or (file-symlink-p file) file) - (file-name-directory file))))) - (+ (lsh (car (nth 5 attr)) 16) - (cadr (nth 5 attr))))) - -(provide 'org-publish) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-publish.el ends here diff --git a/lisp/org-remember.el b/lisp/org-remember.el deleted file mode 100644 index cb1fdbbb9..000000000 --- a/lisp/org-remember.el +++ /dev/null @@ -1,1156 +0,0 @@ -;;; org-remember.el --- Fast note taking in Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains the system to take fast notes with Org-mode. -;; This system is used together with John Wiegley's `remember.el'. - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'org) -(require 'org-compat) -(require 'org-datetree) - -(declare-function remember-mode "remember" ()) -(declare-function remember "remember" (&optional initial)) -(declare-function remember-buffer-desc "remember" ()) -(declare-function remember-finalize "remember" ()) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -(defvar remember-save-after-remembering) -(defvar remember-register) -(defvar remember-buffer) -(defvar remember-handler-functions) -(defvar remember-annotation-functions) -(defvar org-clock-heading) -(defvar org-clock-heading-for-remember) - -(defgroup org-remember nil - "Options concerning interaction with remember.el." - :tag "Org Remember" - :group 'org) - -(defcustom org-remember-store-without-prompt t - "Non-nil means \\\\[org-remember-finalize] \ -stores the remember note without further prompts. -It then uses the file and headline specified by the template or (if the -template does not specify them) by the variables `org-default-notes-file' -and `org-remember-default-headline'. To force prompting anyway, use -\\[universal-argument] \\[org-remember-finalize] to file the note. - -When this variable is nil, \\[org-remember-finalize] gives you the prompts, and -\\[universal-argument] \\[org-remember-finalize] triggers the fast track." - :group 'org-remember - :type 'boolean) - -(defcustom org-remember-interactive-interface 'refile - "The interface to be used for interactive filing of remember notes. -This is only used when the interactive mode for selecting a filing -location is used (see the variable `org-remember-store-without-prompt'). -Allowed values are: -outline The interface shows an outline of the relevant file - and the correct heading is found by moving through - the outline or by searching with incremental search. -outline-path-completion Headlines in the current buffer are offered via - completion. -refile Use the refile interface, and offer headlines, - possibly from different buffers." - :group 'org-remember - :type '(choice - (const :tag "Refile" refile) - (const :tag "Outline" outline) - (const :tag "Outline-path-completion" outline-path-completion))) - -(defcustom org-remember-default-headline "" - "The headline that should be the default location in the notes file. -When filing remember notes, the cursor will start at that position. -You can set this on a per-template basis with the variable -`org-remember-templates'." - :group 'org-remember - :type 'string) - -(defcustom org-remember-templates nil - "Templates for the creation of remember buffers. -When nil, just let remember make the buffer. -When non-nil, this is a list of (up to) 6-element lists. In each entry, -the first element is the name of the template, which should be a single -short word. The second element is a character, a unique key to select -this template. The third element is the template. - -The fourth element is optional and can specify a destination file for -remember items created with this template. The default file is given -by `org-default-notes-file'. If the file name is not an absolute path, -it will be interpreted relative to `org-directory'. - -An optional fifth element can specify the headline in that file that should -be offered first when the user is asked to file the entry. The default -headline is given in the variable `org-remember-default-headline'. When -this element is `top' or `bottom', the note will be placed as a level-1 -entry at the beginning or end of the file, respectively. - -An optional sixth element specifies the contexts in which the template -will be offered to the user. This element can be a list of major modes -or a function, and the template will only be offered if `org-remember' -is called from a mode in the list, or if the function returns t. -Templates that specify t or nil for the context will always be added -to the list of selectable templates. - -The template specifies the structure of the remember buffer. It should have -a first line starting with a star, to act as the org-mode headline. -Furthermore, the following %-escapes will be replaced with content: - - %^{PROMPT} prompt the user for a string and replace this sequence with it. - A default value and a completion table can be specified like this: - %^{prompt|default|completion2|completion3|...} - The arrow keys access a prompt-specific history. - %a annotation, normally the link created with `org-store-link' - %A like %a, but prompt for the description part - %i initial content, copied from the active region. If %i is - indented, the entire inserted text will be indented as well. - %t time stamp, date only - %T time stamp with date and time - %u, %U like the above, but inactive time stamps - %^t like %t, but prompt for date. Similarly %^T, %^u, %^U. - You may define a prompt like %^{Please specify birthday}t - %n user name (taken from `user-full-name') - %c current kill ring head - %x content of the X clipboard - %:keyword specific information for certain link types, see below - %^C interactive selection of which kill or clip to use - %^L like %^C, but insert as link - %k title of the currently clocked task - %K link to the currently clocked task - %^g prompt for tags, completing tags in the target file - %^G prompt for tags, completing all tags in all agenda files - %^{PROP}p Prompt the user for a value for property PROP - %[PATHNAME] insert the contents of the file given by PATHNAME - %(SEXP) evaluate elisp `(SEXP)' and replace with the result - %! store this note immediately after completing the template\ - \\ - (skipping the \\[org-remember-finalize] that normally triggers storing) - %& jump to target location immediately after storing note - %? after completing the template, position cursor here. - -Apart from these general escapes, you can access information specific to the -link type that is created. For example, calling `remember' in emails or gnus -will record the author and the subject of the message, which you can access -with %:fromname and %:subject, respectively. Here is a complete list of what -is recorded for each link type. - -Link type | Available information --------------------+------------------------------------------------------ -bbdb | %:type %:name %:company -vm, wl, mh, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress - | %:to %:toname %:toaddress - | %:fromto (either \"to NAME\" or \"from NAME\") -gnus | %:group, for messages also all email fields and - | %:org-date (the Date: header in Org format) -w3, w3m | %:type %:url -info | %:type %:file %:node -calendar | %:type %:date" - :group 'org-remember - :get (lambda (var) ; Make sure all entries have at least 5 elements - (mapcar (lambda (x) - (if (not (stringp (car x))) (setq x (cons "" x))) - (cond ((= (length x) 4) (append x '(nil))) - ((= (length x) 3) (append x '(nil nil))) - (t x))) - (default-value var))) - :type '(repeat - :tag "enabled" - (list :value ("" ?a "\n" nil nil nil) - (string :tag "Name") - (character :tag "Selection Key") - (string :tag "Template") - (choice :tag "Destination file" - (file :tag "Specify") - (function :tag "Function") - (const :tag "Use `org-default-notes-file'" nil)) - (choice :tag "Destin. headline" - (string :tag "Specify") - (function :tag "Function") - (const :tag "Use `org-remember-default-headline'" nil) - (const :tag "At beginning of file" top) - (const :tag "At end of file" bottom) - (const :tag "In a date tree" date-tree)) - (choice :tag "Context" - (const :tag "Use in all contexts" nil) - (const :tag "Use in all contexts" t) - (repeat :tag "Use only if in major mode" - (symbol :tag "Major mode")) - (function :tag "Perform a check against function"))))) - -(defcustom org-remember-delete-empty-lines-at-end t - "Non-nil means clean up final empty lines in remember buffer." - :group 'org-remember - :type 'boolean) - -(defcustom org-remember-before-finalize-hook nil - "Hook that is run right before a remember process is finalized. -The remember buffer is still current when this hook runs." - :group 'org-remember - :type 'hook) - -(defvar org-remember-mode-map (make-sparse-keymap) - "Keymap for `org-remember-mode', a minor mode. -Use this map to set additional keybindings for when Org-mode is used -for a Remember buffer.") -(defvar org-remember-mode-hook nil - "Hook for the minor `org-remember-mode'.") - -(define-minor-mode org-remember-mode - "Minor mode for special key bindings in a remember buffer." - nil " Rem" org-remember-mode-map - (run-hooks 'org-remember-mode-hook)) -(define-key org-remember-mode-map "\C-c\C-c" 'org-remember-finalize) -(define-key org-remember-mode-map "\C-c\C-k" 'org-remember-kill) - -(defcustom org-remember-clock-out-on-exit 'query - "Non-nil means stop the clock when exiting a clocking remember buffer. -This only applies if the clock is running in the remember buffer. If the -clock is not stopped, it continues to run in the storage location. -Instead of nil or t, this may also be the symbol `query' to prompt the -user each time a remember buffer with a running clock is filed away." - :group 'org-remember - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "Query user" query))) - -(defcustom org-remember-backup-directory nil - "Directory where to store all remember buffers, for backup purposes. -After a remember buffer has been stored successfully, the backup file -will be removed. However, if you forget to finish the remember process, -the file will remain there. -See also `org-remember-auto-remove-backup-files'." - :group 'org-remember - :type '(choice - (const :tag "No backups" nil) - (directory :tag "Directory"))) - -(defcustom org-remember-auto-remove-backup-files t - "Non-nil means remove remember backup files after successfully storage. -When remember is finished successfully, with storing the note at the -desired target, remove the backup files related to this remember process -and show a message about remaining backup files, from previous, unfinished -remember sessions. -Backup files will only be made at all, when `org-remember-backup-directory' -is set." - :group 'org-remember - :type 'boolean) - -(defcustom org-remember-warn-about-backups t - "Non-nil means warn about backup files in `org-remember-backup-directory'. - -Set this to nil if you find that you don't need the warning. - -If you cancel remember calls frequently and know when they -contain useful information (because you know that you made an -error or Emacs crashed, for example) nil is more useful. In the -opposite case, the default, t, is more useful." - :group 'org-remember - :type 'boolean) - -;;;###autoload -(defun org-remember-insinuate () - "Setup remember.el for use with Org-mode." - (org-require-remember) - (setq remember-annotation-functions '(org-remember-annotation)) - (setq remember-handler-functions '(org-remember-handler)) - (add-hook 'remember-mode-hook 'org-remember-apply-template)) - -;;;###autoload -(defun org-remember-annotation () - "Return a link to the current location as an annotation for remember.el. -If you are using Org-mode files as target for data storage with -remember.el, then the annotations should include a link compatible with the -conventions in Org-mode. This function returns such a link." - (org-store-link nil)) - -(defconst org-remember-help - "Select a destination location for the note. -UP/DOWN=headline TAB=cycle visibility [Q]uit RET//=Store -RET on headline -> Store as sublevel entry to current headline -RET at beg-of-buf -> Append to file as level 2 headline -/ -> before/after current headline, same headings level") - -(defvar org-jump-to-target-location nil) -(defvar org-remember-previous-location nil) -(defvar org-remember-reference-date nil) -(defvar org-force-remember-template-char) ;; dynamically scoped - -;; Save the major mode of the buffer we called remember from -(defvar org-select-template-temp-major-mode nil) - -;; Temporary store the buffer where remember was called from -(defvar org-select-template-original-buffer nil) - -(defun org-select-remember-template (&optional use-char) - (when org-remember-templates - (let* ((pre-selected-templates - (mapcar - (lambda (tpl) - (let ((ctxt (nth 5 tpl)) - (mode org-select-template-temp-major-mode) - (buf org-select-template-original-buffer)) - (and (or (not ctxt) (eq ctxt t) - (and (listp ctxt) (memq mode ctxt)) - (and (functionp ctxt) - (with-current-buffer buf - ;; Protect the user-defined function from error - (condition-case nil (funcall ctxt) (error nil))))) - tpl))) - org-remember-templates)) - ;; If no template at this point, add the default templates: - (pre-selected-templates1 - (if (not (delq nil pre-selected-templates)) - (mapcar (lambda(x) (if (not (nth 5 x)) x)) - org-remember-templates) - pre-selected-templates)) - ;; Then unconditionally add template for any contexts - (pre-selected-templates2 - (append (mapcar (lambda(x) (if (eq (nth 5 x) t) x)) - org-remember-templates) - (delq nil pre-selected-templates1))) - (templates (mapcar (lambda (x) - (if (stringp (car x)) - (append (list (nth 1 x) (car x)) (cddr x)) - (append (list (car x) "") (cdr x)))) - (delq nil pre-selected-templates2))) - msg - (char (or use-char - (cond - ((= (length templates) 1) - (caar templates)) - ((and (boundp 'org-force-remember-template-char) - org-force-remember-template-char) - (if (stringp org-force-remember-template-char) - (string-to-char org-force-remember-template-char) - org-force-remember-template-char)) - (t - (setq msg (format - "Select template: %s%s" - (mapconcat - (lambda (x) - (cond - ((not (string-match "\\S-" (nth 1 x))) - (format "[%c]" (car x))) - ((equal (downcase (car x)) - (downcase (aref (nth 1 x) 0))) - (format "[%c]%s" (car x) - (substring (nth 1 x) 1))) - (t (format "[%c]%s" (car x) (nth 1 x))))) - templates " ") - (if (assoc ?C templates) - "" - " [C]customize templates"))) - (let ((inhibit-quit t) char0) - (while (not char0) - (message msg) - (setq char0 (read-char-exclusive)) - (when (and (not (assoc char0 templates)) - (not (equal char0 ?\C-g)) - (not (equal char0 ?C))) - (message "No such template \"%c\"" char0) - (ding) (sit-for 1) - (setq char0 nil))) - (when (equal char0 ?\C-g) - (jump-to-register remember-register) - (kill-buffer remember-buffer) - (error "Abort")) - (when (not (assoc char0 templates)) - (jump-to-register remember-register) - (kill-buffer remember-buffer) - (customize-variable 'org-remember-templates) - (error "Customize templates")) - char0)))))) - (cddr (assoc char templates))))) - -;;;###autoload -(defun org-remember-apply-template (&optional use-char skip-interactive) - "Initialize *remember* buffer with template, invoke `org-mode'. -This function should be placed into `remember-mode-hook' and in fact requires -to be run from that hook to function properly." - (when (and (boundp 'initial) (stringp initial)) - (setq initial (org-no-properties initial))) - (if org-remember-templates - (let* ((entry (org-select-remember-template use-char)) - (ct (or org-overriding-default-time (org-current-time))) - (dct (decode-time ct)) - (ct1 - (if (< (nth 2 dct) org-extend-today-until) - (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) - ct)) - (tpl (car entry)) - (plist-p (if org-store-link-plist t nil)) - (file (if (and (nth 1 entry) - (or (and (stringp (nth 1 entry)) - (string-match "\\S-" (nth 1 entry))) - (functionp (nth 1 entry)))) - (nth 1 entry) - org-default-notes-file)) - (headline (nth 2 entry)) - (v-c (and (> (length kill-ring) 0) (current-kill 0))) - (v-x (or (org-get-x-clipboard 'PRIMARY) - (org-get-x-clipboard 'CLIPBOARD) - (org-get-x-clipboard 'SECONDARY))) - (v-t (format-time-string (car org-time-stamp-formats) ct)) - (v-T (format-time-string (cdr org-time-stamp-formats) ct)) - (v-u (concat "[" (substring v-t 1 -1) "]")) - (v-U (concat "[" (substring v-T 1 -1) "]")) - ;; `initial' and `annotation' are bound in `remember'. - ;; But if the property list has them, we prefer those values - (v-i (or (plist-get org-store-link-plist :initial) - (and (boundp 'initial) (symbol-value 'initial)) - "")) - (v-a (or (plist-get org-store-link-plist :annotation) - (and (boundp 'annotation) (symbol-value 'annotation)) - "")) - ;; Is the link empty? Then we do not want it... - (v-a (if (equal v-a "[[]]") "" v-a)) - (clipboards (remove nil (list v-i - (org-get-x-clipboard 'PRIMARY) - (org-get-x-clipboard 'CLIPBOARD) - (org-get-x-clipboard 'SECONDARY) - v-c))) - (v-A (if (and v-a - (string-match "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a)) - (replace-match "[\\1[%^{Link description}]]" nil nil v-a) - v-a)) - (v-n user-full-name) - (v-k (if (marker-buffer org-clock-marker) - (org-no-properties org-clock-heading))) - (v-K (if (marker-buffer org-clock-marker) - (org-make-link-string - (buffer-file-name (marker-buffer org-clock-marker)) - org-clock-heading))) - v-I - (org-startup-folded nil) - (org-inhibit-startup t) - org-time-was-given org-end-time-was-given x - prompt completions char time pos default histvar) - - (when (functionp file) - (setq file (funcall file))) - (when (functionp headline) - (setq headline (funcall headline))) - (when (and file (not (file-name-absolute-p file))) - (setq file (expand-file-name file org-directory))) - - (setq org-store-link-plist - (plist-put org-store-link-plist :annotation v-a) - org-store-link-plist - (plist-put org-store-link-plist :initial v-i)) - - (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1)) - (erase-buffer) - (insert (substitute-command-keys - (format - "# %s \"%s\" -> \"* %s\" -# C-u C-c C-c like C-c C-c, and immediately visit note at target location -# C-0 C-c C-c \"%s\" -> \"* %s\" -# %s to select file and header location interactively. -# C-2 C-c C-c as child (C-3: as sibling) of the currently clocked item -# To switch templates, use `\\[org-remember]'. To abort use `C-c C-k'.\n\n" - (if org-remember-store-without-prompt " C-c C-c" " C-1 C-c C-c") - (abbreviate-file-name (or file org-default-notes-file)) - (or headline "") - (or (car org-remember-previous-location) "???") - (or (cdr org-remember-previous-location) "???") - (if org-remember-store-without-prompt "C-1 C-c C-c" " C-c C-c")))) - (insert tpl) - - ;; %[] Insert contents of a file. - (goto-char (point-min)) - (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) - (unless (org-remember-escaped-%) - (let ((start (match-beginning 0)) - (end (match-end 0)) - (filename (expand-file-name (match-string 1)))) - (goto-char start) - (delete-region start end) - (condition-case error - (insert-file-contents filename) - (error (insert (format "%%![Couldn't insert %s: %s]" - filename error))))))) - ;; Simple %-escapes - (goto-char (point-min)) - (let ((init (and (boundp 'initial) - (symbol-value 'initial)))) - (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) - (unless (org-remember-escaped-%) - (when (and init (equal (match-string 0) "%i")) - (save-match-data - (let* ((lead (buffer-substring - (point-at-bol) (match-beginning 0)))) - (setq v-i (mapconcat 'identity - (org-split-string init "\n") - (concat "\n" lead)))))) - (replace-match - (or (eval (intern (concat "v-" (match-string 1)))) "") - t t)))) - - ;; %() embedded elisp - (goto-char (point-min)) - (while (re-search-forward "%\\((.+)\\)" nil t) - (unless (org-remember-escaped-%) - (goto-char (match-beginning 0)) - (let ((template-start (point))) - (forward-char 1) - (let ((result - (condition-case error - (eval (read (current-buffer))) - (error (format "%%![Error: %s]" error))))) - (delete-region template-start (point)) - (insert result))))) - - ;; From the property list - (when plist-p - (goto-char (point-min)) - (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) - (unless (org-remember-escaped-%) - (and (setq x (or (plist-get org-store-link-plist - (intern (match-string 1))) "")) - (replace-match x t t))))) - - ;; Turn on org-mode in the remember buffer, set local variables - (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1)) - (if (and file (string-match "\\S-" file) (not (file-directory-p file))) - (org-set-local 'org-default-notes-file file)) - (if headline - (org-set-local 'org-remember-default-headline headline)) - (org-set-local 'org-remember-reference-date - (list (nth 4 dct) (nth 3 dct) (nth 5 dct))) - ;; Interactive template entries - (goto-char (point-min)) - (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) - (unless (org-remember-escaped-%) - (setq char (if (match-end 3) (match-string 3)) - prompt (if (match-end 2) (match-string 2))) - (goto-char (match-beginning 0)) - (replace-match "") - (setq completions nil default nil) - (when prompt - (setq completions (org-split-string prompt "|") - prompt (pop completions) - default (car completions) - histvar (intern (concat - "org-remember-template-prompt-history::" - (or prompt ""))) - completions (mapcar 'list completions))) - (cond - ((member char '("G" "g")) - (let* ((org-last-tags-completion-table - (org-global-tags-completion-table - (if (equal char "G") (org-agenda-files) (and file (list file))))) - (org-add-colon-after-tag-completion t) - (ins (org-icompleting-read - (if prompt (concat prompt ": ") "Tags: ") - 'org-tags-completion-function nil nil nil - 'org-tags-history))) - (setq ins (mapconcat 'identity - (org-split-string ins (org-re "[^[:alnum:]_@#%]+")) - ":")) - (when (string-match "\\S-" ins) - (or (equal (char-before) ?:) (insert ":")) - (insert ins) - (or (equal (char-after) ?:) (insert ":"))))) - ((equal char "C") - (cond ((= (length clipboards) 1) (insert (car clipboards))) - ((> (length clipboards) 1) - (insert (read-string "Clipboard/kill value: " - (car clipboards) '(clipboards . 1) - (car clipboards)))))) - ((equal char "L") - (cond ((= (length clipboards) 1) - (org-insert-link 0 (car clipboards))) - ((> (length clipboards) 1) - (org-insert-link 0 (read-string "Clipboard/kill value: " - (car clipboards) - '(clipboards . 1) - (car clipboards)))))) - ((equal char "p") - (let* - ((prop (org-no-properties prompt)) - (pall (concat prop "_ALL")) - (allowed - (with-current-buffer - (or (find-buffer-visiting file) - (find-file-noselect file)) - (or (cdr (assoc pall org-file-properties)) - (cdr (assoc pall org-global-properties)) - (cdr (assoc pall org-global-properties-fixed))))) - (existing (with-current-buffer - (or (find-buffer-visiting file) - (find-file-noselect file)) - (mapcar 'list (org-property-values prop)))) - (propprompt (concat "Value for " prop ": ")) - (val (if allowed - (org-completing-read - propprompt - (mapcar 'list (org-split-string allowed "[ \t]+")) - nil 'req-match) - (org-completing-read-no-i propprompt existing nil nil - "" nil "")))) - (org-set-property prop val))) - (char - ;; These are the date/time related ones - (setq org-time-was-given (equal (upcase char) char)) - (setq time (org-read-date (equal (upcase char) "U") t nil - prompt)) - (org-insert-time-stamp time org-time-was-given - (member char '("u" "U")) - nil nil (list org-end-time-was-given))) - (t - (let (org-completion-use-ido) - (insert (org-without-partial-completion - (org-completing-read-no-i - (concat (if prompt prompt "Enter string") - (if default (concat " [" default "]")) - ": ") - completions nil nil nil histvar default)))))))) - - (goto-char (point-min)) - (if (re-search-forward "%\\?" nil t) - (replace-match "") - (and (re-search-forward "^[^#\n]" nil t) (backward-char 1)))) - (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1))) - (when (save-excursion - (goto-char (point-min)) - (re-search-forward "%&" nil t)) - (replace-match "") - (org-set-local 'org-jump-to-target-location t)) - (when org-remember-backup-directory - (unless (file-directory-p org-remember-backup-directory) - (make-directory org-remember-backup-directory)) - (org-set-local 'auto-save-file-name-transforms nil) - (setq buffer-file-name - (expand-file-name - (format-time-string "remember-%Y-%m-%d-%H-%M-%S") - org-remember-backup-directory)) - (save-buffer) - (org-set-local 'auto-save-visited-file-name t) - (auto-save-mode 1)) - (when (save-excursion - (goto-char (point-min)) - (re-search-forward "%!" nil t)) - (replace-match "") - (add-hook 'post-command-hook 'org-remember-finish-immediately 'append))) - -(defun org-remember-escaped-% () - (if (equal (char-before (match-beginning 0)) ?\\) - (progn - (delete-region (1- (match-beginning 0)) (match-beginning 0)) - t) - nil)) - - -(defun org-remember-finish-immediately () - "File remember note immediately. -This should be run in `post-command-hook' and will remove itself -from that hook." - (remove-hook 'post-command-hook 'org-remember-finish-immediately) - (org-remember-finalize)) - -(defun org-remember-visit-immediately () - "File remember note immediately. -This should be run in `post-command-hook' and will remove itself -from that hook." - (org-remember '(16)) - (goto-char (or (text-property-any - (point) (save-excursion (org-end-of-subtree t t)) - 'org-position-cursor t) - (point))) - (message "%s" - (format - (substitute-command-keys - "Restore window configuration with \\[jump-to-register] %c") - remember-register))) - -(defvar org-clock-marker) ; Defined in org.el -(defun org-remember-finalize () - "Finalize the remember process." - (interactive) - (unless org-remember-mode - (error "This does not seem to be a remember buffer for Org-mode")) - (run-hooks 'org-remember-before-finalize-hook) - (unless (fboundp 'remember-finalize) - (defalias 'remember-finalize 'remember-buffer)) - (when (and org-clock-marker - (equal (marker-buffer org-clock-marker) (current-buffer))) - ;; the clock is running in this buffer. - (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) - (or (eq org-remember-clock-out-on-exit t) - (and org-remember-clock-out-on-exit - (y-or-n-p "The clock is running in this buffer. Clock out now? ")))) - (let (org-log-note-clock-out) (org-clock-out)))) - (when buffer-file-name - (do-auto-save)) - (remember-finalize)) - -(defun org-remember-kill () - "Abort the current remember process." - (interactive) - (let ((org-note-abort t)) - (org-remember-finalize))) - -;;;###autoload -(defun org-remember (&optional goto org-force-remember-template-char) - "Call `remember'. If this is already a remember buffer, re-apply template. -If there is an active region, make sure remember uses it as initial content -of the remember buffer. - -When called interactively with a \\[universal-argument] \ -prefix argument GOTO, don't remember -anything, just go to the file/headline where the selected template usually -stores its notes. With a double prefix argument \ -\\[universal-argument] \\[universal-argument], go to the last -note stored by remember. - -Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character -associated with a template in `org-remember-templates'." - (interactive "P") - (org-require-remember) - (cond - ((equal goto '(4)) (org-go-to-remember-target)) - ((equal goto '(16)) (org-remember-goto-last-stored)) - (t - ;; set temporary variables that will be needed in - ;; `org-select-remember-template' - (setq org-select-template-temp-major-mode major-mode) - (setq org-select-template-original-buffer (current-buffer)) - (if org-remember-mode - (progn - (when (< (length org-remember-templates) 2) - (error "No other template available")) - (erase-buffer) - (let ((annotation (plist-get org-store-link-plist :annotation)) - (initial (plist-get org-store-link-plist :initial))) - (org-remember-apply-template)) - (message "Press C-c C-c to remember data")) - (if (org-region-active-p) - (org-do-remember (buffer-substring (point) (mark))) - (org-do-remember)))))) - -(defvar org-remember-last-stored-marker (make-marker) - "Marker pointing to the entry most recently stored with `org-remember'.") - -(defun org-remember-goto-last-stored () - "Go to the location where the last remember note was stored." - (interactive) - (org-goto-marker-or-bmk org-remember-last-stored-marker - "org-remember-last-stored") - (message "This is the last note stored by remember")) - -(defun org-go-to-remember-target (&optional template-key) - "Go to the target location of a remember template. -The user is queried for the template." - (interactive) - (let* (org-select-template-temp-major-mode - (entry (org-select-remember-template template-key)) - (file (nth 1 entry)) - (heading (nth 2 entry)) - visiting) - (unless (and file (stringp file) (string-match "\\S-" file)) - (setq file org-default-notes-file)) - (when (and file (not (file-name-absolute-p file))) - (setq file (expand-file-name file org-directory))) - (unless (and heading (stringp heading) (string-match "\\S-" heading)) - (setq heading org-remember-default-headline)) - (setq visiting (org-find-base-buffer-visiting file)) - (if (not visiting) (find-file-noselect file)) - (org-pop-to-buffer-same-window (or visiting (get-file-buffer file))) - (widen) - (goto-char (point-min)) - (if (re-search-forward - (format org-complex-heading-regexp-format (regexp-quote heading)) - nil t) - (goto-char (match-beginning 0)) - (error "Target headline not found: %s" heading)))) - -;; FIXME (bzg): let's clean up of final empty lines happen only once -;; (see the org-remember-delete-empty-lines-at-end option below) -;;;###autoload -(defun org-remember-handler () - "Store stuff from remember.el into an org file. -When the template has specified a file and a headline, the entry is filed -there, or in the location defined by `org-default-notes-file' and -`org-remember-default-headline'. -\\ -If no defaults have been defined, or if the current prefix argument -is 1 (using C-1 \\[org-remember-finalize] to exit remember), an interactive -process is used to select the target location. - -When the prefix is 0 (i.e. when remember is exited with \ -C-0 \\[org-remember-finalize]), -the entry is filed to the same location as the previous note. - -When the prefix is 2 (i.e. when remember is exited with \ -C-2 \\[org-remember-finalize]), -the entry is filed as a subentry of the entry where the clock is -currently running. - -When \\[universal-argument] has been used as prefix argument, the -note is stored and Emacs moves point to the new location of the -note, so that editing can be continued there (similar to -inserting \"%&\" into the template). - -Before storing the note, the function ensures that the text has an -org-mode-style headline, i.e. a first line that starts with -a \"*\". If not, a headline is constructed from the current date and -some additional data. - -If the variable `org-adapt-indentation' is non-nil, the entire text is -also indented so that it starts in the same column as the headline -\(i.e. after the stars). - -See also the variable `org-reverse-note-order'." - (when (and (equal current-prefix-arg 2) - (not (marker-buffer org-clock-marker))) - (error "No running clock")) - (when (org-bound-and-true-p org-jump-to-target-location) - (let* ((end (min (point-max) (1+ (point)))) - (beg (point))) - (if (= end beg) (setq beg (1- beg))) - (put-text-property beg end 'org-position-cursor t))) - (goto-char (point-min)) - (while (looking-at "^[ \t]*\n\\|^# .*\n") - (replace-match "")) - (when org-remember-delete-empty-lines-at-end - (goto-char (point-max)) - (beginning-of-line 1) - (while (and (looking-at "[ \t]*$\\|[ \t]*# .*") (> (point) 1)) - (delete-region (1- (point)) (point-max)) - (beginning-of-line 1))) - (catch 'quit - (if org-note-abort (throw 'quit t)) - (let* ((visitp (org-bound-and-true-p org-jump-to-target-location)) - (backup-file - (and buffer-file-name - (equal (file-name-directory buffer-file-name) - (file-name-as-directory - (expand-file-name org-remember-backup-directory))) - (string-match "^remember-[0-9]\\{4\\}" - (file-name-nondirectory buffer-file-name)) - buffer-file-name)) - - (dummy - (unless (string-match "\\S-" (buffer-string)) - (message "Nothing to remember") - (and backup-file - (ignore-errors - (delete-file backup-file) - (delete-file (concat backup-file "~")))) - (set-buffer-modified-p nil) - (throw 'quit t))) - (reference-date org-remember-reference-date) - (previousp (and (member current-prefix-arg '((16) 0)) - org-remember-previous-location)) - (clockp (equal current-prefix-arg 2)) - (clocksp (equal current-prefix-arg 3)) - (fastp (org-xor (equal current-prefix-arg 1) - org-remember-store-without-prompt)) - (file (cond - (fastp org-default-notes-file) - ((and (eq org-remember-interactive-interface 'refile) - org-refile-targets) - org-default-notes-file) - ((not previousp) - (org-get-org-file)))) - (heading org-remember-default-headline) - (visiting (and file (org-find-base-buffer-visiting file))) - (org-startup-folded nil) - (org-startup-align-all-tables nil) - (org-goto-start-pos 1) - spos exitcmd level reversed txt text-before-node-creation) - (when (equal current-prefix-arg '(4)) - (setq visitp t)) - (when previousp - (setq file (car org-remember-previous-location) - visiting (and file (org-find-base-buffer-visiting file)) - heading (cdr org-remember-previous-location) - fastp t)) - (when (or clockp clocksp) - (setq file (buffer-file-name (marker-buffer org-clock-marker)) - visiting (and file (org-find-base-buffer-visiting file)) - heading org-clock-heading-for-remember - fastp t)) - (setq current-prefix-arg nil) - ;; Modify text so that it becomes a nice subtree which can be inserted - ;; into an org tree. - (when org-remember-delete-empty-lines-at-end - (goto-char (point-min)) - (if (re-search-forward "[ \t\n]+\\'" nil t) - ;; remove empty lines at end - (replace-match ""))) - (goto-char (point-min)) - (setq text-before-node-creation (buffer-string)) - (unless (looking-at org-outline-regexp) - ;; add a headline - (insert (concat "* " (current-time-string) - " (" (remember-buffer-desc) ")\n")) - (backward-char 1) - (when org-adapt-indentation - (while (re-search-forward "^" nil t) - (insert " ")))) - ;; Delete final empty lines - (when org-remember-delete-empty-lines-at-end - (goto-char (point-min)) - (if (re-search-forward "\n[ \t]*\n[ \t\n]*\\'" nil t) - (replace-match "\n\n") - (if (re-search-forward "[ \t\n]*\\'") - (replace-match "\n")))) - (goto-char (point-min)) - (setq txt (buffer-string)) - (org-save-markers-in-region (point-min) (point-max)) - (set-buffer-modified-p nil) - (when (and (eq org-remember-interactive-interface 'refile) - (not fastp)) - (org-refile nil (or visiting (find-file-noselect file))) - (and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately)) - (save-excursion - (bookmark-jump "org-refile-last-stored") - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - (throw 'quit t)) - ;; Find the file - (with-current-buffer (or visiting (find-file-noselect file)) - (unless (or (derived-mode-p 'org-mode) (member heading '(top bottom))) - (error "Target files for notes must be in Org-mode if not filing to top/bottom")) - (save-excursion - (save-restriction - (widen) - (setq reversed (org-notes-order-reversed-p)) - - ;; Find the default location - (when heading - (cond - ((not (derived-mode-p 'org-mode)) - (if (eq heading 'top) - (goto-char (point-min)) - (goto-char (point-max)) - (or (bolp) (newline))) - (insert text-before-node-creation) - (when remember-save-after-remembering - (save-buffer) - (if (not visiting) (kill-buffer (current-buffer)))) - (throw 'quit t)) - ((eq heading 'top) - (goto-char (point-min)) - (or (looking-at org-outline-regexp) - (re-search-forward org-outline-regexp nil t)) - (setq org-goto-start-pos (or (match-beginning 0) (point-min)))) - ((eq heading 'bottom) - (goto-char (point-max)) - (or (bolp) (newline)) - (setq org-goto-start-pos (point))) - ((eq heading 'date-tree) - (org-datetree-find-date-create reference-date) - (setq reversed nil) - (setq org-goto-start-pos (point))) - ((and (stringp heading) (string-match "\\S-" heading)) - (goto-char (point-min)) - (if (re-search-forward - (format org-complex-heading-regexp-format - (regexp-quote heading)) - nil t) - (setq org-goto-start-pos (match-beginning 0)) - (when fastp - (goto-char (point-max)) - (unless (bolp) (newline)) - (insert "* " heading "\n") - (setq org-goto-start-pos (point-at-bol 0))))) - (t (goto-char (point-min)) (setq org-goto-start-pos (point) - heading 'top)))) - - ;; Ask the User for a location, using the appropriate interface - (cond - ((and fastp (memq heading '(top bottom))) - (setq spos org-goto-start-pos - exitcmd (if (eq heading 'top) 'left nil))) - (fastp (setq spos org-goto-start-pos - exitcmd 'return)) - ((eq org-remember-interactive-interface 'outline) - (setq spos (org-get-location (current-buffer) - org-remember-help) - exitcmd (cdr spos) - spos (car spos))) - ((eq org-remember-interactive-interface 'outline-path-completion) - (let ((org-refile-targets '((nil . (:maxlevel . 10)))) - (org-refile-use-outline-path t)) - (setq spos (org-refile-get-location "Heading") - exitcmd 'return - spos (nth 3 spos)))) - (t (error "This should not happen"))) - (if (not spos) (throw 'quit nil)) ; return nil to show we did - ; not handle this note - (and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately)) - (goto-char spos) - (cond ((org-at-heading-p t) - (org-back-to-heading t) - (setq level (funcall outline-level)) - (cond - ((eq exitcmd 'return) - ;; sublevel of current - (setq org-remember-previous-location - (cons (abbreviate-file-name file) - (org-get-heading 'notags))) - (if reversed - (outline-next-heading) - (org-end-of-subtree t) - (if (not (bolp)) - (if (looking-at "[ \t]*\n") - (beginning-of-line 2) - (end-of-line 1) - (insert "\n")))) - (org-paste-subtree (if clocksp - level - (org-get-valid-level level 1)) txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - ((eq exitcmd 'left) - ;; before current - (org-paste-subtree level txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - ((eq exitcmd 'right) - ;; after current - (org-end-of-subtree t) - (org-paste-subtree level txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - (t (error "This should not happen")))) - - ((eq heading 'bottom) - (org-paste-subtree 1 txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - - ((and (bobp) (not reversed)) - ;; Put it at the end, one level below level 1 - (save-restriction - (widen) - (goto-char (point-max)) - (if (not (bolp)) (newline)) - (org-paste-subtree (org-get-valid-level 1 1) txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point)))) - - ((and (bobp) reversed) - ;; Put it at the start, as level 1 - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward org-outline-regexp-bol nil t) - (beginning-of-line 1) - (org-paste-subtree 1 txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point)))) - (t - ;; Put it right there, with automatic level determined by - ;; org-paste-subtree or from prefix arg - (org-paste-subtree - (if (numberp current-prefix-arg) current-prefix-arg) - txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point)))) - - (when remember-save-after-remembering - (save-buffer) - (if (and (not visiting) - (not (equal (marker-buffer org-clock-marker) - (current-buffer)))) - (kill-buffer (current-buffer)))) - (when org-remember-auto-remove-backup-files - (when backup-file - (ignore-errors - (delete-file backup-file) - (delete-file (concat backup-file "~")))) - (when org-remember-backup-directory - (let ((n (length - (directory-files - org-remember-backup-directory nil - "^remember-.*[0-9]$")))) - (when (and org-remember-warn-about-backups - (> n 0)) - (message - "%d backup files (unfinished remember calls) in %s" - n org-remember-backup-directory)))))))))) - - t) ;; return t to indicate that we took care of this note. - -(defun org-do-remember (&optional initial) - "Call remember." - (remember initial)) - -(defun org-require-remember () - "Make sure remember is loaded, or install our own emergency version of it." - (condition-case nil - (require 'remember) - (error - ;; Lets install our own micro version of remember - (defvar remember-register ?R) - (defvar remember-mode-hook nil) - (defvar remember-handler-functions nil) - (defvar remember-buffer "*Remember*") - (defvar remember-save-after-remembering t) - (defvar remember-annotation-functions '(buffer-file-name)) - (defun remember-finalize () - (run-hook-with-args-until-success 'remember-handler-functions) - (when (equal remember-buffer (buffer-name)) - (kill-buffer (current-buffer)) - (jump-to-register remember-register))) - (defun remember-mode () - (fundamental-mode) - (setq mode-name "Remember") - (run-hooks 'remember-mode-hook)) - (defun remember (&optional initial) - (window-configuration-to-register remember-register) - (let* ((annotation (run-hook-with-args-until-success - 'remember-annotation-functions))) - (switch-to-buffer-other-window (get-buffer-create remember-buffer)) - (remember-mode))) - (defun remember-buffer-desc () - (buffer-substring (point-min) (save-excursion (goto-char (point-min)) - (point-at-eol))))))) - -(provide 'org-remember) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-remember.el ends here diff --git a/lisp/org-special-blocks.el b/lisp/org-special-blocks.el deleted file mode 100644 index bbf5fef4b..000000000 --- a/lisp/org-special-blocks.el +++ /dev/null @@ -1,104 +0,0 @@ -;;; org-special-blocks.el --- handle Org special blocks -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Chris Gray - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; - -;; This package generalizes the #+begin_foo and #+end_foo tokens. - -;; To use, put the following in your init file: -;; -;; (require 'org-special-blocks) - -;; The tokens #+begin_center, #+begin_verse, etc. existed previously. -;; This package generalizes them (at least for the LaTeX and html -;; exporters). When a #+begin_foo token is encountered by the LaTeX -;; exporter, it is expanded into \begin{foo}. The text inside the -;; environment is not protected, as text inside environments generally -;; is. When #+begin_foo is encountered by the html exporter, a div -;; with class foo is inserted into the HTML file. It is up to the -;; user to add this class to his or her stylesheet if this div is to -;; mean anything. - -(require 'org-html) -(require 'org-compat) - -(declare-function org-open-par "org-html" ()) -(declare-function org-close-par-maybe "org-html" ()) - -(defvar org-special-blocks-ignore-regexp "^\\(LaTeX\\|HTML\\)$" - "A regexp indicating the names of blocks that should be ignored -by org-special-blocks. These blocks will presumably be -interpreted by other mechanisms.") - -(defvar org-export-current-backend) ; dynamically bound in org-exp.el -(defun org-special-blocks-make-special-cookies () - "Adds special cookies when #+begin_foo and #+end_foo tokens are -seen. This is run after a few special cases are taken care of." - (when (or (eq org-export-current-backend 'html) - (eq org-export-current-backend 'latex)) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t) - (unless (org-string-match-p org-special-blocks-ignore-regexp (match-string 2)) - (replace-match - (if (equal (downcase (match-string 1)) "begin") - (concat "ORG-" (match-string 2) "-START") - (concat "ORG-" (match-string 2) "-END")) - t t))))) - -(add-hook 'org-export-preprocess-after-blockquote-hook - 'org-special-blocks-make-special-cookies) - -(defun org-special-blocks-convert-latex-special-cookies () - "Converts the special cookies into LaTeX blocks." - (goto-char (point-min)) - (while (re-search-forward "^ORG-\\([^ \t\n]*\\)[ \t]*\\(.*\\)-\\(START\\|END\\)$" nil t) - (replace-match - (if (equal (match-string 3) "START") - (concat "\\begin{" (match-string 1) "}" (match-string 2)) - (concat "\\end{" (match-string 1) "}")) - t t))) - - -(add-hook 'org-export-latex-after-blockquotes-hook - 'org-special-blocks-convert-latex-special-cookies) - -(defvar org-line) -(defun org-special-blocks-convert-html-special-cookies () - "Converts the special cookies into div blocks." - ;; Uses the dynamically-bound variable `org-line'. - (when (and org-line (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-line)) - (message "%s" (match-string 1)) - (when (equal (match-string 2 org-line) "START") - (org-close-par-maybe) - (insert "\n
    ") - (org-open-par)) - (when (equal (match-string 2 org-line) "END") - (org-close-par-maybe) - (insert "\n
    ") - (org-open-par)) - (throw 'nextline nil))) - -(add-hook 'org-export-html-after-blockquotes-hook - 'org-special-blocks-convert-html-special-cookies) - -(provide 'org-special-blocks) - -;;; org-special-blocks.el ends here diff --git a/lisp/org-src.el b/lisp/org-src.el index 501d30ab1..81b8e4053 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -64,6 +64,30 @@ there are kept outside the narrowed region." (const :tag "from `lang' element") (const :tag "from `style' element"))))) +(defcustom org-edit-src-turn-on-auto-save nil + "Non-nil means turn `auto-save-mode' on when editing a source block. +This will save the content of the source code editing buffer into +a newly created file, not the base buffer for this source block. + +If you want to regularily save the base buffer instead of the source +code editing buffer, see `org-edit-src-auto-save-idle-delay' instead." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-edit-src-auto-save-idle-delay 0 + "Delay before saving a source code buffer back into its base buffer. +When a positive integer N, save after N seconds of idle time. +When 0 (the default), don't auto-save. + +If you want to save the source code buffer itself, don't use this. +Check `org-edit-src-turn-on-auto-save' instead." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + (defcustom org-coderef-label-format "(ref:%s)" "The default coderef format. This format string will be used to search for coderef labels in literal @@ -174,6 +198,7 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (defvar org-src-mode-map (make-sparse-keymap)) (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) +(define-key org-src-mode-map "\C-c\C-k" 'org-edit-src-abort) (define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save) (defvar org-edit-src-force-single-line nil) @@ -186,11 +211,15 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (defvar org-edit-src-block-indentation nil) (defvar org-edit-src-saved-temp-window-config nil) -(defvar org-src-ask-before-returning-to-edit-buffer t +(defcustom org-src-ask-before-returning-to-edit-buffer t "If nil, when org-edit-src code is used on a block that already has an active edit buffer, it will switch to that edit buffer immediately; otherwise it will ask whether you want to return to -the existing edit buffer.") +the existing edit buffer." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) (defvar org-src-babel-info nil) @@ -202,6 +231,7 @@ This minor mode is turned on in two situations: There is a mode hook, and keybindings for `org-edit-src-exit' and `org-edit-src-save'") +(defvar org-edit-src-code-timer nil) (defun org-edit-src-code (&optional context code edit-buffer-name) "Edit the source CODE block at point. The code is copied to a separate buffer and the appropriate mode @@ -241,8 +271,8 @@ the display of windows containing the Org buffer and the code buffer." end (move-marker end (nth 1 info)) msg (if allow-write-back-p (substitute-command-keys - "Edit, then exit with C-c ' (C-c and single quote)") - "Exit with C-c ' (C-c and single quote)") + "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort") + "Exit with C-c ' (C-c and single quote) -- C-c C-k to abort") code (or code (buffer-substring-no-properties beg end)) lang (or (cdr (assoc (nth 2 info) org-src-lang-modes)) (nth 2 info)) @@ -336,12 +366,33 @@ the display of windows containing the Org buffer and the code buffer." (org-src-mode) (set-buffer-modified-p nil) (setq buffer-file-name nil) + (when org-edit-src-turn-on-auto-save + (setq buffer-auto-save-file-name + (concat (make-temp-name "org-src-") + (format-time-string "-%Y-%d-%m") ".txt"))) (and org-edit-src-persistent-message (org-set-local 'header-line-format msg)) (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) (when (fboundp edit-prep-func) - (funcall edit-prep-func full-info)))) - t))) + (funcall edit-prep-func full-info))) + (or org-edit-src-code-timer + (setq org-edit-src-code-timer + (unless (zerop org-edit-src-auto-save-idle-delay) + (run-with-idle-timer + org-edit-src-auto-save-idle-delay t + (lambda () + (cond + ((and (string-match "\*Org Src" (buffer-name)) + (buffer-modified-p)) + (org-edit-src-save)) + ((not + (delq nil (mapcar + (lambda (b) + (string-match "\*Org Src" (buffer-name b))) + (buffer-list)))) + (cancel-timer org-edit-src-code-timer) + (setq org-edit-src-code-timer))))))))) + t))) (defun org-edit-src-continue (e) "Continue editing source blocks." ;; Fixme: be more accurate @@ -420,7 +471,7 @@ the fragment in the Org-mode buffer." (col (current-column)) (case-fold-search t) (msg (substitute-command-keys - "Edit, then exit with C-c ' (C-c and single quote)")) + "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort")) (org-mode-p (derived-mode-p 'org-mode)) (beg (make-marker)) (end (make-marker)) @@ -520,10 +571,8 @@ the language, a switch telling if the content should be in a single line." ("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex") ("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line) ("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental") - ("^[ \t]*#\\+docbook:" "\n" "xml" single-line) ("^[ \t]*#\\+macro:[ \t]+\\S-+\\( \\|$\\)" "\n" "fundamental" macro-definition) - ("^[ \t]*#\\+begin_docbook.*\n" "\n[ \t]*#\\+end_docbook" "xml") ))) (pos (point)) re1 re2 single beg end lang lfmt match-re1 ind entry) @@ -699,14 +748,17 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"." (set-buffer-modified-p nil)) (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit)) (if (eq context 'save) (save-buffer) + (with-current-buffer buffer + (set-buffer-modified-p nil)) (kill-buffer buffer)) (goto-char beg) (when allow-write-back-p - (delete-region beg (max beg end)) - (unless (string-match "\\`[ \t]*\\'" code) - (insert code)) - (goto-char beg) - (if single (just-one-space))) + (let ((buffer-undo-list t)) + (delete-region beg (max beg end)) + (unless (string-match "\\`[ \t]*\\'" code) + (insert code)) + (goto-char beg) + (if single (just-one-space)))) (if (memq t (mapcar (lambda (overlay) (eq (overlay-get overlay 'invisible) 'org-hide-block)) @@ -714,16 +766,26 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"." ;; Block is hidden; put point at start of block (beginning-of-line 0) ;; Block is visible, put point where it was in the code buffer - (org-goto-line (1- (+ (org-current-line) line))) - (org-move-to-column (if preserve-indentation col (+ col total-nindent delta)))) + (when allow-write-back-p + (org-goto-line (1- (+ (org-current-line) line))) + (org-move-to-column (if preserve-indentation col (+ col total-nindent delta))))) (unless (eq context 'save) (move-marker beg nil) (move-marker end nil))) + (when org-edit-src-code-timer + (cancel-timer org-edit-src-code-timer) + (setq org-edit-src-code-timer nil)) (unless (eq context 'save) (when org-edit-src-saved-temp-window-config (set-window-configuration org-edit-src-saved-temp-window-config) (setq org-edit-src-saved-temp-window-config nil)))) +(defun org-edit-src-abort () + "Abort editing of the src code and return to the Org buffer." + (interactive) + (let (org-edit-src-allow-write-back-p) + (org-edit-src-exit 'exit))) + (defmacro org-src-in-org-buffer (&rest body) `(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg) (save-window-excursion @@ -743,9 +805,11 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"." (defun org-edit-src-save () "Save parent buffer with current state source-code buffer." (interactive) - (org-src-in-org-buffer (save-buffer))) + (if (string-match "Fixed Width" (buffer-name)) + (user-error "Use C-c ' to save and exit, C-c C-k to abort editing") + (org-src-in-org-buffer (save-buffer)))) -(declare-function org-babel-tangle "ob-tangle" (&optional only-this-block target-file lang)) +(declare-function org-babel-tangle "ob-tangle" (&optional arg target-file lang)) (defun org-src-tangle (arg) "Tangle the parent buffer." @@ -829,9 +893,9 @@ issued in the language major mode buffer." (defun org-src-native-tab-command-maybe () "Perform language-specific TAB action. -Alter code block according to effect of TAB in the language major -mode." +Alter code block according to what TAB does in the language major mode." (and org-src-tab-acts-natively + (org-in-src-block-p) (not (equal this-command 'org-shifttab)) (let ((org-src-strip-leading-and-trailing-blank-lines nil)) (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB"))))) diff --git a/lisp/org-table.el b/lisp/org-table.el index 00b2eb4d0..93c33b2b3 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -38,13 +38,11 @@ (require 'cl)) (require 'org) -(declare-function org-table-clean-before-export "org-exp" - (lines &optional maybe-quoted)) -(declare-function org-format-org-table-html "org-html" (lines &optional splice)) +(declare-function org-export-string-as "ox" + (string backend &optional body-only ext-plist)) (declare-function aa2u "ext:ascii-art-to-unicode" ()) (defvar orgtbl-mode) ; defined below (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized -(defvar org-export-html-table-tag) ; defined in org-exp.el (defvar constants-unit-system) (defvar org-table-follow-field-mode) @@ -54,6 +52,8 @@ This can be used to add additional functionality after the table is sent to the receiver position, otherwise, if table is not sent, the functions are not run.") +(defvar org-TBLFM-begin-regexp "|\n[ \t]*#\\+TBLFM: ") + (defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) "Non-nil means use the optimized table editor version for `orgtbl-mode'. In the optimized version, the table editor takes over all simple keys that @@ -112,7 +112,7 @@ table, obtained by prompting the user." :type 'string) (defcustom org-table-number-regexp - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$" + "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$" "Regular expression for recognizing numbers in table columns. If a table column contains mostly numbers, it will be aligned to the right. If not, it will be aligned to the left. @@ -136,10 +136,10 @@ Other options offered by the customize interface are more restrictive." "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") (const :tag "Exponential, Floating point, Integer" "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") - (const :tag "Very General Number-Like, including hex" - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") - (const :tag "Very General Number-Like, including hex, allows comma as decimal mark" - "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|\\(0[xX]\\)[0-9a-fA-F]+\\|nan\\)$") + (const :tag "Very General Number-Like, including hex and Calc radix" + "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") + (const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark" + "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") (string :tag "Regexp:"))) (defcustom org-table-number-fraction 0.5 @@ -419,6 +419,70 @@ available parameters." (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) +(defvar org-table-colgroup-info nil) ; Dynamically scoped. +(defun org-table-clean-before-export (lines &optional maybe-quoted) + "Check if the table has a marking column. +If yes remove the column and the special lines." + (setq org-table-colgroup-info nil) + (if (memq nil + (mapcar + (lambda (x) (or (string-match "^[ \t]*|-" x) + (string-match + (if maybe-quoted + "^[ \t]*| *\\\\?\\([\#!$*_^ /]\\) *|" + "^[ \t]*| *\\([\#!$*_^ /]\\) *|") + x))) + lines)) + ;; No special marking column + (progn + (setq org-table-clean-did-remove-column nil) + (delq nil + (mapcar + (lambda (x) + (cond + ((org-table-colgroup-line-p x) + ;; This line contains colgroup info, extract it + ;; and then discard the line + (setq org-table-colgroup-info + (mapcar (lambda (x) + (cond ((member x '("<" "<")) :start) + ((member x '(">" ">")) :end) + ((member x '("<>" "<>")) :startend))) + (org-split-string x "[ \t]*|[ \t]*"))) + nil) + ((org-table-cookie-line-p x) + ;; This line contains formatting cookies, discard it + nil) + (t x))) + lines))) + ;; there is a special marking column + (setq org-table-clean-did-remove-column t) + (delq nil + (mapcar + (lambda (x) + (cond + ((org-table-colgroup-line-p x) + ;; This line contains colgroup info, extract it + ;; and then discard the line + (setq org-table-colgroup-info + (mapcar (lambda (x) + (cond ((member x '("<" "<")) :start) + ((member x '(">" ">")) :end) + ((member x '("<>" "<>")) :startend))) + (cdr (org-split-string x "[ \t]*|[ \t]*")))) + nil) + ((org-table-cookie-line-p x) + ;; This line contains formatting cookies, discard it + nil) + ((string-match "^[ \t]*| *\\([!_^/$]\\|\\\\\\$\\) *|" x) + ;; ignore this line + nil) + ((or (string-match "^\\([ \t]*\\)|-+\\+" x) + (string-match "^\\([ \t]*\\)|[^|]*|" x)) + ;; remove the first column + (replace-match "\\1|" t nil x)))) + lines)))) + (defconst org-table-translate-regexp (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") "Match a reference that needs translation, for reference display.") @@ -539,7 +603,7 @@ nil When nil, the command tries to be smart and figure out the ((equal separator '(16)) "^\\|\t") ((integerp separator) (if (< separator 1) - (error "Number of spaces in separator must be >= 1") + (user-error "Number of spaces in separator must be >= 1") (format "^ *\\| *\t *\\| \\{%d,\\}" separator))) (t (error "This should not happen")))) (while (re-search-forward re end t) @@ -579,9 +643,7 @@ whether it is set locally or up in the hierarchy, then on the extension of the given file name, and finally on the variable `org-table-export-default-format'." (interactive) - (unless (org-at-table-p) - (error "No table at point")) - (require 'org-exp) + (unless (org-at-table-p) (user-error "No table at point")) (org-table-align) ;; make sure we have everything we need (let* ((beg (org-table-begin)) (end (org-table-end)) @@ -598,13 +660,13 @@ extension of the given file name, and finally on the variable (setq file (read-file-name "Export table to: ")) (unless (or (not (file-exists-p file)) (y-or-n-p (format "Overwrite file %s? " file))) - (error "Abort"))) + (user-error "File not written"))) (if (file-directory-p file) - (error "This is a directory path, not a file")) + (user-error "This is a directory path, not a file")) (if (and (buffer-file-name) (equal (file-truename file) (file-truename (buffer-file-name)))) - (error "Please specify a file name that is different from current")) + (user-error "Please specify a file name that is different from current")) (setq fileext (concat (file-name-extension file) "$")) (unless format (setq deffmt-readable @@ -641,7 +703,7 @@ extension of the given file name, and finally on the variable skipcols i0))) (unless (fboundp transform) - (error "No such transformation function %s" transform)) + (user-error "No such transformation function %s" transform)) (setq txt (funcall transform table params)) (with-current-buffer (find-file-noselect file) @@ -652,7 +714,7 @@ extension of the given file name, and finally on the variable (save-buffer)) (kill-buffer buf) (message "Export done.")) - (error "TABLE_EXPORT_FORMAT invalid")))) + (user-error "TABLE_EXPORT_FORMAT invalid")))) (defvar org-table-aligned-begin-marker (make-marker) "Marker at the beginning of the table last aligned. @@ -760,7 +822,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (error (kill-region beg end) (org-table-create org-table-default-size) - (error "Empty table - created default table"))) + (user-error "Empty table - created default table"))) ;; A list of empty strings to fill any short rows on output (setq emptystrings (make-list maxfields "")) ;; Check for special formatting. @@ -787,7 +849,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) (unless (> f1 1) - (error "Cannot narrow field starting with wide link \"%s\"" + (user-error "Cannot narrow field starting with wide link \"%s\"" (match-string 0 xx))) (add-text-properties f1 (length xx) (list 'org-cwidth t) xx) (add-text-properties (- f1 2) f1 @@ -860,7 +922,8 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (org-goto-line winstartline) (setq winstart (point-at-bol)) (org-goto-line linepos) - (set-window-start (selected-window) winstart 'noforce) + (when (eq (window-buffer (selected-window)) (current-buffer)) + (set-window-start (selected-window) winstart 'noforce)) (org-table-goto-column colpos) (and org-table-overlay-coordinates (org-table-overlay-coordinates)) (setq org-table-may-need-update nil) @@ -978,7 +1041,7 @@ Before doing so, re-align the table if necessary." (progn (re-search-backward "|" (org-table-begin)) (re-search-backward "|" (org-table-begin))) - (error (error "Cannot move to previous table field"))) + (error (user-error "Cannot move to previous table field"))) (while (looking-at "|\\(-\\|[ \t]*$\\)") (re-search-backward "|" (org-table-begin))) (if (looking-at "| ?") @@ -994,7 +1057,7 @@ With numeric argument N, move N-1 fields forward first." (setq n (1- n)) (org-table-previous-field)) (if (not (re-search-backward "|" (point-at-bol 0) t)) - (error "No more table fields before the current") + (user-error "No more table fields before the current") (goto-char (match-end 0)) (and (looking-at " ") (forward-char 1))) (if (>= (point) pos) (org-table-beginning-of-field 2)))) @@ -1055,7 +1118,7 @@ copying. In the case of a timestamp, increment by one day." (interactive "p") (let* ((colpos (org-table-current-column)) (col (current-column)) - (field (org-table-get-field)) + (field (save-excursion (org-table-get-field))) (non-empty (string-match "[^ \t]" field)) (beg (org-table-begin)) (orig-n n) @@ -1091,7 +1154,7 @@ copying. In the case of a timestamp, increment by one day." (org-table-maybe-recalculate-line)) (org-table-align) (org-move-to-column col)) - (error "No non-empty field found")))) + (user-error "No non-empty field found")))) (defun org-table-check-inside-data-field (&optional noerror) "Is point inside a table data field? @@ -1103,7 +1166,7 @@ This actually throws an error, so it aborts the current command." (looking-at "[ \t]*$")) (if noerror nil - (error "Not in table data field")) + (user-error "Not in table data field")) t)) (defvar org-table-clip nil @@ -1286,7 +1349,7 @@ However, when FORCE is non-nil, create new columns if necessary." "Insert a new column into the table." (interactive) (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (org-table-find-dataline) (let* ((col (max 1 (org-table-current-column))) (beg (org-table-begin)) @@ -1326,7 +1389,7 @@ However, when FORCE is non-nil, create new columns if necessary." (if (and (org-at-table-p) (not (org-at-table-hline-p))) t - (error + (user-error "Please position cursor in a data line for column operations"))))) (defun org-table-line-to-dline (line &optional above) @@ -1356,7 +1419,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." "Delete a column from the table." (interactive) (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (org-table-find-dataline) (org-table-check-inside-data-field) (let* ((col (org-table-current-column)) @@ -1400,7 +1463,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." "Move the current column to the right. With arg LEFT, move to the left." (interactive "P") (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (org-table-find-dataline) (org-table-check-inside-data-field) (let* ((col (org-table-current-column)) @@ -1411,9 +1474,9 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." (linepos (org-current-line)) (colpos (if left (1- col) (1+ col)))) (if (and left (= col 1)) - (error "Cannot move column further left")) + (user-error "Cannot move column further left")) (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) - (error "Cannot move column further right")) + (user-error "Cannot move column further right")) (goto-char beg) (while (< (point) end) (if (org-at-table-hline-p) @@ -1461,7 +1524,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." (beginning-of-line tonew) (unless (org-at-table-p) (goto-char pos) - (error "Cannot move row further")) + (user-error "Cannot move row further")) (setq hline2p (looking-at org-table-hline-regexp)) (goto-char pos) (beginning-of-line 1) @@ -1486,7 +1549,7 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." With prefix ARG, insert below the current line." (interactive "P") (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (let* ((line (buffer-substring (point-at-bol) (point-at-eol))) (new (org-table-clean-line line))) ;; Fix the first field if necessary @@ -1508,7 +1571,7 @@ With prefix ARG, insert below the current line." With prefix ABOVE, insert above the current line." (interactive "P") (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (when (eobp) (insert "\n") (backward-char 1)) (if (not (string-match "|[ \t]*$" (org-current-line-string))) (org-table-align)) @@ -1558,7 +1621,7 @@ In particular, this does handle wide and invisible characters." "Delete the current row or horizontal line from the table." (interactive) (if (not (org-at-table-p)) - (error "Not at a table")) + (user-error "Not at a table")) (let ((col (current-column)) (dline (org-table-current-dline))) (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) @@ -1710,7 +1773,7 @@ the table is enlarged as needed. The process ignores horizontal separator lines." (interactive) (unless (and org-table-clip (listp org-table-clip)) - (error "First cut/copy a region to paste!")) + (user-error "First cut/copy a region to paste!")) (org-table-check-inside-data-field) (let* ((clip org-table-clip) (line (org-current-line)) @@ -1839,7 +1902,7 @@ blank, and the content is appended to the field above." nlines) (org-table-cut-region (region-beginning) (region-end)) (if (> (length (car org-table-clip)) 1) - (error "Region must be limited to single column")) + (user-error "Region must be limited to single column")) (setq nlines (if arg (if (< arg 1) (+ (length org-table-clip) arg) @@ -2008,12 +2071,12 @@ If NLAST is a number, only the NLAST fields will actually be summed." (setq col (org-table-current-column)) (goto-char (org-table-begin)) (unless (re-search-forward "^[ \t]*|[^-]" nil t) - (error "No table data")) + (user-error "No table data")) (org-table-goto-column col) (setq beg (point)) (goto-char (org-table-end)) (unless (re-search-backward "^[ \t]*|[^-]" nil t) - (error "No table data")) + (user-error "No table data")) (org-table-goto-column col) (setq end (point)))) (let* ((items (apply 'append (org-table-copy-region beg end))) @@ -2098,7 +2161,7 @@ When NAMED is non-nil, look for a named equation." (int-to-string (org-table-current-column)))) (dummy (and (or nameass refass) (not named) (not (y-or-n-p "Replace existing field formula with column formula? " )) - (error "Abort"))) + (message "Formula not replaced"))) (name (or name ref)) (org-table-may-need-update nil) (stored (cdr (assoc scol stored-list))) @@ -2122,7 +2185,7 @@ When NAMED is non-nil, look for a named equation." ;; remove formula (setq stored-list (delq (assoc scol stored-list) stored-list)) (org-table-store-formulas stored-list) - (error "Formula removed")) + (user-error "Formula removed")) (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) (if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) (if (and name (not named)) @@ -2207,7 +2270,7 @@ When NAMED is non-nil, look for a named equation." (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol) (ding) (sit-for 2)) - (error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) + (user-error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) (push scol seen)))))) (nreverse eq-alist))) @@ -2231,7 +2294,7 @@ For all numbers larger than LIMIT, shift them by DELTA." (while (re-search-forward re2 (point-at-eol) t) (unless (save-match-data (org-in-regexp "remote([^)]+?)")) (if (equal (char-before (match-beginning 0)) ?.) - (error "Change makes TBLFM term %s invalid, use undo to recover" + (user-error "Change makes TBLFM term %s invalid, use undo to recover" (match-string 0)) (replace-match ""))))) (while (re-search-forward re (point-at-eol) t) @@ -2338,7 +2401,7 @@ If yes, store the formula and apply it." (equal (substring eq 0 (min 2 (length eq))) "'(")) (org-table-eval-formula (if named '(4) nil) (org-table-formula-from-user eq)) - (error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) + (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) (defvar org-recalc-commands nil "List of commands triggering the recalculation of a line. @@ -2363,7 +2426,7 @@ after prompting for the marking character. After each change, a message will be displayed indicating the meaning of the new mark." (interactive) - (unless (org-at-table-p) (error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) (let* ((marks (append (mapcar 'car org-recalc-marks) '(" "))) (beg (org-table-begin)) (end (org-table-end)) @@ -2382,13 +2445,13 @@ of the new mark." (setq newchar (char-to-string (read-char-exclusive)) forcenew (car (assoc newchar org-recalc-marks)))) (if (and newchar (not forcenew)) - (error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" + (user-error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" newchar)) (if l1 (org-goto-line l1)) (save-excursion (beginning-of-line 1) (unless (looking-at org-table-dataline-regexp) - (error "Not at a table data line"))) + (user-error "Not at a table data line"))) (unless have-col (org-table-goto-column 1) (org-table-insert-column) @@ -2483,7 +2546,7 @@ not overwrite the stored one." (or suppress-analysis (org-table-get-specials)) (if (equal arg '(16)) (let ((eq (org-table-current-field-formula))) - (or eq (error "No equation active for current field")) + (or eq (user-error "No equation active for current field")) (org-table-get-field nil eq) (org-table-align) (setq org-table-may-need-update t)) @@ -2557,7 +2620,10 @@ not overwrite the stored one." fields))) (if (eq numbers t) (setq fields (mapcar - (lambda (x) (number-to-string (string-to-number x))) + (lambda (x) + (if (string-match "\\S-" x) + (number-to-string (string-to-number x)) + x)) fields))) (setq ndown (1- ndown)) (setq form (copy-sequence formula) @@ -2612,7 +2678,7 @@ not overwrite the stored one." (if (not (save-match-data (string-match (regexp-quote form) formrpl))) (setq form (replace-match formrpl t t form)) - (error "Spreadsheet error: invalid reference \"%s\"" form))) + (user-error "Spreadsheet error: invalid reference \"%s\"" form))) ;; Insert simple ranges (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) (setq form @@ -2630,11 +2696,12 @@ not overwrite the stored one." (setq n (+ (string-to-number (match-string 1 form)) (if (match-end 2) n0 0)) x (nth (1- (if (= n 0) n0 (max n 1))) fields)) - (unless x (error "Invalid field specifier \"%s\"" + (unless x (user-error "Invalid field specifier \"%s\"" (match-string 0 form))) (setq form (replace-match (save-match-data - (org-table-make-reference x nil numbers lispp)) + (org-table-make-reference + x keep-empty numbers lispp)) t t form))) (if lispp @@ -2646,12 +2713,23 @@ not overwrite the stored one." (string-to-number ev) duration-output-format) ev)) (or (fboundp 'calc-eval) - (error "Calc does not seem to be installed, and is needed to evaluate the formula")) - ;; "Inactivate" time-stamps so that Calc can handle them + (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")) + ;; Use <...> time-stamps so that Calc can handle them (setq form (replace-regexp-in-string org-ts-regexp3 "<\\1>" form)) + ;; I18n-ize local time-stamps by setting (system-time-locale "C") + (when (string-match org-ts-regexp2 form) + (let* ((ts (match-string 0 form)) + (tsp (apply 'encode-time (save-match-data (org-parse-time-string ts)))) + (system-time-locale "C") + (tf (or (and (save-match-data (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)) + (cdr org-time-stamp-formats)) + (car org-time-stamp-formats)))) + (setq form (replace-match (format-time-string tf tsp) t t form)))) + (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form)) form - (calc-eval (cons form org-tbl-calc-modes) (if numbers 'num))) + (calc-eval (cons form org-tbl-calc-modes) + (when (and (not keep-empty) numbers) 'num))) ev (if duration (org-table-time-seconds-to-string (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev) (string-to-number (org-table-time-string-to-seconds ev)) @@ -2678,7 +2756,7 @@ $1-> %s\n" orig formula form0 form)) (unless (let (inhibit-redisplay) (y-or-n-p "Debugging Formula. Continue to next? ")) (org-table-align) - (error "Abort")) + (user-error "Abort")) (delete-window bw) (message ""))) (if (listp ev) (setq fmt nil ev "#ERROR")) @@ -2716,7 +2794,7 @@ in the buffer and column1 and column2 are table column numbers." (let ((thisline (org-current-line)) beg end c1 c2 r1 r2 rangep tmp) (unless (string-match org-table-range-regexp desc) - (error "Invalid table range specifier `%s'" desc)) + (user-error "Invalid table range specifier `%s'" desc)) (setq rangep (match-end 3) r1 (and (match-end 1) (match-string 1 desc)) r2 (and (match-end 4) (match-string 4 desc)) @@ -2784,7 +2862,7 @@ and TABLE is a vector with line types." ;; 1 2 3 4 5 6 (and (not (match-end 3)) (not (match-end 6))) (and (match-end 3) (match-end 6) (not (match-end 5)))) - (error "Invalid row descriptor `%s'" desc)) + (user-error "Invalid row descriptor `%s'" desc)) (let* ((hdir (and (match-end 2) (match-string 2 desc))) (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil)) (odir (and (match-end 5) (match-string 5 desc))) @@ -2798,7 +2876,7 @@ and TABLE is a vector with line types." (setq i 0 hdir "+") (if (eq (aref table 0) 'hline) (setq hn (1- hn))))) (if (and (not hn) on (not odir)) - (error "Should never happen");;(aref org-table-dlines on) + (user-error "Should never happen");;(aref org-table-dlines on) (if (and hn (> hn 0)) (setq i (org-table-find-row-type table i 'hline (equal hdir "-") nil hn cline desc))) @@ -2818,41 +2896,56 @@ and TABLE is a vector with line types." (cond ((eq org-table-relative-ref-may-cross-hline t) t) ((eq org-table-relative-ref-may-cross-hline 'error) - (error "Row descriptor %s used in line %d crosses hline" desc cline)) + (user-error "Row descriptor %s used in line %d crosses hline" desc cline)) (t (setq i (- i (if backwards -1 1)) n 1) nil)) t))) (setq n (1- n))) (if (or (< i 0) (>= i l)) - (error "Row descriptor %s used in line %d leads outside table" + (user-error "Row descriptor %s used in line %d leads outside table" desc cline) i))) (defun org-table-rewrite-old-row-references (s) (if (string-match "&[-+0-9I]" s) - (error "Formula contains old &row reference, please rewrite using @-syntax") + (user-error "Formula contains old &row reference, please rewrite using @-syntax") s)) (defun org-table-make-reference (elements keep-empty numbers lispp) "Convert list ELEMENTS to something appropriate to insert into formula. KEEP-EMPTY indicated to keep empty fields, default is to skip them. NUMBERS indicates that everything should be converted to numbers. -LISPP means to return something appropriate for a Lisp list." - (if (stringp elements) ; just a single val +LISPP non-nil means to return something appropriate for a Lisp +list, 'literal is for the format specifier L." + ;; Calc nan (not a number) is used for the conversion of the empty + ;; field to a reference for several reasons: (i) It is accepted in a + ;; Calc formula (e. g. "" or "()" would result in a Calc error). + ;; (ii) In a single field (not in range) it can be distinguished + ;; from "(nan)" which is the reference made from a single field + ;; containing "nan". + (if (stringp elements) + ;; field reference (if lispp (if (eq lispp 'literal) elements - (prin1-to-string (if numbers (string-to-number elements) elements))) - (if (equal elements "") (setq elements "0")) - (if numbers (setq elements (number-to-string (string-to-number elements)))) - (concat "(" elements ")")) + (if (and (eq elements "") (not keep-empty)) + "" + (prin1-to-string + (if numbers (string-to-number elements) elements)))) + (if (string-match "\\S-" elements) + (progn + (when numbers (setq elements (number-to-string + (string-to-number elements)))) + (concat "(" elements ")")) + (if (or (not keep-empty) numbers) "(0)" "nan"))) + ;; range reference (unless keep-empty (setq elements (delq nil (mapcar (lambda (x) (if (string-match "\\S-" x) x nil)) elements)))) - (setq elements (or elements '("0"))) + (setq elements (or elements '())) ; if delq returns nil then we need '() (if lispp (mapconcat (lambda (x) @@ -2862,10 +2955,32 @@ LISPP means to return something appropriate for a Lisp list." elements " ") (concat "[" (mapconcat (lambda (x) - (if numbers (number-to-string (string-to-number x)) x)) + (if (string-match "\\S-" x) + (if numbers + (number-to-string (string-to-number x)) + x) + (if (or (not keep-empty) numbers) "0" "nan"))) elements ",") "]")))) +;;;###autoload +(defun org-table-set-constants () + "Set `org-table-formula-constants-local' in the current buffer." + (let (cst consts const-str) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t) + (setq const-str (substring-no-properties (match-string 1))) + (setq consts (append consts (org-split-string const-str "[ \t]+"))) + (when consts + (let (e) + (while (setq e (pop consts)) + (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) + (if (assoc-string (match-string 1 e) cst) + (setq cst (delete (assoc-string (match-string 1 e) cst) cst))) + (push (cons (match-string 1 e) (match-string 2 e)) cst))) + (setq org-table-formula-constants-local cst))))))) + ;;;###autoload (defun org-table-recalculate (&optional all noalign) "Recalculate the current table line by applying all stored formulas. @@ -2879,7 +2994,7 @@ known that the table will be realigned a little later anyway." (interactive "P") (or (memq this-command org-recalc-commands) (setq org-recalc-commands (cons this-command org-recalc-commands))) - (unless (org-at-table-p) (error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) (if (or (eq all 'iterate) (equal all '(16))) (org-table-iterate) (org-table-get-specials) @@ -2902,7 +3017,7 @@ known that the table will be realigned a little later anyway." (car x)) 1) (cdr x))) (if (assoc (car x) eqlist1) - (error "\"%s=\" formula tries to overwrite existing formula for column %s" + (user-error "\"%s=\" formula tries to overwrite existing formula for column %s" lhs1 (car x)))) (cons (org-table-formula-handle-first/last-rc (car x)) @@ -2947,7 +3062,7 @@ known that the table will be realigned a little later anyway." (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a)) (nth 2 a)))) (when (member name1 seen-fields) - (error "Several field/range formulas try to set %s" name1)) + (user-error "Several field/range formulas try to set %s" name1)) (push name1 seen-fields) (and (not a) @@ -2956,7 +3071,7 @@ known that the table will be realigned a little later anyway." (condition-case nil (aref org-table-dlines (string-to-number (match-string 1 name))) - (error (error "Invalid row number in %s" + (error (user-error "Invalid row number in %s" name))) (string-to-number (match-string 2 name))))) (when (and a (or all (equal (nth 1 a) thisline))) @@ -3026,7 +3141,7 @@ with the prefix ARG." (message "Convergence after %d iterations" i) (message "Table was already stable")) (throw 'exit t))) - (error "No convergence after %d iterations" i)))) + (user-error "No convergence after %d iterations" i)))) ;;;###autoload (defun org-table-recalculate-buffer-tables () @@ -3057,7 +3172,44 @@ with the prefix ARG." (message "Convergence after %d iterations" (- imax i)) (throw 'exit t)) (setq checksum c1))) - (error "No convergence after %d iterations" imax)))))) + (user-error "No convergence after %d iterations" imax)))))) + +(defun org-calc-current-TBLFM (&optional arg) + "Apply the #+TBLFM in the line to the table." + (interactive "P") + (unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line")) + (let ((formula (buffer-substring + (point-at-bol) + (point-at-eol))) + s e) + (save-excursion + ;; Insert a temporary formula at right after the table + (goto-char (org-TBLFM-begin)) + (setq s (set-marker (make-marker) (point))) + (insert (concat formula "\n")) + (setq e (set-marker (make-marker) (point))) + + ;; Recalculate the table + (beginning-of-line 0) ; move to the inserted line + (skip-chars-backward " \r\n\t") + (if (org-at-table-p) + (unwind-protect + (org-call-with-arg 'org-table-recalculate (or arg t)) + + ;; delete the formula inserted temporarily + (delete-region s e)))))) + +(defun org-TBLFM-begin () + "Find the beginning of the TBLFM lines and return its position. +Return nil when the beginning of TBLFM line was not found." + (save-excursion + (when (progn (forward-line 1) + (re-search-backward + org-TBLFM-begin-regexp + nil t)) + (point-at-bol 2)))) + + (defun org-table-expand-lhs-ranges (equations) "Expand list of formulas. @@ -3115,7 +3267,7 @@ borders of the table using the @< @> $< $> makers." len (- nmax len -1))) (if (or (< n 1) (> n nmax)) - (error "Reference \"%s\" in expression \"%s\" points outside table" + (user-error "Reference \"%s\" in expression \"%s\" points outside table" (match-string 0 s) s)) (setq start (match-beginning 0)) (setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s))))) @@ -3214,7 +3366,7 @@ Parameters get priority." (interactive) (when (save-excursion (beginning-of-line 1) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM"))) (beginning-of-line 0)) - (unless (org-at-table-p) (error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) (org-table-get-specials) (let ((key (org-table-current-field-formula 'key 'noerror)) (eql (sort (org-table-get-stored-formulas 'noerror) @@ -3436,7 +3588,7 @@ minutes or seconds." ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&") (if (memq dir '(left right)) (org-rematch-and-replace 1 (eq dir 'left)) - (error "Cannot shift reference in this direction"))) + (user-error "Cannot shift reference in this direction"))) ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)") ;; A B3-like reference (if (memq dir '(up down)) @@ -3451,7 +3603,7 @@ minutes or seconds." (defun org-rematch-and-replace (n &optional decr hline) "Re-match the group N, and replace it with the shifted reference." - (or (match-end n) (error "Cannot shift reference in this direction")) + (or (match-end n) (user-error "Cannot shift reference in this direction")) (goto-char (match-beginning n)) (and (looking-at (regexp-quote (match-string n))) (replace-match (org-table-shift-refpart (match-string 0) decr hline) @@ -3487,7 +3639,7 @@ a translation reference." (org-number-to-letters (max 1 (+ (org-letters-to-number ref) (if decr -1 1))))) - (t (error "Cannot shift reference")))))) + (t (user-error "Cannot shift reference")))))) (defun org-table-fedit-toggle-coordinates () "Toggle the display of coordinates in the referenced table." @@ -3519,14 +3671,14 @@ With prefix ARG, apply the new formulas to the table." (while (string-match "[ \t]*\n[ \t]*" form) (setq form (replace-match " " t t form))) (when (assoc var eql) - (error "Double formulas for %s" var)) + (user-error "Double formulas for %s" var)) (push (cons var form) eql))) (setq org-pos nil) (set-window-configuration org-window-configuration) (select-window sel-win) (goto-char pos) (unless (org-at-table-p) - (error "Lost table position - cannot install formulas")) + (user-error "Lost table position - cannot install formulas")) (org-table-store-formulas eql) (move-marker pos nil) (kill-buffer "*Edit Formulas*") @@ -3556,14 +3708,14 @@ With prefix ARG, apply the new formulas to the table." (call-interactively 'lisp-indent-line)) ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) ((not (fboundp 'pp-buffer)) - (error "Cannot pretty-print. Command `pp-buffer' is not available")) + (user-error "Cannot pretty-print. Command `pp-buffer' is not available")) ((looking-at "[$&@0-9a-zA-Z]+ *= *'(") (goto-char (- (match-end 0) 2)) (setq beg (point)) (setq ind (make-string (current-column) ?\ )) (condition-case nil (forward-sexp 1) (error - (error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) + (user-error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) (setq end (point)) (save-restriction (narrow-to-region beg end) @@ -3615,7 +3767,7 @@ With prefix ARG, apply the new formulas to the table." ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) ((org-at-regexp-p "\\$[0-9]+") 'column) ((not local) nil) - (t (error "No reference at point"))) + (t (user-error "No reference at point"))) match (and what (or match (match-string 0)))) (when (and match (not (equal (match-beginning 0) (point-at-bol)))) (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) @@ -3682,7 +3834,7 @@ With prefix ARG, apply the new formulas to the table." (goto-char (match-beginning 1)) (org-table-highlight-rectangle) (message "Named column (column %s)" (cdr e))) - (error "Column name not found"))) + (user-error "Column name not found"))) ((eq what 'column) ;; column number (org-table-goto-column (string-to-number (substring match 1))) @@ -3695,10 +3847,10 @@ With prefix ARG, apply the new formulas to the table." (goto-char (match-beginning 1)) (org-table-highlight-rectangle) (message "Local parameter.")) - (error "Parameter not found"))) + (user-error "Parameter not found"))) (t (cond - ((not var) (error "No reference at point")) + ((not var) (user-error "No reference at point")) ((setq e (assoc var org-table-formula-constants-local)) (message "Local Constant: $%s=%s in #+CONSTANTS line." var (cdr e))) @@ -3708,7 +3860,7 @@ With prefix ARG, apply the new formulas to the table." ((setq e (and (fboundp 'constants-get) (constants-get var))) (message "Constant: $%s=%s, from `constants.el'%s." var e (format " (%s units)" constants-unit-system))) - (t (error "Undefined name $%s" var))))) + (t (user-error "Undefined name $%s" var))))) (goto-char pos) (when (and org-show-positions (not (memq this-command '(org-table-fedit-scroll @@ -3734,7 +3886,7 @@ With prefix ARG, apply the new formulas to the table." (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point)))) p1 p2))) ((or p1 p2) (goto-char (or p1 p2))) - (t (error "No table dataline around here")))))) + (t (user-error "No table dataline around here")))))) (defun org-table-fedit-line-up () "Move cursor one line up in the window showing the table." @@ -3999,7 +4151,7 @@ to execute outside of tables." (defun orgtbl-error () "Error when there is no default binding for a table key." (interactive) - (error "This key has no function outside tables")) + (user-error "This key has no function outside tables")) (defun orgtbl-setup () "Setup orgtbl keymaps." @@ -4151,7 +4303,7 @@ to execute outside of tables." If it is a table to be sent away to a receiver, do it. With prefix arg, also recompute table." (interactive "P") - (let ((case-fold-search t) (pos (point)) action consts-str consts cst const-str) + (let ((case-fold-search t) (pos (point)) action) (save-excursion (beginning-of-line 1) (setq action (cond @@ -4169,17 +4321,7 @@ With prefix arg, also recompute table." (when (orgtbl-send-table 'maybe) (run-hooks 'orgtbl-after-send-table-hook))) ((eq action 'recalc) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t) - (setq const-str (substring-no-properties (match-string 1))) - (setq consts (append consts (org-split-string const-str "[ \t]+"))) - (when consts - (let (e) - (while (setq e (pop consts)) - (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) - (push (cons (match-string 1 e) (match-string 2 e)) cst))) - (setq org-table-formula-constants-local cst))))) + (org-table-set-constants) (save-excursion (beginning-of-line 1) (skip-chars-backward " \r\n\t") @@ -4265,13 +4407,12 @@ overwritten, and the table is not marked as requiring realignment." "Regular expression matching exponentials as produced by calc.") (defun orgtbl-export (table target) - (require 'org-exp) (let ((func (intern (concat "orgtbl-to-" (symbol-name target)))) (lines (org-split-string table "[ \t]*\n[ \t]*")) org-table-last-alignment org-table-last-column-widths maxcol column) (if (not (fboundp func)) - (error "Cannot export orgtbl table to %s" target)) + (user-error "Cannot export orgtbl table to %s" target)) (setq lines (org-table-clean-before-export lines)) (setq table (mapcar @@ -4312,14 +4453,14 @@ a radio table." (goto-char (point-min)) (unless (re-search-forward (concat "BEGIN RECEIVE ORGTBL +" name "\\([ \t]\\|$\\)") nil t) - (error "Don't know where to insert translated table")) + (user-error "Don't know where to insert translated table")) (goto-char (match-beginning 0)) (beginning-of-line 2) (save-excursion (let ((beg (point))) (unless (re-search-forward (concat "END RECEIVE ORGTBL +" name) nil t) - (error "Cannot find end of insertion region")) + (user-error "Cannot find end of insertion region")) (beginning-of-line 1) (delete-region beg (point)))) (insert txt "\n"))) @@ -4332,7 +4473,7 @@ for a horizontal separator line, or a list of field values as strings. The table is taken from the parameter TXT, or from the buffer at point." (unless txt (unless (org-at-table-p) - (error "No table at point"))) + (user-error "No table at point"))) (let* ((txt (or txt (buffer-substring-no-properties (org-table-begin) (org-table-end)))) @@ -4351,7 +4492,7 @@ With argument MAYBE, fail quietly if no transformation is defined for this table." (interactive) (catch 'exit - (unless (org-at-table-p) (error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) ;; when non-interactive, we assume align has just happened. (when (org-called-interactively-p 'any) (org-table-align)) (let ((dests (orgtbl-gather-send-defs)) @@ -4359,7 +4500,7 @@ this table." (org-table-end))) (ntbl 0)) (unless dests (if maybe (throw 'exit nil) - (error "Don't know how to transform this table"))) + (user-error "Don't know how to transform this table"))) (dolist (dest dests) (let* ((name (plist-get dest :name)) (transform (plist-get dest :transform)) @@ -4392,7 +4533,7 @@ this table." skipcols i0)) (txt (if (fboundp transform) (funcall transform table params) - (error "No such transformation function %s" transform)))) + (user-error "No such transformation function %s" transform)))) (orgtbl-send-replace-tbl name txt)) (setq ntbl (1+ ntbl))) (message "Table converted and installed at %d receiver location%s" @@ -4422,7 +4563,7 @@ First element has index 0, or I0 if given." (commented (save-excursion (beginning-of-line 1) (cond ((looking-at re1) t) ((looking-at re2) nil) - (t (error "Not at an org table"))))) + (t (user-error "Not at an org table"))))) (re (if commented re1 re2)) beg end) (save-excursion @@ -4440,7 +4581,7 @@ First element has index 0, or I0 if given." (let* ((e (assq major-mode orgtbl-radio-table-templates)) (txt (nth 1 e)) name pos) - (unless e (error "No radio table setup defined for %s" major-mode)) + (unless e (user-error "No radio table setup defined for %s" major-mode)) (setq name (read-string "Table name: ")) (while (string-match "%n" txt) (setq txt (replace-match name t t txt))) @@ -4474,7 +4615,8 @@ First element has index 0, or I0 if given." fmt)) (defsubst orgtbl-apply-fmt (fmt &rest args) - "Apply format FMT to the arguments. NIL FMTs return the first argument." + "Apply format FMT to arguments ARGS. +When FMT is nil, return the first argument from ARGS." (cond ((functionp fmt) (apply fmt args)) (fmt (apply 'format fmt args)) (args (car args)) @@ -4504,7 +4646,7 @@ First element has index 0, or I0 if given." f))) line))) (push (if *orgtbl-lfmt* - (orgtbl-apply-fmt *orgtbl-lfmt* line) + (apply #'orgtbl-apply-fmt *orgtbl-lfmt* line) (concat (orgtbl-eval-str *orgtbl-lstart*) (mapconcat 'identity line *orgtbl-sep*) (orgtbl-eval-str *orgtbl-lend*))) @@ -4523,12 +4665,15 @@ First element has index 0, or I0 if given." (orgtbl-format-line prevline)))))) ;;;###autoload -(defun orgtbl-to-generic (table params) +(defun orgtbl-to-generic (table params &optional backend) "Convert the orgtbl-mode TABLE to some other format. This generic routine can be used for many standard cases. TABLE is a list, each entry either the symbol `hline' for a horizontal separator line, or a list of fields for that line. PARAMS is a property list of parameters that can influence the conversion. +A third optional argument BACKEND can be used to convert the content of +the cells using a specific export back-end. + For the generic converter, some parameters are obligatory: you need to specify either :lfmt, or all of (:lstart :lend :sep). @@ -4599,22 +4744,31 @@ directly by `orgtbl-send-table'. See manual." (*orgtbl-llfmt* (or (plist-get params :llfmt) *orgtbl-lfmt*)) (*orgtbl-fmt* (plist-get params :fmt)) *orgtbl-rtn*) - + ;; Convert cells content to backend BACKEND + (when backend + (setq *orgtbl-table* + (mapcar + (lambda(r) + (if (listp r) + (mapcar + (lambda (c) + (org-trim (org-export-string-as c backend t '(:with-tables t)))) + r) + r)) + *orgtbl-table*))) ;; Put header (unless splicep (when (plist-member params :tstart) (let ((tstart (orgtbl-eval-str (plist-get params :tstart)))) (if tstart (push tstart *orgtbl-rtn*))))) - - ;; Do we have a heading section? If so, format it and handle the - ;; trailing hline. + ;; If we have a heading, format it and handle the trailing hline. (if (and (not splicep) (or (consp (car *orgtbl-table*)) (consp (nth 1 *orgtbl-table*))) (memq 'hline (cdr *orgtbl-table*))) (progn (when (eq 'hline (car *orgtbl-table*)) - ;; there is a hline before the first data line + ;; There is a hline before the first data line (and hline (push hline *orgtbl-rtn*)) (pop *orgtbl-table*)) (let* ((*orgtbl-lstart* (or (plist-get params :hlstart) @@ -4632,15 +4786,12 @@ directly by `orgtbl-send-table'. See manual." (orgtbl-format-section 'hline)) (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*)) (pop *orgtbl-table*))) - ;; Now format the main section. (orgtbl-format-section nil) - (unless splicep (when (plist-member params :tend) (let ((tend (orgtbl-eval-str (plist-get params :tend)))) (if tend (push tend *orgtbl-rtn*))))) - (mapconcat (if remove-newlines (lambda (tend) (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend)) @@ -4698,7 +4849,8 @@ this function is called." :tend "\\end{tabular}" :lstart "" :lend " \\\\" :sep " & " :efmt "%s\\,(%s)" :hline "\\hline"))) - (orgtbl-to-generic table (org-combine-plists params2 params)))) + (require 'ox-latex) + (orgtbl-to-generic table (org-combine-plists params2 params) 'latex))) ;;;###autoload (defun orgtbl-to-html (table params) @@ -4714,22 +4866,14 @@ Currently this function recognizes the following parameters: The general parameters :skip and :skipcols have already been applied when this function is called. The function does *not* use `orgtbl-to-generic', so you cannot specify parameters for it." - (let* ((splicep (plist-get params :splice)) - (html-table-tag org-export-html-table-tag) - html) - ;; Just call the formatter we already have - ;; We need to make text lines for it, so put the fields back together. - (setq html (org-format-org-table-html - (mapcar - (lambda (x) - (if (eq x 'hline) - "|----+----|" - (concat "| " (mapconcat 'org-html-expand x " | ") " |"))) - table) - splicep)) - (if (string-match "\n+\\'" html) - (setq html (replace-match "" t t html))) - html)) + (require 'ox-html) + (let ((output (org-export-string-as + (orgtbl-to-orgtbl table nil) 'html t '(:with-tables t)))) + (if (not (plist-get params :splice)) output + (org-trim + (replace-regexp-in-string + "\\`
  • \n" "" + (replace-regexp-in-string "
    \n*\\'" "" output)))))) ;;;###autoload (defun orgtbl-to-texinfo (table params) @@ -4768,7 +4912,8 @@ this function is called." :tend "@end multitable" :lstart "@item " :lend "" :sep " @tab " :hlstart "@headitem "))) - (orgtbl-to-generic table (org-combine-plists params2 params)))) + (require 'ox-texinfo) + (orgtbl-to-generic table (org-combine-plists params2 params) 'texinfo))) ;;;###autoload (defun orgtbl-to-orgtbl (table params) @@ -4815,22 +4960,22 @@ it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links)) (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el" "Link to ascii-art-to-unicode.el") org-stored-links)) - (error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)")) + (user-error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)")) (buffer-string))) (defun org-table-get-remote-range (name-or-id form) "Get a field value or a list of values in a range from table at ID. -NAME-OR-ID may be the name of a table in the current file as set by -a \"#+TBLNAME:\" directive. The first table following this line +NAME-OR-ID may be the name of a table in the current file as set +by a \"#+NAME:\" directive. The first table following this line will then be used. Alternatively, it may be an ID referring to -any entry, also in a different file. In this case, the first table -in that entry will be referenced. +any entry, also in a different file. In this case, the first +table in that entry will be referenced. FORM is a field or range descriptor like \"@2$3\" or \"B3\" or \"@I$2..@II$2\". All the references must be absolute, not relative. The return value is either a single string for a single field, or a -list of the fields in the rectangle ." +list of the fields in the rectangle." (save-match-data (let ((case-fold-search t) (id-loc nil) ;; Protect a bunch of variables from being overwritten @@ -4856,7 +5001,7 @@ list of the fields in the rectangle ." (setq buffer (current-buffer) loc (match-beginning 0)) (setq id-loc (org-id-find name-or-id 'marker)) (unless (and id-loc (markerp id-loc)) - (error "Can't find remote table \"%s\"" name-or-id)) + (user-error "Can't find remote table \"%s\"" name-or-id)) (setq buffer (marker-buffer id-loc) loc (marker-position id-loc)) (move-marker id-loc nil))) @@ -4868,7 +5013,7 @@ list of the fields in the rectangle ." (forward-char 1) (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) (not (match-beginning 1))) - (error "Cannot find a table at NAME or ID %s" name-or-id)) + (user-error "Cannot find a table at NAME or ID %s" name-or-id)) (setq tbeg (point-at-bol)) (org-table-get-specials) (setq form (org-table-formula-substitute-names @@ -4879,6 +5024,38 @@ list of the fields in the rectangle ." (org-table-get-range (match-string 0 form) tbeg 1)) form))))))))) +(defmacro org-define-lookup-function (mode) + (let ((mode-str (symbol-name mode)) + (first-p (equal mode 'first)) + (all-p (equal mode 'all))) + (let ((plural-str (if all-p "s" ""))) + `(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate) + ,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST. +If R-LIST is nil, return matching element%s of S-LIST. +If PREDICATE is not nil, use it instead of `equal' to match VAL. +Matching is done by (PREDICATE VAL S), where S is an element of S-LIST. +This function is generated by a call to the macro `org-define-lookup-function'." + mode-str plural-str plural-str plural-str) + (let ,(let ((lvars '((p (or predicate 'equal)) + (sl s-list) + (rl (or r-list s-list)) + (ret nil)))) + (if first-p (add-to-list 'lvars '(match-p nil))) + lvars) + (while ,(if first-p '(and (not match-p) sl) 'sl) + (progn + (if (funcall p val (car sl)) + (progn + ,(if first-p '(setq match-p t)) + (let ((rval (car rl))) + (setq ret ,(if all-p '(append ret (list rval)) 'rval))))) + (setq sl (cdr sl) rl (cdr rl)))) + ret))))) + +(org-define-lookup-function first) +(org-define-lookup-function last) +(org-define-lookup-function all) + (provide 'org-table) ;; Local variables: diff --git a/lisp/org-taskjuggler.el b/lisp/org-taskjuggler.el deleted file mode 100644 index bd4c10b2e..000000000 --- a/lisp/org-taskjuggler.el +++ /dev/null @@ -1,699 +0,0 @@ -;;; org-taskjuggler.el --- TaskJuggler exporter for org-mode -;; -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. -;; -;; Emacs Lisp Archive Entry -;; Filename: org-taskjuggler.el -;; Author: Christian Egli -;; Maintainer: Christian Egli -;; Keywords: org, taskjuggler, project planning -;; Description: Converts an org-mode buffer into a taskjuggler project plan -;; URL: - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;; Commentary: -;; -;; This library implements a TaskJuggler exporter for org-mode. -;; TaskJuggler uses a text format to define projects, tasks and -;; resources, so it is a natural fit for org-mode. It can produce all -;; sorts of reports for tasks or resources in either HTML, CSV or PDF. -;; The current version of TaskJuggler requires KDE but the next -;; version is implemented in Ruby and should therefore run on any -;; platform. -;; -;; The exporter is a bit different from other exporters, such as the -;; HTML and LaTeX exporters for example, in that it does not export -;; all the nodes of a document or strictly follow the order of the -;; nodes in the document. -;; -;; Instead the TaskJuggler exporter looks for a tree that defines the -;; tasks and a optionally tree that defines the resources for this -;; project. It then creates a TaskJuggler file based on these trees -;; and the attributes defined in all the nodes. -;; -;; * Installation -;; -;; Put this file into your load-path and the following line into your -;; ~/.emacs: -;; -;; (require 'org-taskjuggler) -;; -;; The interactive functions are similar to those of the HTML and LaTeX -;; exporters: -;; -;; M-x `org-export-as-taskjuggler' -;; M-x `org-export-as-taskjuggler-and-open' -;; -;; * Tasks -;; -;; Let's illustrate the usage with a small example. Create your tasks -;; as you usually do with org-mode. Assign efforts to each task using -;; properties (it's easiest to do this in the column view). You should -;; end up with something similar to the example by Peter Jones in -;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org. -;; Now mark the top node of your tasks with a tag named -;; "taskjuggler_project" (or whatever you customized -;; `org-export-taskjuggler-project-tag' to). You are now ready to -;; export the project plan with `org-export-as-taskjuggler-and-open' -;; which will export the project plan and open a Gantt chart in -;; TaskJugglerUI. -;; -;; * Resources -;; -;; Next you can define resources and assign those to work on specific -;; tasks. You can group your resources hierarchically. Tag the top -;; node of the resources with "taskjuggler_resource" (or whatever you -;; customized `org-export-taskjuggler-resource-tag' to). You can -;; optionally assign an identifier (named "resource_id") to the -;; resources (using the standard org properties commands) or you can -;; let the exporter generate identifiers automatically (the exporter -;; picks the first word of the headline as the identifier as long as -;; it is unique, see the documentation of -;; `org-taskjuggler-get-unique-id'). Using that identifier you can -;; then allocate resources to tasks. This is again done with the -;; "allocate" property on the tasks. Do this in column view or when on -;; the task type -;; -;; C-c C-x p allocate RET RET -;; -;; Once the allocations are done you can again export to TaskJuggler -;; and check in the Resource Allocation Graph which person is working -;; on what task at what time. -;; -;; * Export of properties -;; -;; The exporter also takes TODO state information into consideration, -;; i.e. if a task is marked as done it will have the corresponding -;; attribute in TaskJuggler ("complete 100"). Also it will export any -;; property on a task resource or resource node which is known to -;; TaskJuggler, such as limits, vacation, shift, booking, efficiency, -;; journalentry, rate for resources or account, start, note, duration, -;; end, journalentry, milestone, reference, responsible, scheduling, -;; etc for tasks. -;; -;; * Dependencies -;; -;; The exporter will handle dependencies that are defined in the tasks -;; either with the ORDERED attribute (see TODO dependencies in the Org -;; mode manual) or with the BLOCKER attribute (see org-depend.el) or -;; alternatively with a depends attribute. Both the BLOCKER and the -;; depends attribute can be either "previous-sibling" or a reference -;; to an identifier (named "task_id") which is defined for another -;; task in the project. BLOCKER and the depends attribute can define -;; multiple dependencies separated by either space or comma. You can -;; also specify optional attributes on the dependency by simply -;; appending it. The following examples should illustrate this: -;; -;; * Training material -;; :PROPERTIES: -;; :task_id: training_material -;; :ORDERED: t -;; :END: -;; ** Markup Guidelines -;; :PROPERTIES: -;; :Effort: 2d -;; :END: -;; ** Workflow Guidelines -;; :PROPERTIES: -;; :Effort: 2d -;; :END: -;; * Presentation -;; :PROPERTIES: -;; :Effort: 2d -;; :BLOCKER: training_material { gapduration 1d } some_other_task -;; :END: -;; -;;;; * TODO -;; - Use SCHEDULED and DEADLINE information (not just start and end -;; properties). -;; - Look at org-file-properties, org-global-properties and -;; org-global-properties-fixed -;; - What about property inheritance and org-property-inherit-p? -;; - Use TYPE_TODO as an way to assign resources -;; - Make sure multiple dependency definitions (i.e. BLOCKER on -;; previous-sibling and on a specific task_id) in multiple -;; attributes are properly exported. -;; -;;; Code: - -(eval-when-compile - (require 'cl)) - -(require 'org) -(require 'org-exp) - -;;; User variables: - -(defgroup org-export-taskjuggler nil - "Options for exporting Org-mode files to TaskJuggler." - :tag "Org Export TaskJuggler" - :group 'org-export) - -(defcustom org-export-taskjuggler-extension ".tjp" - "Extension of TaskJuggler files." - :group 'org-export-taskjuggler - :version "24.1" - :type 'string) - -(defcustom org-export-taskjuggler-project-tag "taskjuggler_project" - "Tag, property or todo used to find the tree containing all -the tasks for the project." - :group 'org-export-taskjuggler - :version "24.1" - :type 'string) - -(defcustom org-export-taskjuggler-resource-tag "taskjuggler_resource" - "Tag, property or todo used to find the tree containing all the -resources for the project." - :group 'org-export-taskjuggler - :version "24.1" - :type 'string) - -(defcustom org-export-taskjuggler-target-version 2.4 - "Which version of TaskJuggler the exporter is targeting." - :group 'org-export-taskjuggler - :version "24.1" - :type 'number) - -(defcustom org-export-taskjuggler-default-project-version "1.0" - "Default version string for the project." - :group 'org-export-taskjuggler - :version "24.1" - :type 'string) - -(defcustom org-export-taskjuggler-default-project-duration 280 - "Default project duration if no start and end date have been defined -in the root node of the task tree, i.e. the tree that has been marked -with `org-export-taskjuggler-project-tag'" - :group 'org-export-taskjuggler - :version "24.1" - :type 'integer) - -(defcustom org-export-taskjuggler-default-reports - '("taskreport \"Gantt Chart\" { - headline \"Project Gantt Chart\" - columns hierarchindex, name, start, end, effort, duration, completed, chart - timeformat \"%Y-%m-%d\" - hideresource 1 - loadunit shortauto -}" - "resourcereport \"Resource Graph\" { - headline \"Resource Allocation Graph\" - columns no, name, utilization, freeload, chart - loadunit shortauto - sorttasks startup - hidetask ~isleaf() -}") - "Default reports for the project." - :group 'org-export-taskjuggler - :version "24.1" - :type '(repeat (string :tag "Report"))) - -(defcustom org-export-taskjuggler-default-global-properties - "shift s40 \"Part time shift\" { - workinghours wed, thu, fri off -} -" - "Default global properties for the project. Here you typically -define global properties such as shifts, accounts, rates, -vacation, macros and flags. Any property that is allowed within -the TaskJuggler file can be inserted. You could for example -include another TaskJuggler file. - -The global properties are inserted after the project declaration -but before any resource and task declarations." - :group 'org-export-taskjuggler - :version "24.1" - :type '(string :tag "Preamble")) - -;;; Hooks - -(defvar org-export-taskjuggler-final-hook nil - "Hook run at the end of TaskJuggler export, in the new buffer.") - -;;; Autoload functions: - -;; avoid compiler warning about free variable -(defvar org-export-taskjuggler-old-level) - -;;;###autoload -(defun org-export-as-taskjuggler () - "Export parts of the current buffer as a TaskJuggler file. -The exporter looks for a tree with tag, property or todo that -matches `org-export-taskjuggler-project-tag' and takes this as -the tasks for this project. The first node of this tree defines -the project properties such as project name and project period. -If there is a tree with tag, property or todo that matches -`org-export-taskjuggler-resource-tag' this three is taken as -resources for the project. If no resources are specified, a -default resource is created and allocated to the project. Also -the taskjuggler project will be created with default reports as -defined in `org-export-taskjuggler-default-reports'." - (interactive) - - (message "Exporting...") - (setq-default org-done-keywords org-done-keywords) - (let* ((tasks - (org-taskjuggler-resolve-dependencies - (org-taskjuggler-assign-task-ids - (org-taskjuggler-compute-task-leafiness - (org-map-entries - 'org-taskjuggler-components - org-export-taskjuggler-project-tag nil 'archive 'comment))))) - (resources - (org-taskjuggler-assign-resource-ids - (org-map-entries - 'org-taskjuggler-components - org-export-taskjuggler-resource-tag nil 'archive 'comment))) - (filename (expand-file-name - (concat - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - org-export-taskjuggler-extension))) - (buffer (find-file-noselect filename)) - (old-buffer (current-buffer)) - (org-export-taskjuggler-old-level 0) - task resource) - (unless tasks - (error "No tasks specified")) - ;; add a default resource - (unless resources - (setq resources - `((("resource_id" . ,(user-login-name)) - ("headline" . ,user-full-name) - ("level" . 1))))) - ;; add a default allocation to the first task if none was given - (unless (assoc "allocate" (car tasks)) - (let ((task (car tasks)) - (resource-id (cdr (assoc "resource_id" (car resources))))) - (setcar tasks (push (cons "allocate" resource-id) task)))) - ;; add a default start date to the first task if none was given - (unless (assoc "start" (car tasks)) - (let ((task (car tasks)) - (time-string (format-time-string "%Y-%m-%d"))) - (setcar tasks (push (cons "start" time-string) task)))) - ;; add a default version if none was given - (unless (assoc "version" (car tasks)) - (let ((task (car tasks)) - (version org-export-taskjuggler-default-project-version)) - (setcar tasks (push (cons "version" version) task)))) - (with-current-buffer buffer - (erase-buffer) - (org-clone-local-variables old-buffer "^org-") - (org-taskjuggler-open-project (car tasks)) - (insert org-export-taskjuggler-default-global-properties) - (insert "\n") - (dolist (resource resources) - (let ((level (cdr (assoc "level" resource)))) - (org-taskjuggler-close-maybe level) - (org-taskjuggler-open-resource resource) - (setq org-export-taskjuggler-old-level level))) - (org-taskjuggler-close-maybe 1) - (setq org-export-taskjuggler-old-level 0) - (dolist (task tasks) - (let ((level (cdr (assoc "level" task)))) - (org-taskjuggler-close-maybe level) - (org-taskjuggler-open-task task) - (setq org-export-taskjuggler-old-level level))) - (org-taskjuggler-close-maybe 1) - (org-taskjuggler-insert-reports) - (save-buffer) - (or (org-export-push-to-kill-ring "TaskJuggler") - (message "Exporting... done")) - (current-buffer)))) - -;;;###autoload -(defun org-export-as-taskjuggler-and-open () - "Export the current buffer as a TaskJuggler file and open it -with the TaskJuggler GUI." - (interactive) - (let* ((file-name (buffer-file-name (org-export-as-taskjuggler))) - (process-name "TaskJugglerUI") - (command (concat process-name " " file-name))) - (start-process-shell-command process-name nil command))) - -(defun org-taskjuggler-targeting-tj3-p () - "Return true if we are targeting TaskJuggler III." - (>= org-export-taskjuggler-target-version 3.0)) - -(defun org-taskjuggler-parent-is-ordered-p () - "Return true if the parent of the current node has a property -\"ORDERED\". Return nil otherwise." - (save-excursion - (and (org-up-heading-safe) (org-entry-get (point) "ORDERED")))) - -(defun org-taskjuggler-components () - "Return an alist containing all the pertinent information for -the current node such as the headline, the level, todo state -information, all the properties, etc." - (let* ((props (org-entry-properties)) - (components (org-heading-components)) - (level (nth 1 components)) - (headline - (replace-regexp-in-string - "\"" "\\\"" (nth 4 components) t t)) ; quote double quotes in headlines - (parent-ordered (org-taskjuggler-parent-is-ordered-p))) - (push (cons "level" level) props) - (push (cons "headline" headline) props) - (push (cons "parent-ordered" parent-ordered) props))) - -(defun org-taskjuggler-assign-task-ids (tasks) - "Given a list of tasks return the same list assigning a unique id -and the full path to each task. Taskjuggler takes hierarchical ids. -For that reason we have to make ids locally unique and we have to keep -a path to the current task." - (let ((previous-level 0) - unique-ids unique-id - path - task resolved-tasks tmp) - (dolist (task tasks resolved-tasks) - (let ((level (cdr (assoc "level" task)))) - (cond - ((< previous-level level) - (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) - (dotimes (tmp (- level previous-level)) - (push (list unique-id) unique-ids) - (push unique-id path))) - ((= previous-level level) - (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) - (push unique-id (car unique-ids)) - (setcar path unique-id)) - ((> previous-level level) - (dotimes (tmp (- previous-level level)) - (pop unique-ids) - (pop path)) - (setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids))) - (push unique-id (car unique-ids)) - (setcar path unique-id))) - (push (cons "unique-id" unique-id) task) - (push (cons "path" (mapconcat 'identity (reverse path) ".")) task) - (setq previous-level level) - (setq resolved-tasks (append resolved-tasks (list task))))))) - -(defun org-taskjuggler-compute-task-leafiness (tasks) - "Figure out if each task is a leaf by looking at it's level, -and the level of its successor. If the successor is higher (ie -deeper), then it's not a leaf." - (let (new-list) - (while (car tasks) - (let ((task (car tasks)) - (successor (car (cdr tasks)))) - (cond - ;; if a task has no successors it is a leaf - ((null successor) - (push (cons (cons "leaf-node" t) task) new-list)) - ;; if the successor has a lower level than task it is a leaf - ((<= (cdr (assoc "level" successor)) (cdr (assoc "level" task))) - (push (cons (cons "leaf-node" t) task) new-list)) - ;; otherwise examine the rest of the tasks - (t (push task new-list)))) - (setq tasks (cdr tasks))) - (nreverse new-list))) - -(defun org-taskjuggler-assign-resource-ids (resources) - "Given a list of resources return the same list, assigning a -unique id to each resource." - (let (unique-ids new-list) - (dolist (resource resources new-list) - (let ((unique-id (org-taskjuggler-get-unique-id resource unique-ids))) - (push (cons "unique-id" unique-id) resource) - (push unique-id unique-ids) - (push resource new-list))) - (nreverse new-list))) - -(defun org-taskjuggler-resolve-dependencies (tasks) - (let ((previous-level 0) - siblings - task resolved-tasks) - (dolist (task tasks resolved-tasks) - (let* ((level (cdr (assoc "level" task))) - (depends (cdr (assoc "depends" task))) - (parent-ordered (cdr (assoc "parent-ordered" task))) - (blocker (cdr (assoc "BLOCKER" task))) - (blocked-on-previous - (and blocker (string-match "previous-sibling" blocker))) - (dependencies - (org-taskjuggler-resolve-explicit-dependencies - (append - (and depends (org-taskjuggler-tokenize-dependencies depends)) - (and blocker (org-taskjuggler-tokenize-dependencies blocker))) - tasks)) - previous-sibling) - ; update previous sibling info - (cond - ((< previous-level level) - (dotimes (tmp (- level previous-level)) - (push task siblings))) - ((= previous-level level) - (setq previous-sibling (car siblings)) - (setcar siblings task)) - ((> previous-level level) - (dotimes (tmp (- previous-level level)) - (pop siblings)) - (setq previous-sibling (car siblings)) - (setcar siblings task))) - ; insert a dependency on previous sibling if the parent is - ; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling" - (when (or (and previous-sibling parent-ordered) blocked-on-previous) - (push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies)) - ; store dependency information - (when dependencies - (push (cons "depends" (mapconcat 'identity dependencies ", ")) task)) - (setq previous-level level) - (setq resolved-tasks (append resolved-tasks (list task))))))) - -(defun org-taskjuggler-tokenize-dependencies (dependencies) - "Split a dependency property value DEPENDENCIES into the -individual dependencies and return them as a list while keeping -the optional arguments (such as gapduration) for the -dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'." - (cond - ((string-match "^ *$" dependencies) nil) - ((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies) - (cons - (substring dependencies (match-beginning 1) (match-end 1)) - (org-taskjuggler-tokenize-dependencies (substring dependencies (match-end 0))))) - (t (error (format "invalid dependency id %s" dependencies))))) - -(defun org-taskjuggler-resolve-explicit-dependencies (dependencies tasks) - "For each dependency in DEPENDENCIES try to find a -corresponding task with a matching property \"task_id\" in TASKS. -Return a list containing the resolved links for all DEPENDENCIES -where a matching tasks was found. If the dependency is -\"previous-sibling\" it is ignored (as this is dealt with in -`org-taskjuggler-resolve-dependencies'). If there is no matching -task the dependency is ignored and a warning is displayed ." - (unless (null dependencies) - (let* - ;; the dependency might have optional attributes such as "{ - ;; gapduration 5d }", so only use the first string as id for the - ;; dependency - ((dependency (car dependencies)) - (id (car (split-string dependency))) - (optional-attributes - (mapconcat 'identity (cdr (split-string dependency)) " ")) - (path (org-taskjuggler-find-task-with-id id tasks))) - (cond - ;; ignore previous sibling dependencies - ((equal (car dependencies) "previous-sibling") - (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks)) - ;; if the id is found in another task use its path - ((not (null path)) - (cons (mapconcat 'identity (list path optional-attributes) " ") - (org-taskjuggler-resolve-explicit-dependencies - (cdr dependencies) tasks))) - ;; warn about dangling dependency but otherwise ignore it - (t (display-warning - 'org-export-taskjuggler - (format "No task with matching property \"task_id\" found for id %s" id)) - (org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks)))))) - -(defun org-taskjuggler-find-task-with-id (id tasks) - "Find ID in tasks. If found return the path of task. Otherwise -return nil." - (let ((task-id (cdr (assoc "task_id" (car tasks)))) - (path (cdr (assoc "path" (car tasks))))) - (cond - ((null tasks) nil) - ((equal task-id id) path) - (t (org-taskjuggler-find-task-with-id id (cdr tasks)))))) - -(defun org-taskjuggler-get-unique-id (item unique-ids) - "Return a unique id for an ITEM which can be a task or a resource. -The id is derived from the headline and made unique against -UNIQUE-IDS. If the (downcased) first token of the headline is not -unique try to add more (downcased) tokens of the headline or -finally add more underscore characters (\"_\")." - (let* ((headline (cdr (assoc "headline" item))) - (parts (split-string headline)) - (id (org-taskjuggler-clean-id (downcase (pop parts))))) - ; try to add more parts of the headline to make it unique - (while (and (member id unique-ids) (car parts)) - (setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts)))))) - ; if its still not unique add "_" - (while (member id unique-ids) - (setq id (concat id "_"))) - id)) - -(defun org-taskjuggler-clean-id (id) - "Clean and return ID to make it acceptable for taskjuggler." - (and id - ;; replace non-ascii by _ - (replace-regexp-in-string - "[^a-zA-Z0-9_]" "_" - ;; make sure id doesn't start with a number - (replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id)))) - -(defun org-taskjuggler-open-project (project) - "Insert the beginning of a project declaration. All valid -attributes from the PROJECT alist are inserted. If no end date is -specified it is calculated -`org-export-taskjuggler-default-project-duration' days from now." - (let* ((unique-id (cdr (assoc "unique-id" project))) - (headline (cdr (assoc "headline" project))) - (version (cdr (assoc "version" project))) - (start (cdr (assoc "start" project))) - (end (cdr (assoc "end" project)))) - (insert - (format "project %s \"%s\" \"%s\" %s +%sd {\n }\n" - unique-id headline version start - org-export-taskjuggler-default-project-duration)))) - -(defun org-taskjuggler-filter-and-join (items) - "Filter all nil elements from ITEMS and join the remaining ones -with separator \"\n\"." - (let ((filtered-items (remq nil items))) - (and filtered-items (mapconcat 'identity filtered-items "\n")))) - -(defun org-taskjuggler-get-attributes (item attributes) - "Return all attribute as a single formatted string. ITEM is an -alist representing either a resource or a task. ATTRIBUTES is a -list of symbols. Only entries from ITEM are considered that are -listed in ATTRIBUTES." - (org-taskjuggler-filter-and-join - (mapcar - (lambda (attribute) - (org-taskjuggler-filter-and-join - (org-taskjuggler-get-attribute item attribute))) - attributes))) - -(defun org-taskjuggler-get-attribute (item attribute) - "Return a list of strings containing the properly formatted -taskjuggler declaration for a given ATTRIBUTE in ITEM (an alist). -If the ATTRIBUTE is not in ITEM return nil." - (cond - ((null item) nil) - ((equal (symbol-name attribute) (car (car item))) - (cons (format "%s %s" (symbol-name attribute) (cdr (car item))) - (org-taskjuggler-get-attribute (cdr item) attribute))) - (t (org-taskjuggler-get-attribute (cdr item) attribute)))) - -(defun org-taskjuggler-open-resource (resource) - "Insert the beginning of a resource declaration. All valid -attributes from the RESOURCE alist are inserted. If the RESOURCE -defines a property \"resource_id\" it will be used as the id for -this resource. Otherwise it will use the ID property. If neither -is defined it will calculate a unique id for the resource using -`org-taskjuggler-get-unique-id'." - (let ((id (org-taskjuggler-clean-id - (or (cdr (assoc "resource_id" resource)) - (cdr (assoc "ID" resource)) - (cdr (assoc "unique-id" resource))))) - (headline (cdr (assoc "headline" resource))) - (attributes '(limits vacation shift booking efficiency journalentry rate))) - (insert - (concat - "resource " id " \"" headline "\" {\n " - (org-taskjuggler-get-attributes resource attributes) "\n")))) - -(defun org-taskjuggler-clean-effort (effort) - "Translate effort strings into a format acceptable to taskjuggler, -i.e. REAL UNIT. A valid effort string can be anything that is -accepted by `org-duration-string-to-minutes´." - (cond - ((null effort) effort) - (t (let* ((minutes (org-duration-string-to-minutes effort)) - (hours (/ minutes 60.0))) - (format "%.1fh" hours))))) - -(defun org-taskjuggler-get-priority (priority) - "Return a priority between 1 and 1000 based on PRIORITY, an -org-mode priority string." - (max 1 (/ (* 1000 (- org-lowest-priority (string-to-char priority))) - (- org-lowest-priority org-highest-priority)))) - -(defun org-taskjuggler-open-task (task) - (let* ((unique-id (cdr (assoc "unique-id" task))) - (headline (cdr (assoc "headline" task))) - (effort (org-taskjuggler-clean-effort (cdr (assoc org-effort-property task)))) - (depends (cdr (assoc "depends" task))) - (allocate (cdr (assoc "allocate" task))) - (priority-raw (cdr (assoc "PRIORITY" task))) - (priority (and priority-raw (org-taskjuggler-get-priority priority-raw))) - (state (cdr (assoc "TODO" task))) - (complete (or (and (member state org-done-keywords) "100") - (cdr (assoc "complete" task)))) - (parent-ordered (cdr (assoc "parent-ordered" task))) - (previous-sibling (cdr (assoc "previous-sibling" task))) - (milestone (or (cdr (assoc "milestone" task)) - (and (assoc "leaf-node" task) - (not (or effort - (cdr (assoc "duration" task)) - (cdr (assoc "end" task)) - (cdr (assoc "period" task))))))) - (attributes - '(account start note duration endbuffer endcredit end - flags journalentry length maxend maxstart minend - minstart period reference responsible scheduling - startbuffer startcredit statusnote))) - (insert - (concat - "task " unique-id " \"" headline "\" {\n" - (if (and parent-ordered previous-sibling) - (format " depends %s\n" previous-sibling) - (and depends (format " depends %s\n" depends))) - (and allocate (format " purge %s\n allocate %s\n" - (or (and (org-taskjuggler-targeting-tj3-p) "allocate") - "allocations") - allocate)) - (and complete (format " complete %s\n" complete)) - (and effort (format " effort %s\n" effort)) - (and priority (format " priority %s\n" priority)) - (and milestone (format " milestone\n")) - - (org-taskjuggler-get-attributes task attributes) - "\n")))) - -(defun org-taskjuggler-close-maybe (level) - (while (> org-export-taskjuggler-old-level level) - (insert "}\n") - (setq org-export-taskjuggler-old-level (1- org-export-taskjuggler-old-level))) - (when (= org-export-taskjuggler-old-level level) - (insert "}\n"))) - -(defun org-taskjuggler-insert-reports () - (let (report) - (dolist (report org-export-taskjuggler-default-reports) - (insert report "\n")))) - -(provide 'org-taskjuggler) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-taskjuggler.el ends here diff --git a/lisp/org-w3m.el b/lisp/org-w3m.el index e1cc99627..a2f29165e 100644 --- a/lisp/org-w3m.el +++ b/lisp/org-w3m.el @@ -8,12 +8,12 @@ ;; ;; This file is part of GNU Emacs. ;; -;; GNU Emacs is free software: you can redistribute it and/or modify +;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; GNU Emacs is distributed in the hope that it will be useful, +;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. @@ -43,6 +43,19 @@ (require 'org) +(defvar w3m-current-url) +(defvar w3m-current-title) + +(add-hook 'org-store-link-functions 'org-w3m-store-link) +(defun org-w3m-store-link () + "Store a link to a w3m buffer." + (when (eq major-mode 'w3m-mode) + (org-store-link-props + :type "w3m" + :link w3m-current-url + :url (url-view-url t) + :description (or w3m-current-title w3m-current-url)))) + (defun org-w3m-copy-for-org-mode () "Copy current buffer content or active region with `org-mode' style links. This will encode `link-title' and `link-location' with diff --git a/lisp/org-xoxo.el b/lisp/org-xoxo.el deleted file mode 100644 index 1083fe16c..000000000 --- a/lisp/org-xoxo.el +++ /dev/null @@ -1,129 +0,0 @@ -;;; org-xoxo.el --- XOXO export for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; XOXO export - -;;; Code: - -(require 'org-exp) - -(defvar org-export-xoxo-final-hook nil - "Hook run after XOXO export, in the new buffer.") - -(defun org-export-as-xoxo-insert-into (buffer &rest output) - (with-current-buffer buffer - (apply 'insert output))) -(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1) - -;;;###autoload -(defun org-export-as-xoxo (&optional buffer) - "Export the org buffer as XOXO. -The XOXO buffer is named *xoxo-*" - (interactive (list (current-buffer))) - (run-hooks 'org-export-first-hook) - ;; A quickie abstraction - - ;; Output everything as XOXO - (with-current-buffer (get-buffer buffer) - (let* ((pos (point)) - (opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (filename (concat (file-name-as-directory - (org-export-directory :xoxo opt-plist)) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".html")) - (out (find-file-noselect filename)) - (last-level 1) - (hanging-li nil)) - (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. - ;; Check the output buffer is empty. - (with-current-buffer out (erase-buffer)) - ;; Kick off the output - (org-export-as-xoxo-insert-into out "
      \n") - (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't) - (let* ((hd (match-string-no-properties 1)) - (level (length hd)) - (text (concat - (match-string-no-properties 2) - (save-excursion - (goto-char (match-end 0)) - (let ((str "")) - (catch 'loop - (while 't - (forward-line) - (if (looking-at "^[ \t]\\(.*\\)") - (setq str (concat str (match-string-no-properties 1))) - (throw 'loop str))))))))) - - ;; Handle level rendering - (cond - ((> level last-level) - (org-export-as-xoxo-insert-into out "\n
        \n")) - - ((< level last-level) - (dotimes (- (- last-level level) 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "\n")) - (org-export-as-xoxo-insert-into out "
      \n")) - (when hanging-li - (org-export-as-xoxo-insert-into out "\n") - (setq hanging-li nil))) - - ((equal level last-level) - (if hanging-li - (org-export-as-xoxo-insert-into out "\n"))) - ) - - (setq last-level level) - - ;; And output the new li - (setq hanging-li 't) - (if (equal ?+ (elt text 0)) - (org-export-as-xoxo-insert-into out "
    1. ") - (org-export-as-xoxo-insert-into out "
    2. " text)))) - - ;; Finally finish off the ol - (dotimes (- last-level 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "
    3. \n")) - (org-export-as-xoxo-insert-into out "
    \n")) - - (goto-char pos) - ;; Finish the buffer off and clean it up. - (switch-to-buffer-other-window out) - (indent-region (point-min) (point-max) nil) - (run-hooks 'org-export-xoxo-final-hook) - (save-buffer) - (goto-char (point-min)) - ))) - -(provide 'org-xoxo) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-xoxo.el ends here diff --git a/lisp/org.el b/lisp/org.el index 13fb44d14..b41185ea1 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -22,7 +22,6 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: ;; @@ -78,10 +77,13 @@ (require 'find-func) (require 'format-spec) -(load "org-loaddefs.el" t t) +(load "org-loaddefs.el" t t t) + +(require 'org-macs) +(require 'org-compat) ;; `org-outline-regexp' ought to be a defconst but is let-binding in -;; some places -- e.g. see the macro org-with-limited-levels. +;; some places -- e.g. see the macro `org-with-limited-levels'. ;; ;; In Org buffers, the value of `outline-regexp' is that of ;; `org-outline-regexp'. The only function still directly relying on @@ -96,42 +98,67 @@ This is similar to `org-outline-regexp' but additionally makes sure that we are at the beginning of the line.") (defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Matches an headline, putting stars and text into groups. + "Matches a headline, putting stars and text into groups. Stars are put in group 1 and the trimmed body in group 2.") ;; Emacs 22 calendar compatibility: Make sure the new variables are available -(when (fboundp 'defvaralias) - (unless (boundp 'calendar-view-holidays-initially-flag) - (defvaralias 'calendar-view-holidays-initially-flag - 'view-calendar-holidays-initially)) - (unless (boundp 'calendar-view-diary-initially-flag) - (defvaralias 'calendar-view-diary-initially-flag - 'view-diary-entries-initially)) - (unless (boundp 'diary-fancy-buffer) - (defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))) +(unless (boundp 'calendar-view-holidays-initially-flag) + (org-defvaralias 'calendar-view-holidays-initially-flag + 'view-calendar-holidays-initially)) +(unless (boundp 'calendar-view-diary-initially-flag) + (org-defvaralias 'calendar-view-diary-initially-flag + 'view-diary-entries-initially)) +(unless (boundp 'diary-fancy-buffer) + (org-defvaralias 'diary-fancy-buffer 'fancy-diary-buffer)) (declare-function org-inlinetask-at-task-p "org-inlinetask" ()) (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) -(declare-function org-clock-timestamps-up "org-clock" ()) -(declare-function org-clock-timestamps-down "org-clock" ()) +(declare-function org-clock-get-last-clock-out-time "org-clock" ()) +(declare-function org-clock-timestamps-up "org-clock" (&optional n)) +(declare-function org-clock-timestamps-down "org-clock" (&optional n)) (declare-function org-clock-sum-current-item "org-clock" (&optional tstart)) (declare-function orgtbl-mode "org-table" (&optional arg)) (declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time)) -(declare-function org-beamer-mode "org-beamer" ()) +(declare-function org-beamer-mode "ox-beamer" ()) (declare-function org-table-edit-field "org-table" (arg)) (declare-function org-table-justify-field-maybe "org-table" (&optional new)) +(declare-function org-table-set-constants "org-table" ()) (declare-function org-id-get-create "org-id" (&optional force)) (declare-function org-id-find-id-file "org-id" (id)) (declare-function org-tags-view "org-agenda" (&optional todo-only match)) (declare-function org-agenda-list "org-agenda" (&optional arg start-day span)) +(declare-function org-agenda-redo "org-agenda" (&optional all)) (declare-function org-table-align "org-table" ()) (declare-function org-table-paste-rectangle "org-table" ()) (declare-function org-table-maybe-eval-formula "org-table" ()) (declare-function org-table-maybe-recalculate-line "org-table" ()) +(declare-function org-element--parse-objects "org-element" + (beg end acc restriction)) +(declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-contents "org-element" (element)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-interpret-data "org-element" + (data &optional parent)) +(declare-function org-element-map "org-element" + (data types fun &optional info first-match no-recursion)) +(declare-function org-element-nested-p "org-element" (elem-a elem-b)) +(declare-function org-element-parse-buffer "org-element" + (&optional granularity visible-only)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-put-property "org-element" + (element property value)) +(declare-function org-element-swap-A-B "org-element" (elem-a elem-b)) +(declare-function org-element--parse-objects "org-element" + (beg end acc restriction)) +(declare-function org-element-parse-buffer "org-element" + (&optional granularity visible-only)) +(declare-function org-element-restriction "org-element" (element)) +(declare-function org-element-type "org-element" (element)) + ;; load languages based on value of `org-babel-load-languages' (defvar org-babel-load-languages) @@ -151,6 +178,33 @@ Stars are put in group 1 and the trimmed body in group 2.") (intern (concat "org-babel-expand-body:" lang))))))) org-babel-load-languages)) +;;;###autoload +(defun org-babel-load-file (file &optional compile) + "Load Emacs Lisp source code blocks in the Org-mode FILE. +This function exports the source code using `org-babel-tangle' +and then loads the resulting file using `load-file'. With prefix +arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp +file to byte-code before it is loaded." + (interactive "fFile to load: \nP") + (require 'ob-core) + (let* ((age (lambda (file) + (float-time + (time-subtract (current-time) + (nth 5 (or (file-attributes (file-truename file)) + (file-attributes file))))))) + (base-name (file-name-sans-extension file)) + (exported-file (concat base-name ".el"))) + ;; tangle if the org-mode file is newer than the elisp file + (unless (and (file-exists-p exported-file) + (> (funcall age file) (funcall age exported-file))) + (org-babel-tangle-file file exported-file "emacs-lisp")) + (message "%s %s" + (if compile + (progn (byte-compile-file exported-file 'load) + "Compiled and loaded") + (progn (load-file exported-file) "Loaded")) + exported-file))) + (defcustom org-babel-load-languages '((emacs-lisp . t)) "Languages which can be evaluated in Org-mode buffers. This list can be used to load support for any of the languages @@ -188,6 +242,7 @@ requirements) is loaded." (const :tag "Ledger" ledger) (const :tag "Lilypond" lilypond) (const :tag "Lisp" lisp) + (const :tag "Makefile" makefile) (const :tag "Maxima" maxima) (const :tag "Matlab" matlab) (const :tag "Mscgen" mscgen) @@ -220,7 +275,6 @@ identifier." :group 'org-id) ;;; Version -(require 'org-compat) (org-check-version) ;;;###autoload @@ -231,11 +285,13 @@ When FULL is non-nil, use a verbose version string. When MESSAGE is non-nil, display a message with the version." (interactive "P") (let* ((org-dir (ignore-errors (org-find-library-dir "org"))) - (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs.el"))) + (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes)) + (load-suffixes (list ".el")) + (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs"))) (org-trash (or (and (fboundp 'org-release) (fboundp 'org-git-version)) - (load (concat org-dir "org-version.el") - 'noerror 'nomessage 'nosuffix))) + (org-load-noerror-mustsuffix (concat org-dir "org-version")))) + (load-suffixes save-load-suffixes) (org-version (org-release)) (git-version (org-git-version)) (version (format "Org-mode version %s (%s @ %s)" @@ -301,24 +357,25 @@ When MESSAGE is non-nil, display a message with the version." (when (featurep 'org) (org-load-modules-maybe 'force))) -(when (org-bound-and-true-p org-modules) - (let ((a (member 'org-infojs org-modules))) - (and a (setcar a 'org-jsinfo)))) - -(defcustom org-modules '(org-bbdb org-bibtex org-docview org-gnus org-info org-jsinfo org-irc org-mew org-mhe org-rmail org-vm org-w3m org-wl) +(defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail) "Modules that should always be loaded together with org.el. + If a description starts with , the file is not part of Emacs -and loading it will require that you have downloaded and properly installed -the org-mode distribution. +and loading it will require that you have downloaded and properly +installed the Org mode distribution. You can also use this system to load external packages (i.e. neither Org core modules, nor modules from the CONTRIB directory). Just add symbols to the end of the list. If the package is called org-xyz.el, then you need -to add the symbol `xyz', and the package must have a call to +to add the symbol `xyz', and the package must have a call to: - (provide 'org-xyz)" + \(provide 'org-xyz) + +For export specific modules, see also `org-export-backends'." :group 'org :set 'org-set-modules + :version "24.4" + :package-version '(Org . "8.0") :type '(set :greedy t (const :tag " bbdb: Links to BBDB entries" org-bbdb) @@ -327,26 +384,20 @@ to add the symbol `xyz', and the package must have a call to (const :tag " ctags: Access to Emacs tags with links" org-ctags) (const :tag " docview: Links to doc-view buffers" org-docview) (const :tag " gnus: Links to GNUS folders/messages" org-gnus) + (const :tag " habit: Track your consistency with habits" org-habit) (const :tag " id: Global IDs for identifying entries" org-id) (const :tag " info: Links to Info nodes" org-info) - (const :tag " jsinfo: Set up Sebastian Rose's JavaScript org-info.js" org-jsinfo) - (const :tag " habit: Track your consistency with habits" org-habit) (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask) (const :tag " irc: Links to IRC/ERC chat sessions" org-irc) - (const :tag " mac-message: Links to messages in Apple Mail" org-mac-message) - (const :tag " mew Links to Mew folders/messages" org-mew) (const :tag " mhe: Links to MHE folders/messages" org-mhe) + (const :tag " mouse: Additional mouse support" org-mouse) (const :tag " protocol: Intercept calls from emacsclient" org-protocol) (const :tag " rmail: Links to RMAIL folders/messages" org-rmail) - (const :tag " special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks) - (const :tag " vm: Links to VM folders/messages" org-vm) - (const :tag " wl: Links to Wanderlust folders/messages" org-wl) (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m) - (const :tag " mouse: Additional mouse support" org-mouse) - (const :tag " TaskJuggler: Export tasks to a TaskJuggler project" org-taskjuggler) (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark) + (const :tag "C bullets: Add overlays to headlines stars" org-bullets) (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist) (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) (const :tag "C collector: Collect properties into tables" org-collector) @@ -354,35 +405,139 @@ to add the symbol `xyz', and the package must have a call to (const :tag "C drill: Flashcards and spaced repetition for Org-mode" org-drill) (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol) (const :tag "C eshell Support for links to working directories in eshell" org-eshell) - (const :tag "C eval: Include command output as text" org-eval) (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) + (const :tag "C eval: Include command output as text" org-eval) (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry) - (const :tag "C exp-bibtex: Export citations using BibTeX" org-exp-bibtex) + (const :tag "C favtable: Lookup table of favorite references and links" org-favtable) (const :tag "C git-link: Provide org links to specific file version" org-git-link) (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query) - (const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice) - (const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira) (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) - (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) - (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch) (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal) (const :tag "C mac-link-grabber Grab links and URLs from various Mac applications" org-mac-link-grabber) + (const :tag "C mac-message: Links to messages in Apple Mail" org-mac-message) + (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) (const :tag "C man: Support for links to manpages in Org-mode" org-man) + (const :tag "C mew: Links to Mew folders/messages" org-mew) (const :tag "C mtags: Support for muse-like tags" org-mtags) + (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch) (const :tag "C panel: Simple routines for us with bad memory" org-panel) (const :tag "C registry: A registry for Org-mode links" org-registry) - (const :tag "C org2rem: Convert org appointments into reminders" org2rem) (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen) (const :tag "C secretary: Team management with org-mode" org-secretary) (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) (const :tag "C track: Keep up with Org-mode development" org-track) (const :tag "C velocity Something like Notational Velocity for Org" org-velocity) + (const :tag "C vm: Links to VM folders/messages" org-vm) (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes) + (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 +(declare-function org-export-derived-backend-p "ox" (backend &rest backends)) +(defcustom org-export-backends '(ascii html icalendar latex) + "List of export back-ends that should be always available. + +If a description starts with , the file is not part of Emacs +and loading it will require that you have downloaded and properly +installed the Org mode distribution. + +Unlike to `org-modules', libraries in this list will not be +loaded along with Org, but only once the export framework is +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: + + \(progn + \(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))) + \(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))) + +Adding a back-end to this list will also pull the back-end it +depends on, if any." + :group 'org + :group 'org-export + :version "24.4" + :package-version '(Org . "8.0") + :initialize 'custom-initialize-set + :set (lambda (var val) + (if (not (featurep 'ox)) (set-default var val) + ;; 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 + (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)) + ;; Now build NEW-LIST of both new back-ends and required + ;; parents. + (let ((new-list (mapcar 'car 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 VAR to that list with fixed dependencies. + (set-default var new-list)))) + :type '(set :greedy t + (const :tag " ascii Export buffer to ASCII format" ascii) + (const :tag " beamer Export buffer to Beamer presentation" beamer) + (const :tag " html Export buffer to HTML format" html) + (const :tag " icalendar Export buffer to iCalendar format" icalendar) + (const :tag " latex Export buffer to LaTeX format" latex) + (const :tag " man Export buffer to MAN format" man) + (const :tag " md Export buffer to Markdown format" md) + (const :tag " odt Export buffer to ODT format" odt) + (const :tag " org Export buffer to Org format" org) + (const :tag " texinfo Export buffer to Texinfo format" texinfo) + (const :tag "C confluence Export buffer to Confluence Wiki format" confluence) + (const :tag "C deck Export buffer to deck.js presentations" deck) + (const :tag "C freemind Export buffer to Freemind mindmap format" freemind) + (const :tag "C groff Export buffer to Groff format" groff) + (const :tag "C koma-letter Export buffer to KOMA Scrlttrl2 format" koma-letter) + (const :tag "C RSS 2.0 Export buffer to RSS 2.0 format" rss) + (const :tag "C s5 Export buffer to s5 presentations" s5) + (const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler))) + +(eval-after-load 'ox + '(mapc + (lambda (backend) + (condition-case nil (require (intern (format "ox-%s" backend))) + (error (message "Problems while trying to load export back-end `%s'" + backend)))) + org-export-backends)) + (defcustom org-support-shift-select nil "Non-nil means make shift-cursor commands select text when possible. @@ -498,7 +653,7 @@ the following lines anywhere in the buffer: (const :tag "Globally (slow on startup in large files)" t))) (defcustom org-use-sub-superscripts t - "Non-nil means interpret \"_\" and \"^\" for export. + "Non-nil means interpret \"_\" and \"^\" for display. When this option is turned on, you can use TeX-like syntax for sub- and superscripts. Several characters after \"_\" or \"^\" will be considered as a single item - so grouping with {} is normally not @@ -511,27 +666,18 @@ sub- or superscripts. terminated by almost any nonword/nondigit char. x_{i^2} or x^(2-i) braces or parenthesis do grouping. -Still, ambiguity is possible - so when in doubt use {} to enclose the -sub/superscript. If you set this variable to the symbol `{}', -the braces are *required* in order to trigger interpretations as -sub/superscript. This can be helpful in documents that need \"_\" -frequently in plain text. - -Not all export backends support this, but HTML does. - -This option can also be set with the #+OPTIONS line, e.g. \"^:nil\"." +Still, ambiguity is possible - so when in doubt use {} to enclose +the sub/superscript. If you set this variable to the symbol +`{}', the braces are *required* in order to trigger +interpretations as sub/superscript. This can be helpful in +documents that need \"_\" frequently in plain text." :group 'org-startup - :group 'org-export-translation :version "24.1" :type '(choice (const :tag "Always interpret" t) (const :tag "Only with braces" {}) (const :tag "Never interpret" nil))) -(if (fboundp 'defvaralias) - (defvaralias 'org-export-with-sub-superscripts 'org-use-sub-superscripts)) - - (defcustom org-startup-with-beamer-mode nil "Non-nil means turn on `org-beamer-mode' on startup. This can also be configured on a per-file basis by adding one of @@ -563,6 +709,18 @@ the following lines anywhere in the buffer: :version "24.1" :type 'boolean) +(defcustom org-startup-with-latex-preview nil + "Non-nil means preview LaTeX fragments when loading a new Org file. + +This can also be configured on a per-file basis by adding one of +the followinglines anywhere in the buffer: + #+STARTUP: latexpreview + #+STARTUP: nolatexpreview" + :group 'org-startup + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + (defcustom org-insert-mode-line-in-empty-file nil "Non-nil means insert the first line setting Org-mode in empty files. When the function `org-mode' is called interactively in an empty file, this @@ -602,8 +760,7 @@ it work for ESC." :group 'org-startup :type 'boolean) -(if (fboundp 'defvaralias) - (defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)) +(org-defvaralias 'org-CUA-compatible 'org-replace-disputed-keys) (defcustom org-disputed-keys '(([(shift up)] . [(meta p)]) @@ -695,6 +852,14 @@ Changes become only effective after restarting Emacs." :group 'org-keywords :type 'string) +(defcustom org-closed-keep-when-no-todo nil + "Remove CLOSED: time-stamp when switching back to a non-todo state?" + :group 'org-todo + :group 'org-keywords + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + (defconst org-planning-or-clock-line-re (concat "^[ \t]*\\(" org-scheduled-string "\\|" org-deadline-string "\\|" @@ -786,7 +951,7 @@ contexts. See `org-show-hierarchy-above' for valid contexts." :group 'org-reveal-location :type org-context-choice) -(defcustom org-show-siblings '((default . nil) (isearch t)) +(defcustom org-show-siblings '((default . nil) (isearch t) (bookmark-jump t)) "Non-nil means show all sibling heading when revealing a location. Org-mode often shows locations in an org-mode file which might have been invisible before. When this is set, the sibling of the current entry @@ -800,7 +965,9 @@ use the command \\[org-reveal] to show more context. Instead of t, this can also be an alist specifying this option for different contexts. See `org-show-hierarchy-above' for valid contexts." :group 'org-reveal-location - :type org-context-choice) + :type org-context-choice + :version "24.4" + :package-version '(Org . "8.0")) (defcustom org-show-entry-below '((default . nil)) "Non-nil means show the entry below a headline when revealing a location. @@ -957,8 +1124,7 @@ visibility is cycled." (const :tag "Only in completely white lines" white) (const :tag "Before first char in a line" whitestart) (const :tag "Everywhere except in headlines" t) - (const :tag "Everywhere except at bol in headlines" exc-hl-bol) - )) + (const :tag "Everywhere except at bol in headlines" exc-hl-bol))) (defcustom org-cycle-separator-lines 2 "Number of empty lines needed to keep an empty line between collapsed trees. @@ -990,6 +1156,7 @@ the values `folded', `children', or `subtree'." (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees org-cycle-hide-drawers + org-cycle-hide-inline-tasks org-cycle-show-empty-lines org-optimize-window-after-visibility-change) "Hook that is run after `org-cycle' has changed the buffer visibility. @@ -1083,8 +1250,7 @@ This may also be a cons cell where the behavior for `C-a' and (const :tag "off" nil) (const :tag "on: before tags first" t) (const :tag "reversed: after tags first" reversed))))) -(if (fboundp 'defvaralias) - (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)) +(org-defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e) (defcustom org-special-ctrl-k nil "Non-nil means `C-k' will behave specially in headlines. @@ -1180,9 +1346,8 @@ default the value to be used for all contexts not explicitly (defcustom org-insert-heading-respect-content nil "Non-nil means insert new headings after the current subtree. When nil, the new heading is created directly after the current line. -The commands \\[org-insert-heading-respect-content] and -\\[org-insert-todo-heading-respect-content] turn this variable on -for the duration of the command." +The commands \\[org-insert-heading-respect-content] and \\[org-insert-todo-heading-respect-content] turn +this variable on for the duration of the command." :group 'org-structure :type 'boolean) @@ -1194,9 +1359,9 @@ and a boolean flag as CDR. The cdr may also be the symbol `auto', in which case Org will look at the surrounding headings/items and try to make an intelligent decision whether to insert a blank line or not. -For plain lists, if the variable `org-empty-line-terminates-plain-lists' is -set, the setting here is ignored and no empty line is inserted, to avoid -breaking the list structure." +For plain lists, if `org-list-empty-line-terminates-plain-lists' is set, +the setting here is ignored and no empty line is inserted to avoid breaking +the list structure." :group 'org-edit-structure :type '(list (cons (const heading) @@ -1535,7 +1700,8 @@ implementation is bad." :type 'boolean) (defcustom org-return-follows-link nil - "Non-nil means on links RET will follow the link." + "Non-nil means on links RET will follow the link. +In tables, the special behavior of RET has precedence." :group 'org-link-follow :type 'boolean) @@ -1746,12 +1912,10 @@ The system \"open\" is used for most files. See `org-file-apps'.") (defcustom org-file-apps - '( - (auto-mode . emacs) + '((auto-mode . emacs) ("\\.mm\\'" . default) ("\\.x?html?\\'" . default) - ("\\.pdf\\'" . default) - ) + ("\\.pdf\\'" . default)) "External applications for opening `file:path' items in a document. Org-mode uses system defaults for different file types, but you can use this variable to set the application for a given file @@ -2157,7 +2321,12 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'." (defvar org-done-keywords-for-agenda nil) (defvar org-drawers-for-agenda nil) (defvar org-todo-keyword-alist-for-agenda nil) -(defvar org-tag-alist-for-agenda nil) +(defvar org-tag-alist-for-agenda nil + "Alist of all tags from all agenda files.") +(defvar org-tag-groups-alist-for-agenda nil + "Alist of all groups tags from all current agenda files.") +(defvar org-tag-groups-alist nil) +(make-variable-buffer-local 'org-tag-groups-alist) (defvar org-agenda-contributing-files nil) (defvar org-not-done-keywords nil) (make-variable-buffer-local 'org-not-done-keywords) @@ -2491,6 +2660,11 @@ also set this to a string to define the drawer of your choice. A value of t is also allowed, representing \"LOGBOOK\". +A value of t or nil can also be set with on a per-file-basis with + + #+STARTUP: logdrawer + #+STARTUP: nologdrawer + If this variable is set, `org-log-state-notes-insert-after-drawers' will be ignored. @@ -2503,8 +2677,7 @@ a subtree." (const :tag "LOGBOOK" t) (string :tag "Other"))) -(if (fboundp 'defvaralias) - (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)) +(org-defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer) (defun org-log-into-drawer () "Return the value of `org-log-into-drawer', but let properties overrule. @@ -2532,7 +2705,12 @@ set." (defcustom org-log-states-order-reversed t "Non-nil means the latest state note will be directly after heading. -When nil, the state change notes will be ordered according to time." +When nil, the state change notes will be ordered according to time. + +This option can also be set with on a per-file-basis with + + #+STARTUP: logstatesreversed + #+STARTUP: nologstatesreversed" :group 'org-todo :group 'org-progress :type 'boolean) @@ -2705,26 +2883,137 @@ commands, if custom time display is turned on at the time of export." (concat "[" (substring f 1 -1) "]") f))) -(defcustom org-time-clocksum-format "%d:%02d" +(defcustom org-time-clocksum-format + '(:days "%dd " :hours "%d" :require-hours t :minutes ":%02d" :require-minutes t) "The format string used when creating CLOCKSUM lines. -This is also used when org-mode generates a time duration." +This is also used when Org mode generates a time duration. + +The value can be a single format string containing two +%-sequences, which will be filled with the number of hours and +minutes in that order. + +Alternatively, the value can be a plist associating any of the +keys :years, :months, :weeks, :days, :hours or :minutes with +format strings. The time duration is formatted using only the +time components that are needed and concatenating the results. +If a time unit in absent, it falls back to the next smallest +unit. + +The keys :require-years, :require-months, :require-days, +:require-weeks, :require-hours, :require-minutes are also +meaningful. A non-nil value for these keys indicates that the +corresponding time component should always be included, even if +its value is 0. + + +For example, + + \(:days \"%dd\" :hours \"%d\" :require-hours t :minutes \":%02d\" + :require-minutes t) + +means durations longer than a day will be expressed in days, +hours and minutes, and durations less than a day will always be +expressed in hours and minutes (even for durations less than an +hour). + +The value + + \(:days \"%dd\" :minutes \"%dm\") + +means durations longer than a day will be expressed in days and +minutes, and durations less than a day will be expressed entirely +in minutes (even for durations longer than an hour)." :group 'org-time - :type 'string) + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice (string :tag "Format string") + (set :tag "Plist" + (group :inline t (const :tag "Years" :years) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show years" :require-years) + (const t)) + (group :inline t (const :tag "Months" :months) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show months" :require-months) + (const t)) + (group :inline t (const :tag "Weeks" :weeks) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show weeks" :require-weeks) + (const t)) + (group :inline t (const :tag "Days" :days) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show days" :require-days) + (const t)) + (group :inline t (const :tag "Hours" :hours) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show hours" :require-hours) + (const t)) + (group :inline t (const :tag "Minutes" :minutes) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show minutes" :require-minutes) + (const t))))) (defcustom org-time-clocksum-use-fractional nil - "If non-nil, \\[org-clock-display] uses fractional times. -org-mode generates a time duration." + "When non-nil, \\[org-clock-display] uses fractional times. +See `org-time-clocksum-format' for more on time clock formats." :group 'org-time + :group 'org-clock + :version "24.3" + :type 'boolean) + +(defcustom org-time-clocksum-use-effort-durations nil + "When non-nil, \\[org-clock-display] uses effort durations. +E.g. by default, one day is considered to be a 8 hours effort, +so a task that has been clocked for 16 hours will be displayed +as during 2 days in the clock display or in the clocktable. + +See `org-effort-durations' on how to set effort durations +and `org-time-clocksum-format' for more on time clock formats." + :group 'org-time + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) (defcustom org-time-clocksum-fractional-format "%.2f" - "The format string used when creating CLOCKSUM lines, or when -org-mode generates a time duration." + "The format string used when creating CLOCKSUM lines, +or when Org mode generates a time duration, if +`org-time-clocksum-use-fractional' is enabled. + +The value can be a single format string containing one +%-sequence, which will be filled with the number of hours as +a float. + +Alternatively, the value can be a plist associating any of the +keys :years, :months, :weeks, :days, :hours or :minutes with +a format string. The time duration is formatted using the +largest time unit which gives a non-zero integer part. If all +specified formats have zero integer part, the smallest time unit +is used." :group 'org-time - :type 'string) + :type '(choice (string :tag "Format string") + (set (group :inline t (const :tag "Years" :years) + (string :tag "Format string")) + (group :inline t (const :tag "Months" :months) + (string :tag "Format string")) + (group :inline t (const :tag "Weeks" :weeks) + (string :tag "Format string")) + (group :inline t (const :tag "Days" :days) + (string :tag "Format string")) + (group :inline t (const :tag "Hours" :hours) + (string :tag "Format string")) + (group :inline t (const :tag "Minutes" :minutes) + (string :tag "Format string"))))) (defcustom org-deadline-warning-days 14 - "No. of days before expiration during which a deadline becomes active. + "Number of days before expiration during which a deadline becomes active. This variable governs the display in sparse trees and in the agenda. When 0 or negative, it means use this number (the absolute value of it) even if a deadline has a different individual lead time specified. @@ -2734,6 +3023,21 @@ Custom commands can set this variable in the options section." :group 'org-agenda-daily/weekly :type 'integer) +(defcustom org-scheduled-delay-days 0 + "Number of days before a scheduled item becomes active. +This variable governs the display in sparse trees and in the agenda. +The default value (i.e. 0) means: don't delay scheduled item. +When negative, it means use this number (the absolute value of it) +even if a scheduled item has a different individual delay time +specified. + +Custom commands can set this variable in the options section." + :group 'org-time + :group 'org-agenda-daily/weekly + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + (defcustom org-read-date-prefer-future t "Non-nil means assume future for incomplete date input from user. This affects the following situations: @@ -2821,14 +3125,19 @@ minibuffer will also be active, and you can simply enter the date as well. When nil, only the minibuffer will be available." :group 'org-time :type 'boolean) -(if (fboundp 'defvaralias) - (defvaralias 'org-popup-calendar-for-date-prompt - 'org-read-date-popup-calendar)) +(org-defvaralias 'org-popup-calendar-for-date-prompt + 'org-read-date-popup-calendar) +(make-obsolete-variable + 'org-read-date-minibuffer-setup-hook + "Set `org-read-date-minibuffer-local-map' instead." "24.4") (defcustom org-read-date-minibuffer-setup-hook nil "Hook to be used to set up keys for the date/time interface. -Add key definitions to `minibuffer-local-map', which will be a temporary -copy." +Add key definitions to `minibuffer-local-map', which will be a +temporary copy. + +WARNING: This option is obsolete, you should use +`org-read-date-minibuffer-local-map' to set up keys." :group 'org-time :type 'hook) @@ -2856,6 +3165,15 @@ For example, if `org-extend-today-until' is 8, and it's 4am, then the :version "24.1" :type 'boolean) +(defcustom org-use-last-clock-out-time-as-effective-time nil + "When non-nil, use the last clock out time for `org-todo'. +Note that this option has precedence over the combined use of +`org-use-effective-time' and `org-extend-today-until'." + :group 'org-time + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + (defcustom org-edit-timestamp-down-means-later nil "Non-nil means S-down will increase the time in a time stamp. When nil, S-up will increase." @@ -2890,6 +3208,8 @@ See the manual for details." (list :tag "Start radio group" (const :startgroup) (option (string :tag "Group description"))) + (list :tag "Group tags delimiter" + (const :grouptags)) (list :tag "End radio group" (const :endgroup) (option (string :tag "Group description"))) @@ -2912,6 +3232,7 @@ To disable these tags on a per-file basis, insert anywhere in the file: (cons (string :tag "Tag name") (character :tag "Access char")) (const :tag "Start radio group" (:startgroup)) + (const :tag "Group tags delimiter" (:grouptags)) (const :tag "End radio group" (:endgroup)) (const :tag "New line" (:newline))))) @@ -3094,7 +3415,7 @@ and the clock summary: (let ((clocksum (org-clock-sum-current-item)) (effort (org-duration-string-to-minutes (org-entry-get (point) \"Effort\")))) - (org-minutes-to-hh:mm-string (- effort clocksum))))))" + (org-minutes-to-clocksum-string (- effort clocksum))))))" :group 'org-properties :version "24.1" :type '(alist :key-type (string :tag "Property") @@ -3277,9 +3598,8 @@ scope." (const :tag "Agenda Archives" agenda-archives) (repeat :inline t (file)))) -(if (fboundp 'defvaralias) - (defvaralias 'org-agenda-multi-occur-extra-files - 'org-agenda-text-search-extra-files)) +(org-defvaralias 'org-agenda-multi-occur-extra-files + 'org-agenda-text-search-extra-files) (defcustom org-agenda-skip-unavailable-files nil "Non-nil means to just skip non-reachable files in `org-agenda-files'. @@ -3340,8 +3660,10 @@ points to a file, `org-agenda-diary-entry' will be used instead." This is a property list with the following properties: :foreground the foreground color for images embedded in Emacs, e.g. \"Black\". `default' means use the foreground of the default face. + `auto' means use the foreground from the text face. :background the background color, or \"Transparent\". `default' means use the background of the default face. + `auto' means use the background from the text face. :scale a scaling factor for the size of the images, to get more pixels :html-foreground, :html-background, :html-scale the same numbers for HTML export. @@ -3408,9 +3730,10 @@ imagemagick Convert the LaTeX fragments to pdf files and use imagemagick (const :tag "imagemagick" imagemagick))) (defcustom org-latex-preview-ltxpng-directory "ltxpng/" - "Path to store latex preview images. A relative path here creates many - directories relative to the processed org files paths. An absolute path - puts all preview images at the same place." + "Path to store latex preview images. +A relative path here creates many directories relative to the +processed org files paths. An absolute path puts all preview +images at the same place." :group 'org-latex :version "24.3" :type 'string) @@ -3451,14 +3774,12 @@ imagemagick Convert the LaTeX fragments to pdf files and use imagemagick "The document header used for processing LaTeX fragments. It is imperative that this header make sure that no page number appears on the page. The package defined in the variables -`org-export-latex-default-packages-alist' and `org-export-latex-packages-alist' -will either replace the placeholder \"[PACKAGES]\" in this header, or they -will be appended." +`org-latex-default-packages-alist' and `org-latex-packages-alist' +will either replace the placeholder \"[PACKAGES]\" in this +header, or they will be appended." :group 'org-latex :type 'string) -(defvar org-format-latex-header-extra nil) - (defun org-set-packages-alist (var val) "Set the packages alist and make sure it has 3 elements per entry." (set var (mapcar (lambda (x) @@ -3468,7 +3789,6 @@ will be appended." val))) (defun org-get-packages-alist (var) - "Get the packages alist and make sure it has 3 elements per entry." (mapcar (lambda (x) (if (and (consp x) (= (length x) 2)) @@ -3476,10 +3796,7 @@ will be appended." x)) (default-value var))) -;; The following variables are defined here because is it also used -;; when formatting latex fragments. Originally it was part of the -;; LaTeX exporter, which is why the name includes "export". -(defcustom org-export-latex-default-packages-alist +(defcustom org-latex-default-packages-alist '(("AUTO" "inputenc" t) ("T1" "fontenc" t) ("" "fixltx2e" nil) @@ -3493,30 +3810,36 @@ will be appended." ("" "wasysym" t) ("" "latexsym" t) ("" "amssymb" t) + ("" "amstext" nil) ("" "hyperref" nil) - "\\tolerance=1000" - ) + "\\tolerance=1000") "Alist of default packages to be inserted in the header. -Change this only if one of the packages here causes an incompatibility -with another package you are using. -The packages in this list are needed by one part or another of Org-mode -to function properly. + +Change this only if one of the packages here causes an +incompatibility with another package you are using. + +The packages in this list are needed by one part or another of +Org mode to function properly: - inputenc, fontenc: for basic font and character selection -- textcomp, marvosymb, wasysym, latexsym, amssym: for various symbols used - for interpreting the entities in `org-entities'. You can skip some of these - packages if you don't use any of the symbols in it. +- amstext: for subscript and superscript +- textcomp, marvosymb, wasysym, latexsym, amssym: for various + symbols used for interpreting the entities in `org-entities'. + You can skip some of these packages if you don't use any of the + symbols in it. - graphicx: for including images - float, wrapfig: for figure placement - longtable: for long tables - hyperref: for cross references -Therefore you should not modify this variable unless you know what you -are doing. The one reason to change it anyway is that you might be loading -some other package that conflicts with one of the default packages. -Each cell is of the format \( \"options\" \"package\" snippet-flag\). -If SNIPPET-FLAG is t, the package also needs to be included when -compiling LaTeX snippets into images for inclusion into HTML." +Therefore you should not modify this variable unless you know +what you are doing. The one reason to change it anyway is that +you might be loading some other package that conflicts with one +of the default packages. Each cell is of the format +\( \"options\" \"package\" snippet-flag). If SNIPPET-FLAG is t, +the package also needs to be included when compiling LaTeX +snippets into images for inclusion into non-LaTeX output." + :group 'org-latex :group 'org-export-latex :set 'org-set-packages-alist :get 'org-get-packages-alist @@ -3529,17 +3852,25 @@ compiling LaTeX snippets into images for inclusion into HTML." (boolean :tag "Snippet")) (string :tag "A line of LaTeX")))) -(defcustom org-export-latex-packages-alist nil +(defcustom org-latex-packages-alist nil "Alist of packages to be inserted in every LaTeX header. -These will be inserted after `org-export-latex-default-packages-alist'. -Each cell is of the format \( \"options\" \"package\" snippet-flag \). -SNIPPET-FLAG, when t, indicates that this package is also needed when -turning LaTeX snippets into images for inclusion into HTML. + +These will be inserted after `org-latex-default-packages-alist'. +Each cell is of the format: + + \(\"options\" \"package\" snippet-flag) + +SNIPPET-FLAG, when t, indicates that this package is also needed +when turning LaTeX snippets into images for inclusion into +non-LaTeX output. + Make sure that you only list packages here which: -- you want in every file -- do not conflict with the default packages in - `org-export-latex-default-packages-alist' -- do not conflict with the setup in `org-format-latex-header'." + + - you want in every file + - do not conflict with the setup in `org-format-latex-header'. + - do not conflict with the default packages in + `org-latex-default-packages-alist'." + :group 'org-latex :group 'org-export-latex :set 'org-set-packages-alist :get 'org-get-packages-alist @@ -3551,7 +3882,6 @@ Make sure that you only list packages here which: (boolean :tag "Snippet")) (string :tag "A line of LaTeX")))) - (defgroup org-appearance nil "Settings for Org-mode appearance." :tag "Org Appearance" @@ -3622,10 +3952,22 @@ org-level-* faces." :group 'org-appearance :type 'boolean) -(defcustom org-highlight-latex-fragments-and-specials nil - "Non-nil means fontify what is treated specially by the exporters." +(defcustom org-highlight-latex-and-related nil + "Non-nil means highlight LaTeX related syntax in the buffer. +When non nil, the value should be a list containing any of the +following symbols: + `latex' Highlight LaTeX snippets and environments. + `script' Highlight subscript and superscript. + `entities' Highlight entities." :group 'org-appearance - :type 'boolean) + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "No highlighting" nil) + (set :greedy t :tag "Highlight" + (const :tag "LaTeX snippets and environments" latex) + (const :tag "Subscript and superscript" script) + (const :tag "Entities" entities)))) (defcustom org-hide-emphasis-markers nil "Non-nil mean font-lock should hide the emphasis marker characters." @@ -3674,7 +4016,7 @@ After a match, the match groups contain these elements: (body1 (concat body "*?")) (markers (mapconcat 'car org-emphasis-alist "")) (vmarkers (mapconcat - (lambda (x) (if (eq (nth 4 x) 'verbatim) (car x) "")) + (lambda (x) (if (eq (nth 2 x) 'verbatim) (car x) "")) org-emphasis-alist ""))) ;; make sure special characters appear at the right position in the class (if (string-match "\\^" markers) @@ -3714,7 +4056,10 @@ After a match, the match groups contain these elements: "\\3\\)" "\\([" post "]\\|$\\)"))))) -(defcustom org-emphasis-regexp-components +;; This used to be a defcustom (Org <8.0) but allowing the users to +;; set this option proved cumbersome. See this message/thread: +;; http://article.gmane.org/gmane.emacs.orgmode/68681 +(defvar org-emphasis-regexp-components '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1) "Components used to build the regular expression for emphasis. This is a list with five entries. Terminology: In an emphasis string @@ -3730,48 +4075,36 @@ body-regexp A regexp like \".\" to match a body character. Don't use non-shy groups here, and don't allow newline here. newline The maximum number of newlines allowed in an emphasis exp. -Use customize to modify this, or restart Emacs after changing it." - :group 'org-appearance - :set 'org-set-emph-re - :type '(list - (sexp :tag "Allowed chars in pre ") - (sexp :tag "Allowed chars in post ") - (sexp :tag "Forbidden chars in border ") - (sexp :tag "Regexp for body ") - (integer :tag "number of newlines allowed") - (option (boolean :tag "Please ignore this button")))) +You need to reload Org or to restart Emacs after customizing this.") (defcustom org-emphasis-alist - `(("*" bold "" "") - ("/" italic "" "") - ("_" underline "" "") - ("=" org-code "" "" verbatim) - ("~" org-verbatim "" "" verbatim) - ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t)) - "" "") - ) - "Special syntax for emphasized text. -Text starting and ending with a special character will be emphasized, for -example *bold*, _underlined_ and /italic/. This variable sets the marker -characters, the face to be used by font-lock for highlighting in Org-mode -Emacs buffers, and the HTML tags to be used for this. -For LaTeX export, see the variable `org-export-latex-emphasis-alist'. -For DocBook export, see the variable `org-export-docbook-emphasis-alist'. -Use customize to modify this, or restart Emacs after changing it." + `(("*" bold) + ("/" italic) + ("_" underline) + ("=" org-code verbatim) + ("~" org-verbatim verbatim) + ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t)))) + "Alist of characters and faces to emphasize text. +Text starting and ending with a special character will be emphasized, +for example *bold*, _underlined_ and /italic/. This variable sets the +marker characters and the face to be used by font-lock for highlighting +in Org-mode Emacs buffers. + +You need to reload Org or to restart Emacs after customizing this." :group 'org-appearance :set 'org-set-emph-re + :version "24.4" + :package-version '(Org . "8.0") :type '(repeat (list (string :tag "Marker character") (choice (face :tag "Font-lock-face") (plist :tag "Face property list")) - (string :tag "HTML start tag") - (string :tag "HTML end tag") (option (const verbatim))))) (defvar org-protecting-blocks - '("src" "example" "latex" "ascii" "html" "docbook" "ditaa" "dot" "r" "R") + '("src" "example" "latex" "ascii" "html" "ditaa" "dot" "r" "R") "Blocks that contain text that is quoted, i.e. not processed as Org syntax. This is needed for font-lock setup.") @@ -3838,7 +4171,7 @@ Normal means, no org-mode-specific context." (declare-function org-agenda-skip "org-agenda" ()) (declare-function org-agenda-format-item "org-agenda" - (extra txt &optional category tags dotime noprefix remove-re habitp)) + (extra txt &optional level category tags dotime noprefix remove-re habitp)) (declare-function org-agenda-new-marker "org-agenda" (&optional pos)) (declare-function org-agenda-change-all-lines "org-agenda" (newhead hdmarker &optional fixface just-this)) @@ -3856,16 +4189,12 @@ Normal means, no org-mode-specific context." (declare-function org-indent-mode "org-indent" (&optional arg)) (declare-function parse-time-string "parse-time" (string)) (declare-function org-attach-reveal "org-attach" (&optional if-exists)) -(declare-function org-export-latex-fix-inputenc "org-latex" ()) (declare-function orgtbl-send-table "org-table" (&optional maybe)) (defvar remember-data-file) (defvar texmathp-why) (declare-function speedbar-line-directory "speedbar" (&optional depth)) (declare-function table--at-cell-p "table" (position &optional object at-column)) -(defvar w3m-current-url) -(defvar w3m-current-title) - (defvar org-latex-regexps) ;;; Autoload and prepare some org modules @@ -3893,6 +4222,9 @@ This works for both table types.") (org-autoload "org-table" '(org-table-begin org-table-blank-field org-table-end))) +(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: " + "Detect a #+TBLFM line.") + ;;;###autoload (defun turn-on-orgtbl () "Unconditionally turn on `orgtbl-mode'." @@ -3971,11 +4303,11 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (re-search-forward org-table-any-border-regexp nil 1)))) (unless quietly (message "Mapping tables: done"))) -;; Declare and autoload functions from org-exp.el & Co +;; Declare and autoload functions from ox.el and al. -(declare-function org-default-export-plist "org-exp") -(declare-function org-infile-export-plist "org-exp") -(declare-function org-get-current-options "org-exp") +(declare-function org-export-get-environment "ox" + (&optional backend subtreep ext-plist)) +(declare-function org-latex-guess-inputenc "ox-latex" (header)) ;; Declare and autoload functions from org-agenda.el @@ -3987,6 +4319,15 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (declare-function org-clock-update-mode-line "org-clock" ()) (declare-function org-resolve-clocks "org-clock" (&optional also-non-dangling-p prompt last-valid)) + +(defun org-at-TBLFM-p (&optional pos) + "Return t when point (or POS) is in #+TBLFM line." + (save-excursion + (let ((pos pos))) + (goto-char (or pos (point))) + (beginning-of-line 1) + (looking-at org-TBLFM-regexp))) + (defvar org-clock-start-time) (defvar org-clock-marker (make-marker) "Marker recording the last clock-in.") @@ -4155,7 +4496,8 @@ Otherwise, these types are allowed: (const :tag "Only active timestamps" active) (const :tag "Only inactive timestamps" inactive) (const :tag "Only scheduled timestamps" scheduled) - (const :tag "Only deadline timestamps" deadline)) + (const :tag "Only deadline timestamps" deadline) + (const :tag "Only closed timestamps" closed)) :version "24.3" :group 'org-sparse-trees) @@ -4274,6 +4616,9 @@ Also put tags into group 4 if tags are present.") (defvar org-deadline-time-regexp nil "Matches the DEADLINE keyword together with a time stamp.") (make-variable-buffer-local 'org-deadline-time-regexp) +(defvar org-deadline-time-hour-regexp nil + "Matches the DEADLINE keyword together with a time-and-hour stamp.") +(make-variable-buffer-local 'org-deadline-time-hour-regexp) (defvar org-deadline-line-regexp nil "Matches the DEADLINE keyword and the rest of the line.") (make-variable-buffer-local 'org-deadline-line-regexp) @@ -4283,6 +4628,9 @@ Also put tags into group 4 if tags are present.") (defvar org-scheduled-time-regexp nil "Matches the SCHEDULED keyword together with a time stamp.") (make-variable-buffer-local 'org-scheduled-time-regexp) +(defvar org-scheduled-time-hour-regexp nil + "Matches the SCHEDULED keyword together with a time-and-hour stamp.") +(make-variable-buffer-local 'org-scheduled-time-hour-regexp) (defvar org-closed-time-regexp nil "Matches the CLOSED keyword together with a time stamp.") (make-variable-buffer-local 'org-closed-time-regexp) @@ -4357,6 +4705,8 @@ After a match, the following groups carry important information: ("noalign" org-startup-align-all-tables nil) ("inlineimages" org-startup-with-inline-images t) ("noinlineimages" org-startup-with-inline-images nil) + ("latexpreview" org-startup-with-latex-preview t) + ("nolatexpreview" org-startup-with-latex-preview nil) ("customtime" org-display-custom-times t) ("logdone" org-log-done time) ("lognotedone" org-log-done note) @@ -4365,6 +4715,10 @@ After a match, the following groups carry important information: ("nolognoteclock-out" org-log-note-clock-out nil) ("logrepeat" org-log-repeat state) ("lognoterepeat" org-log-repeat note) + ("logdrawer" org-log-into-drawer t) + ("nologdrawer" org-log-into-drawer nil) + ("logstatesreversed" org-log-states-order-reversed t) + ("nologstatesreversed" org-log-states-order-reversed nil) ("nologrepeat" org-log-repeat nil) ("logreschedule" org-log-reschedule time) ("lognotereschedule" org-log-reschedule note) @@ -4413,19 +4767,107 @@ means to push this value onto the list in the variable.") "Regular expression for hiding blocks.") (defconst org-heading-keyword-regexp-format "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Printf format for a regexp matching an headline with some keyword. + "Printf format for a regexp matching a headline with some keyword. This regexp will match the headline of any node which has the exact keyword that is put into the format. The keyword isn't in any group by default, but the stars and the body are.") (defconst org-heading-keyword-maybe-regexp-format "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Printf format for a regexp matching an headline, possibly with some keyword. + "Printf format for a regexp matching a headline, possibly with some keyword. This regexp can match any headline with the specified keyword, or without a keyword. The keyword isn't in any group by default, but the stars and the body are.") +(defcustom org-group-tags t + "When non-nil (the default), use group tags. +This can be turned on/off through `org-toggle-tags-groups'." + :group 'org-tags + :group 'org-startup + :type 'boolean) + +(defun org-toggle-tags-groups () + "Toggle support for group tags. +Support for group tags is controlled by the option +`org-group-tags', which is non-nil by default." + (interactive) + (setq org-group-tags (not org-group-tags)) + (cond ((and (derived-mode-p 'org-agenda-mode) + org-group-tags) + (org-agenda-redo)) + ((derived-mode-p 'org-mode) + (let ((org-inhibit-startup t)) (org-mode)))) + (message "Groups tags support has been turned %s" + (if org-group-tags "on" "off"))) + +(defun org-set-regexps-and-options-for-tags () + "Precompute regular expressions used for tags in the current buffer." + (when (derived-mode-p 'org-mode) + (org-set-local 'org-file-tags nil) + (let ((re (org-make-options-regexp '("FILETAGS" "TAGS"))) + (splitre "[ \t]+") + (start 0) + tags ftags key value) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (setq key (upcase (org-match-string-no-properties 1)) + value (org-match-string-no-properties 2)) + (if (stringp value) (setq value (org-trim value))) + (cond + ((equal key "TAGS") + (setq tags (append tags (if tags '("\\n") nil) + (org-split-string value splitre)))) + ((equal key "FILETAGS") + (when (string-match "\\S-" value) + (setq ftags + (append + ftags + (apply 'append + (mapcar (lambda (x) (org-split-string x ":")) + (org-split-string value))))))))))) + ;; Process the file tags. + (and ftags (org-set-local 'org-file-tags + (mapcar 'org-add-prop-inherited ftags))) + (org-set-local 'org-tag-groups-alist nil) + ;; Process the tags. + ;; 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) + (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)))))))) + (defun org-set-regexps-and-options () - "Precompute regular expressions for current buffer." + "Precompute regular expressions used in the current buffer." (when (derived-mode-p 'org-mode) (org-set-local 'org-todo-kwd-alist nil) (org-set-local 'org-todo-key-alist nil) @@ -4436,23 +4878,32 @@ but the stars and the body are.") (org-set-local 'org-todo-sets nil) (org-set-local 'org-todo-log-states nil) (org-set-local 'org-file-properties nil) - (org-set-local 'org-file-tags nil) (let ((re (org-make-options-regexp - '("CATEGORY" "TODO" "COLUMNS" - "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" - "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE" "LATEX_CLASS" - "OPTIONS") + '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" + "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS" + "SETUPFILE" "OPTIONS") "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)")) (splitre "[ \t]+") (scripts org-use-sub-superscripts) - kwds kws0 kwsa key log value cat arch tags const links hw dws - tail sep kws1 prio props ftags drawers beamer-p - ext-setup-or-nil setup-contents (start 0)) + kwds kws0 kwsa key log value cat arch const links hw dws + tail sep kws1 prio props drawers ext-setup-or-nil setup-contents + (start 0)) (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (or (and ext-setup-or-nil + (let (ret) + (with-temp-buffer + (insert ext-setup-or-nil) + (let ((major-mode 'org-mode)) + (org-set-regexps-and-options-for-tags) + (setq ret (list org-file-tags org-tag-alist + org-tag-groups-alist)))) + (setq org-file-tags (nth 0 ret) + org-tag-alist (nth 1 ret) + org-tag-groups-alist (nth 2 ret)))) + (and ext-setup-or-nil (string-match re ext-setup-or-nil start) (setq start (match-end 0))) (and (setq ext-setup-or-nil nil start 0) @@ -4471,9 +4922,6 @@ but the stars and the body are.") ;; general TODO-like setup (push (cons (intern (downcase (match-string 1 key))) (org-split-string value splitre)) kwds)) - ((equal key "TAGS") - (setq tags (append tags (if tags '("\\n") nil) - (org-split-string value splitre)))) ((equal key "COLUMNS") (org-set-local 'org-columns-default-format value)) ((equal key "LINK") @@ -4488,18 +4936,10 @@ but the stars and the body are.") (setq props (org-update-property-plist (match-string 1 value) (match-string 2 value) props)))) - ((equal key "FILETAGS") - (when (string-match "\\S-" value) - (setq ftags - (append - ftags - (apply 'append - (mapcar (lambda (x) (org-split-string x ":")) - (org-split-string value))))))) ((equal key "DRAWERS") (setq drawers (delete-dups (append org-drawers (org-split-string value splitre))))) ((equal key "CONSTANTS") - (setq const (append const (org-split-string value splitre)))) + (org-table-set-constants)) ((equal key "STARTUP") (let ((opts (org-split-string value splitre)) l var val) @@ -4516,12 +4956,12 @@ but the stars and the body are.") (setq arch value) (remove-text-properties 0 (length arch) '(face t fontified t) arch)) - ((equal key "LATEX_CLASS") - (setq beamer-p (equal value "beamer"))) ((equal key "OPTIONS") (if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value) (setq scripts (read (match-string 2 value))))) - ((equal key "SETUPFILE") + ((and (equal key "SETUPFILE") + ;; Prevent checking in Gnus messages + (not buffer-read-only)) (setq setup-contents (org-file-contents (expand-file-name (org-remove-double-quotes value)) @@ -4553,8 +4993,6 @@ but the stars and the body are.") (org-set-local 'org-lowest-priority (nth 1 prio)) (org-set-local 'org-default-priority (nth 2 prio))) (and props (org-set-local 'org-file-properties (nreverse props))) - (and ftags (org-set-local 'org-file-tags - (mapcar 'org-add-prop-inherited ftags))) (and drawers (org-set-local 'org-drawers drawers)) (and arch (org-set-local 'org-archive-location arch)) (and links (setq org-link-abbrev-alist-local (nreverse links))) @@ -4605,33 +5043,6 @@ but the stars and the body are.") org-todo-kwd-alist (nreverse org-todo-kwd-alist) org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist)) org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))) - ;; Process the constants - (when const - (let (e cst) - (while (setq e (pop const)) - (if (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) - (push (cons (match-string 1 e) (match-string 2 e)) cst))) - (setq org-table-formula-constants-local cst))) - - ;; Process the tags. - (when tags - (let (e tgs) - (while (setq e (pop tags)) - (cond - ((equal e "{") (push '(:startgroup) tgs)) - ((equal e "}") (push '(:endgroup) tgs)) - ((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)) - (t (push (list e) tgs)))) - (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))))) - ;; Compute the regular expressions and other local variables. ;; Using `org-outline-regexp-bol' would complicate them much, ;; because of the fixed white space at the end of that string. @@ -4688,12 +5099,18 @@ but the stars and the body are.") org-deadline-regexp (concat "\\<" org-deadline-string) org-deadline-time-regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") + org-deadline-time-hour-regexp + (concat "\\<" org-deadline-string + " *<\\(.+[0-9]\\{1,2\\}:[0-9]\\{2\\}[^>]*\\)>") org-deadline-line-regexp (concat "\\<\\(" org-deadline-string "\\).*") org-scheduled-regexp (concat "\\<" org-scheduled-string) org-scheduled-time-regexp (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") + org-scheduled-time-hour-regexp + (concat "\\<" org-scheduled-string + " *<\\(.+[0-9]\\{1,2\\}:[0-9]\\{2\\}[^>]*\\)>") org-closed-time-regexp (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") org-keyword-time-regexp @@ -4717,9 +5134,8 @@ but the stars and the body are.") org-all-time-keywords (mapcar (lambda (w) (substring w 0 -1)) (list org-scheduled-string org-deadline-string - org-clock-string org-closed-string)) - ) - (org-compute-latex-and-specials-regexp) + org-clock-string org-closed-string))) + (org-compute-latex-and-related-regexp) (org-set-font-lock-defaults)))) (defun org-file-contents (file &optional noerror) @@ -4727,10 +5143,7 @@ but the stars and the body are.") (if (or (not file) (not (file-readable-p file))) (if noerror - (progn - (message "Cannot read file \"%s\"" file) - (ding) (sit-for 2) - "") + (message "Cannot read file \"%s\"" file) (error "Cannot read file \"%s\"" file)) (with-temp-buffer (insert-file-contents file) @@ -4763,7 +5176,7 @@ This will extract info from a string like \"WAIT(w@/!)\"." Respect keys that are already there." (let (new e (alt ?0)) (while (setq e (pop alist)) - (if (or (memq (car e) '(:newline :endgroup :startgroup)) + (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup)) (cdr e)) ;; Key already assigned. (push e new) (let ((clist (string-to-list (downcase (car e)))) @@ -4834,7 +5247,7 @@ This variable is set by `org-before-change-function'. (require 'easymenu) (require 'overlay) -(require 'org-macs) +;; (require 'org-macs) moved higher up in the file before it is first used (require 'org-entities) ;; (require 'org-compat) moved higher up in the file before it is first used (require 'org-faces) @@ -4842,15 +5255,10 @@ This variable is set by `org-before-change-function'. (require 'org-pcomplete) (require 'org-src) (require 'org-footnote) +(require 'org-macro) ;; babel (require 'ob) -(require 'ob-table) -(require 'ob-lob) -(require 'ob-ref) -(require 'ob-tangle) -(require 'ob-comint) -(require 'ob-keys) ;;;###autoload (define-derived-mode org-mode outline-mode "Org" @@ -4912,13 +5320,16 @@ The following commands are available: org-ellipsis))) (if (stringp org-ellipsis) org-ellipsis "...")))) (setq buffer-display-table org-display-table)) + (org-set-regexps-and-options-for-tags) (org-set-regexps-and-options) (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)) ;; Calc embedded (org-set-local 'calc-embedded-open-mode "# ") + ;; Modify a few syntax entries (modify-syntax-entry ?@ "w") + (modify-syntax-entry ?\" "\"") (if org-startup-truncated (setq truncate-lines t)) (when org-startup-indented (require 'org-indent) (org-indent-mode 1)) (org-set-local 'font-lock-unfontify-region-function @@ -4929,18 +5340,20 @@ The following commands are available: 'local) ;; Check for running clock before killing a buffer (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) + ;; Initialize macros templates. + (org-macro-initialize-templates) + ;; Initialize radio targets. + (org-update-radio-target-regexp) ;; Indentation. (org-set-local 'indent-line-function 'org-indent-line) (org-set-local 'indent-region-function 'org-indent-region) - ;; Initialize radio targets. - (org-update-radio-target-regexp) ;; Filling and auto-filling. (org-setup-filling) ;; Comments. (org-setup-comments-handling) ;; Beginning/end of defun - (org-set-local 'beginning-of-defun-function 'org-back-to-heading) - (org-set-local 'end-of-defun-function (lambda () (interactive) (org-end-of-subtree nil t))) + (org-set-local 'beginning-of-defun-function 'org-backward-element) + (org-set-local 'end-of-defun-function 'org-forward-element) ;; Next error for sparse trees (org-set-local 'next-error-function 'org-occur-next-match) ;; Make sure dependence stuff works reliably, even for users who set it @@ -4996,18 +5409,32 @@ The following commands are available: (= (point-min) (point-max))) (insert "# -*- mode: org -*-\n\n")) (unless org-inhibit-startup - (and org-startup-with-beamer-mode (org-beamer-mode)) - (when org-startup-align-all-tables - (let ((bmp (buffer-modified-p))) - (org-table-map-tables 'org-table-align 'quietly) - (set-buffer-modified-p bmp))) - (when org-startup-with-inline-images - (org-display-inline-images)) - (unless org-inhibit-startup-visibility-stuff - (org-set-startup-visibility))) + (org-unmodified + (and org-startup-with-beamer-mode (org-beamer-mode)) + (when org-startup-align-all-tables + (org-table-map-tables 'org-table-align 'quietly)) + (when org-startup-with-inline-images + (org-display-inline-images)) + (when org-startup-with-latex-preview + (org-preview-latex-fragment)) + (unless org-inhibit-startup-visibility-stuff + (org-set-startup-visibility)))) ;; Try to set org-hide correctly (set-face-foreground 'org-hide (org-find-invisible-foreground))) +;; Update `customize-package-emacs-version-alist' +(add-to-list 'customize-package-emacs-version-alist + '(Org ("6.21b" . "23.1") ("6.33x" . "23.2") + ("7.8.11" . "24.1") ("7.9.4" . "24.3") + ("8.0" . "24.4"))) + +(defvar org-mode-transpose-word-syntax-table + (let ((st (make-syntax-table))) + (mapc (lambda(c) (modify-syntax-entry + (string-to-char (car c)) "w p" st)) + org-emphasis-alist) + st)) + (when (fboundp 'abbrev-table-put) (abbrev-table-put org-mode-abbrev-table :parents (list text-mode-abbrev-table))) @@ -5031,15 +5458,23 @@ The following commands are available: (list (face-foreground 'org-hide)))))) (car (remove nil candidates)))) -(defun org-current-time () - "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." - (if (> (car org-time-stamp-rounding-minutes) 1) - (let ((r (car org-time-stamp-rounding-minutes)) - (time (decode-time))) - (apply 'encode-time - (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) - (nthcdr 2 time)))) - (current-time))) +(defun org-current-time (&optional rounding-minutes past) + "Current time, possibly rounded to ROUNDING-MINUTES. +When ROUNDING-MINUTES is not an integer, fall back on the car of +`org-time-stamp-rounding-minutes'. When PAST is non-nil, ensure +the rounding returns a past time." + (let ((r (or (and (integerp rounding-minutes) rounding-minutes) + (car org-time-stamp-rounding-minutes))) + (time (decode-time)) res) + (if (< r 1) + (current-time) + (setq res + (apply 'encode-time + (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) + (nthcdr 2 time)))) + (if (and past (< (org-float-time (time-subtract (current-time) res)) 0)) + (seconds-to-time (- (org-float-time res) (* r 60))) + res)))) (defun org-today () "Return today date, considering `org-extend-today-until'." @@ -5090,11 +5525,8 @@ Here is what the match groups contain after a match: (defvar org-any-link-re nil "Regular expression matching any link.") -(defcustom org-match-sexp-depth 3 - "Number of stacked braces for sub/superscript matching. -This has to be set before loading org.el to be effective." - :group 'org-export-translation ; ??????????????????????????/ - :type 'integer) +(defconst org-match-sexp-depth 3 + "Number of stacked braces for sub/superscript matching.") (defun org-create-multibrace-regexp (left right n) "Create a regular expression which will match a balanced sexp. @@ -5116,7 +5548,7 @@ stacked delimiters is N. Escaping delimiters is not possible." (defvar org-match-substring-regexp (concat - "\\([^\\]\\|^\\)\\([_^]\\)\\(" + "\\(\\S-\\)\\([_^]\\)\\(" "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" "\\|" "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" @@ -5126,7 +5558,7 @@ stacked delimiters is N. Escaping delimiters is not possible." (defvar org-match-substring-with-braces-regexp (concat - "\\([^\\]\\|^\\)\\([_^]\\)\\(" + "\\(\\S-\\)\\([_^]\\)\\(" "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" "\\)") "The regular expression matching a sub- or superscript, forcing braces.") @@ -5251,36 +5683,27 @@ The time stamps may be either active or inactive.") If there is an active region, change that region to a new emphasis. If there is no region, just insert the marker characters and position the cursor between them. -CHAR should be either the marker character, or the first character of the -HTML tag associated with that emphasis. If CHAR is a space, the means -to remove the emphasis of the selected region. -If char is not given (for example in an interactive call) it -will be prompted for." +CHAR should be the marker character. If it is a space, it means to +remove the emphasis of the selected region. +If CHAR is not given (for example in an interactive call) it will be +prompted for." (interactive) - (let ((eal org-emphasis-alist) e det - (erc org-emphasis-regexp-components) + (let ((erc org-emphasis-regexp-components) (prompt "") - (string "") beg end move tag c s) + (string "") beg end move c s) (if (org-region-active-p) (setq beg (region-beginning) end (region-end) string (buffer-substring beg end)) (setq move t)) - (while (setq e (pop eal)) - (setq tag (car (org-split-string (nth 2 e) "[ <>/]+")) - c (aref tag 0)) - (push (cons c (string-to-char (car e))) det) - (setq prompt (concat prompt (format " [%s%c]%s" (car e) c - (substring tag 1))))) - (setq det (nreverse det)) (unless char - (message "%s" (concat "Emphasis marker or tag:" prompt)) + (message "Emphasis marker or tag: [%s]" + (mapconcat (lambda(e) (car e)) org-emphasis-alist "")) (setq char (read-char-exclusive))) - (setq char (or (cdr (assoc char det)) char)) (if (equal char ?\ ) (setq s "" move nil) (unless (assoc (char-to-string char) org-emphasis-alist) - (error "No such emphasis marker: \"%c\"" char)) + (user-error "No such emphasis marker: \"%c\"" char)) (setq s (char-to-string char))) (while (and (> (length string) 1) (equal (substring string 0 1) (substring string -1)) @@ -5307,17 +5730,19 @@ will be prompted for." (defun org-activate-plain-links (limit) "Run through the buffer and add overlays to links." - (let (f) + (let (f hl) (when (and (re-search-forward (concat org-plain-link-re) limit t) (not (org-in-src-block-p))) (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (setq f (get-text-property (match-beginning 0) 'face)) - (unless (or (org-in-src-block-p) - (eq f 'org-tag) - (and (listp f) (memq 'org-tag f))) + (setq hl (org-match-string-no-properties 0)) + (if (or (eq f 'org-tag) + (and (listp f) (memq 'org-tag f))) + nil (add-text-properties (match-beginning 0) (match-end 0) (list 'mouse-face 'highlight 'face 'org-link + 'htmlize-link `(:uri ,hl) 'keymap org-mouse-map)) (org-rear-nonsticky-at (match-end 0))) t))) @@ -5351,7 +5776,7 @@ by a #." (error (message "org-mode fontification error")))) (defun org-fontify-meta-lines-and-blocks-1 (limit) - "Fontify #+ lines and blocks, in the correct ways." + "Fontify #+ lines and blocks." (let ((case-fold-search t)) (if (re-search-forward "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" @@ -5365,7 +5790,7 @@ by a #." (dc3 (downcase (match-string 3))) end end1 quoting block-type ovl) (cond - ((member dc1 '("+html:" "+ascii:" "+latex:" "+docbook:")) + ((member dc1 '("+html:" "+ascii:" "+latex:")) ;; a single line of backend-specific content (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (remove-text-properties (match-beginning 0) (match-end 0) @@ -5484,17 +5909,16 @@ by a #." "Run through the buffer and add overlays to bracketed links." (if (and (re-search-forward org-bracket-link-regexp limit t) (not (org-in-src-block-p))) - (let* ((help (concat "LINK: " - (org-match-string-no-properties 1))) - ;; FIXME: above we should remove the escapes. - ;; but that requires another match, protecting match data, - ;; a lot of overhead for font-lock. + (let* ((hl (org-match-string-no-properties 1)) + (help (concat "LINK: " (save-match-data (org-link-unescape hl)))) (ip (org-maybe-intangible (list 'invisible 'org-link 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help))) + 'font-lock-multiline t 'help-echo help + 'htmlize-link `(:uri ,hl)))) (vp (list 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help))) + 'font-lock-multiline t 'help-echo help + 'htmlize-link `(:uri ,hl)))) ;; We need to remove the invisible property here. Table narrowing ;; may have made some of this invisible. (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) @@ -5575,97 +5999,55 @@ by a #." (goto-char e) t))) -(defvar org-latex-and-specials-regexp nil - "Regular expression for highlighting export special stuff.") +(defvar org-latex-and-related-regexp nil + "Regular expression for highlighting LaTeX, entities and sub/superscript.") (defvar org-match-substring-regexp) (defvar org-match-substring-with-braces-regexp) -;; This should be with the exporter code, but we also use if for font-locking -(defconst org-export-html-special-string-regexps - '(("\\\\-" . "­") - ("---\\([^-]\\)" . "—\\1") - ("--\\([^-]\\)" . "–\\1") - ("\\.\\.\\." . "…")) - "Regular expressions for special string conversion.") +(defun org-compute-latex-and-related-regexp () + "Compute regular expression for LaTeX, entities and sub/superscript. +Result depends on variable `org-highlight-latex-and-related'." + (org-set-local + 'org-latex-and-related-regexp + (let* ((re-sub + (cond ((not (memq 'script org-highlight-latex-and-related)) nil) + ((eq org-use-sub-superscripts '{}) + (list org-match-substring-with-braces-regexp)) + (org-use-sub-superscripts (list org-match-substring-regexp)))) + (re-latex + (when (memq 'latex org-highlight-latex-and-related) + (let ((matchers (plist-get org-format-latex-options :matchers))) + (delq nil + (mapcar (lambda (x) + (and (member (car x) matchers) (nth 1 x))) + org-latex-regexps))))) + (re-entities + (when (memq 'entities org-highlight-latex-and-related) + (list "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")))) + (mapconcat 'identity (append re-latex re-entities re-sub) "\\|")))) - -(defun org-compute-latex-and-specials-regexp () - "Compute regular expression for stuff treated specially by exporters." - (if (not org-highlight-latex-fragments-and-specials) - (org-set-local 'org-latex-and-specials-regexp nil) - (require 'org-exp) - (let* - ((matchers (plist-get org-format-latex-options :matchers)) - (latexs (delq nil (mapcar (lambda (x) (if (member (car x) matchers) x)) - org-latex-regexps))) - (org-export-allow-BIND nil) - (options (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (org-export-with-sub-superscripts (plist-get options :sub-superscript)) - (org-export-with-LaTeX-fragments (plist-get options :LaTeX-fragments)) - (org-export-with-TeX-macros (plist-get options :TeX-macros)) - (org-export-html-expand (plist-get options :expand-quoted-html)) - (org-export-with-special-strings (plist-get options :special-strings)) - (re-sub - (cond - ((equal org-export-with-sub-superscripts '{}) - (list org-match-substring-with-braces-regexp)) - (org-export-with-sub-superscripts - (list org-match-substring-regexp)))) - (re-latex - (if org-export-with-LaTeX-fragments - (mapcar (lambda (x) (nth 1 x)) latexs))) - (re-macros - (if org-export-with-TeX-macros - (list (concat "\\\\" - (regexp-opt - (append - - (delq nil - (mapcar 'car-safe - (append org-entities-user - org-entities))) - (if (boundp 'org-latex-entities) - (mapcar (lambda (x) - (or (car-safe x) x)) - org-latex-entities) - nil)) - 'words))) ; FIXME - )) - ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) - (re-special (if org-export-with-special-strings - (mapcar (lambda (x) (car x)) - org-export-html-special-string-regexps))) - (re-rest - (delq nil - (list - (if org-export-html-expand "@<[^>\n]+>") - )))) - (org-set-local - 'org-latex-and-specials-regexp - (mapconcat 'identity (append re-latex re-sub re-macros re-special - re-rest) "\\|"))))) - -(defun org-do-latex-and-special-faces (limit) - "Run through the buffer and add overlays to links." - (when org-latex-and-specials-regexp - (let (rtn d) - (while (and (not rtn) (re-search-forward org-latex-and-specials-regexp - limit t)) - (if (not (memq (car-safe (get-text-property (1+ (match-beginning 0)) - 'face)) - '(org-code org-verbatim underline))) - (progn - (setq rtn t - d (cond ((member (char-after (1+ (match-beginning 0))) - '(?_ ?^)) 1) - (t 0))) - (font-lock-prepend-text-property - (+ d (match-beginning 0)) (match-end 0) - 'face 'org-latex-and-export-specials) - (add-text-properties (+ d (match-beginning 0)) (match-end 0) - '(font-lock-multiline t))))) - rtn))) +(defun org-do-latex-and-related (limit) + "Highlight LaTeX snippets and environments, entities and sub/superscript. +LIMIT bounds the search for syntax to highlight. Stop at first +highlighted object, if any. Return t if some highlighting was +done, nil otherwise." + (when (org-string-nw-p org-latex-and-related-regexp) + (catch 'found + (while (re-search-forward org-latex-and-related-regexp limit t) + (unless (memq (car-safe (get-text-property (1+ (match-beginning 0)) + 'face)) + '(org-code org-verbatim underline)) + (let ((offset (if (memq (char-after (1+ (match-beginning 0))) + '(?_ ?^)) + 1 + 0))) + (font-lock-prepend-text-property + (+ offset (match-beginning 0)) (match-end 0) + 'face 'org-latex-and-related) + (add-text-properties (+ offset (match-beginning 0)) (match-end 0) + '(font-lock-multiline t))) + (throw 'found t))) + nil))) (defun org-restart-font-lock () "Restart `font-lock-mode', to force refontification." @@ -5675,13 +6057,17 @@ by a #." (defun org-all-targets (&optional radio) "Return a list of all targets in this file. -With optional argument RADIO, only find radio targets." - (let ((re (if radio org-radio-target-regexp org-target-regexp)) - rtn) +When optional argument RADIO is non-nil, only find radio +targets." + (let ((re (if radio org-radio-target-regexp org-target-regexp)) rtn) (save-excursion (goto-char (point-min)) (while (re-search-forward re nil t) - (add-to-list 'rtn (downcase (org-match-string-no-properties 1)))) + ;; Make sure point is really within the object. + (backward-char) + (let ((obj (org-element-context))) + (when (memq (org-element-type obj) '(radio-target target)) + (add-to-list 'rtn (downcase (org-element-property :value obj)))))) rtn))) (defun org-make-target-link-regexp (targets) @@ -5713,13 +6099,15 @@ between words." (defun org-outline-level () "Compute the outline level of the heading at point. -This function assumes that the cursor is at the beginning of a line matched -by `outline-regexp'. Otherwise it returns garbage. If this is called at a normal headline, the level is the number of stars. Use `org-reduced-level' to remove the effect of `org-odd-levels'." (save-excursion - (looking-at org-outline-regexp) - (1- (- (match-end 0) (match-beginning 0))))) + (if (not (condition-case nil + (org-back-to-heading t) + (error nil))) + 0 + (looking-at org-outline-regexp) + (1- (- (match-end 0) (match-beginning 0)))))) (defvar org-font-lock-keywords nil) @@ -5772,12 +6160,17 @@ needs to be inserted at a specific position in the font-lock sequence.") ;; Links (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) - (if (memq 'plain lk) '(org-activate-plain-links)) + (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) (if (memq 'footnote lk) '(org-activate-footnote-links)) + ;; Targets. + (list org-any-target-regexp '(0 'org-target t)) + ;; Diary sexps. '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) + ;; Macro + '("{{{.+}}}" (0 'org-macro t)) '(org-hide-wide-columns (0 nil append)) ;; TODO keyword (list (format org-heading-keyword-regexp-format @@ -5796,6 +6189,12 @@ needs to be inserted at a specific position in the font-lock sequence.") '(org-font-lock-add-priority-faces) ;; Tags '(org-font-lock-add-tag-faces) + ;; Tags groups + (if (and org-group-tags org-tag-groups-alist) + (list (concat org-outline-regexp-bol ".+\\(:" + (regexp-opt (mapcar 'car org-tag-groups-alist)) + ":\\).*$") + '(1 'org-tag-group prepend))) ;; Special keywords (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) @@ -5821,7 +6220,7 @@ needs to be inserted at a specific position in the font-lock sequence.") "\\(.*:" org-archive-tag ":.*\\)") '(1 'org-archived prepend)) ;; Specials - '(org-do-latex-and-special-faces) + '(org-do-latex-and-related) '(org-fontify-entities) '(org-raise-scripts) ;; Code @@ -5833,8 +6232,7 @@ needs to be inserted at a specific position in the font-lock sequence.") "\\)")) '(2 'org-special-keyword t)) ;; Blocks and meta lines - '(org-fontify-meta-lines-and-blocks) - ))) + '(org-fontify-meta-lines-and-blocks)))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) (run-hooks 'org-font-lock-set-keywords-hook) ;; Now set the full font-lock-keywords @@ -5849,11 +6247,11 @@ needs to be inserted at a specific position in the font-lock sequence.") (org-set-local 'org-pretty-entities (not org-pretty-entities)) (org-restart-font-lock) (if org-pretty-entities - (message "Entities are displayed as UTF8 characters") + (message "Entities are now displayed as UTF8 characters") (save-restriction (widen) (org-decompose-region (point-min) (point-max)) - (message "Entities are displayed plain")))) + (message "Entities are now displayed as plain text")))) (defvar org-custom-properties-overlays nil "List of overlays used for custom properties.") @@ -5962,10 +6360,10 @@ When FACE-OR-COLOR is not a string, just return it." (add-text-properties (match-beginning 0) (match-end 0) (list 'face (or (org-face-from-face-or-color - 'priority 'org-special-keyword + 'priority 'org-priority (cdr (assoc (char-after (match-beginning 1)) org-priority-faces))) - 'org-special-keyword) + 'org-priority) 'font-lock-fontified t))))) (defun org-get-tag-face (kwd) @@ -6023,10 +6421,10 @@ and subscripts." (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) (goto-char (point-at-bol)) (setq table-p (org-looking-at-p org-table-dataline-regexp) - comment-p (org-looking-at-p "[ \t]*#")) + comment-p (org-looking-at-p "^[ \t]*#[ +]")) (goto-char pos) - ;; FIXME: Should we go back one character here, for a_b^c - ;; (goto-char (1- pos)) ;???????????????????? + ;; Handle a_b^c + (if (member (char-after) '(?_ ?^)) (goto-char (1- pos))) (if (or comment-p emph-p link-p keyw-p) t (put-text-property (match-beginning 3) (match-end 0) @@ -6054,8 +6452,10 @@ and subscripts." (defvar org-cycle-global-status nil) (make-variable-buffer-local 'org-cycle-global-status) +(put 'org-cycle-global-status 'org-state t) (defvar org-cycle-subtree-status nil) (make-variable-buffer-local 'org-cycle-subtree-status) +(put 'org-cycle-subtree-status 'org-state t) (defvar org-inlinetask-min-level) @@ -6113,7 +6513,8 @@ in special contexts. (and org-cycle-level-after-item/entry-creation (or (org-cycle-level) (org-cycle-item-indentation)))) - (let* ((limit-level + (let* (message-log-max ; Don't populate the *Messages* buffer + (limit-level (or org-cycle-max-level (and (boundp 'org-inlinetask-min-level) org-inlinetask-min-level @@ -6228,7 +6629,8 @@ in special contexts. (defun org-cycle-internal-global () "Do the global cycling action." ;; Hack to avoid display of messages for .org attachments in Gnus - (let ((ga (string-match "\\*fontification" (buffer-name)))) + (let (message-log-max ; Don't populate the *Messages* buffer + (ga (string-match "\\*fontification" (buffer-name)))) (cond ((and (eq last-command this-command) (eq org-cycle-global-status 'overview)) @@ -6260,7 +6662,8 @@ in special contexts. (defun org-cycle-internal-local () "Do the local cycling action." - (let ((goal-column 0) eoh eol eos has-children children-skipped struct) + (let (message-log-max ; Don't populate the *Messages* buffer + (goal-column 0) eoh eol eos has-children children-skipped struct) ;; First, determine end of headline (EOH), end of subtree or item ;; (EOS), and if item or heading has children (HAS-CHILDREN). (save-excursion @@ -6334,7 +6737,7 @@ in special contexts. (end (org-list-get-bottom-point struct))) (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded)) (org-list-get-all-items (point) struct prevs)) - (goto-char end)))))) + (goto-char (if (< end eos) end eos))))))) (message "CHILDREN") (save-excursion (goto-char eos) @@ -6613,6 +7016,13 @@ open and agenda-wise Org files." (while (re-search-forward org-drawer-regexp end t) (org-flag-drawer t)))))) +(defun org-cycle-hide-inline-tasks (state) + "Re-hide inline task when switching to 'contents visibility state." + (when (and (eq state 'contents) + (boundp 'org-inlinetask-min-level) + org-inlinetask-min-level) + (hide-sublevels (1- org-inlinetask-min-level)))) + (defun org-flag-drawer (flag) "When FLAG is non-nil, hide the drawer we are within. Otherwise make it visible." @@ -6624,7 +7034,7 @@ Otherwise make it visible." "^[ \t]*:END:" (save-excursion (outline-next-heading) (point)) t) (outline-flag-region b (point-at-eol) flag) - (error ":END: line missing at position %s" b)))))) + (user-error ":END: line missing at position %s" b)))))) (defun org-subtree-end-visible-p () "Is the end of the current subtree visible?" @@ -6756,7 +7166,7 @@ Optional arguments START and END can be used to limit the range." 'org-hide-block) (delete-overlay ov)))) (push ov org-hide-block-overlays))) - (error "Not looking at a source block")))) + (user-error "Not looking at a source block")))) ;; org-tab-after-check-for-cycling-hook (add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe) @@ -6814,7 +7224,6 @@ RET=jump to location C-g=quit and return to previous location (defvar org-goto-start-pos) ; dynamically scoped parameter -;; FIXME: Docstring does not mention both interfaces (defun org-goto (&optional alternative-interface) "Look up a different location in the current file, keeping current visibility. @@ -6950,7 +7359,7 @@ or nil." (setq org-goto-selected-point (point) org-goto-exit-command 'left) (throw 'exit nil)) - (error "Not on a heading"))) + (user-error "Not on a heading"))) (defun org-goto-right () "Finish `org-goto' by going to the new location." @@ -6960,7 +7369,7 @@ or nil." (setq org-goto-selected-point (point) org-goto-exit-command 'right) (throw 'exit nil)) - (error "Not on a heading"))) + (user-error "Not on a heading"))) (defun org-goto-quit () "Finish `org-goto' without cursor motion." @@ -7062,36 +7471,59 @@ frame is not changed." ;;; Inserting headlines -(defun org-previous-line-empty-p () +(defun org-previous-line-empty-p (&optional next) + "Is the previous line a blank line? +When NEXT is non-nil, check the next line instead." (save-excursion (and (not (bobp)) - (or (beginning-of-line 0) t) + (or (beginning-of-line (if next 2 0)) t) (save-match-data (looking-at "[ \t]*$"))))) -(defun org-insert-heading (&optional force-heading invisible-ok) +(defun org-insert-heading (&optional arg invisible-ok) "Insert a new heading or item with same depth at point. -If point is in a plain list and FORCE-HEADING is nil, create a new list item. -If point is at the beginning of a headline, insert a sibling before the -current headline. If point is not at the beginning, split the line, -create the new headline with the text in the current line after point -\(but see also the variable `org-M-RET-may-split-line'). +If point is in a plain list and ARG is nil, create a new list item. +With one universal prefix argument, insert a heading even in lists. +With two universal prefix arguments, insert the heading at the end +of the parent subtree. + +If point is at the beginning of a headline, insert a sibling before +the current headline. If point is not at the beginning, split the line +and create a new headline with the text in the current line after point +\(see `org-M-RET-may-split-line' on how to modify this behavior). When INVISIBLE-OK is set, stop at invisible headlines when going back. This is important for non-interactive uses of the command." (interactive "P") - (if (or (= (buffer-size) 0) - (and (not (save-excursion - (and (ignore-errors (org-back-to-heading invisible-ok)) - (org-at-heading-p)))) - (or force-heading (not (org-in-item-p))))) - (progn - (insert "\n* ") - (run-hooks 'org-insert-heading-hook)) - (when (or force-heading (not (org-insert-item))) + (cond + ((or (= (buffer-size) 0) + (and (not (save-excursion + (and (ignore-errors (org-back-to-heading invisible-ok)) + (org-at-heading-p)))) + (or arg (not (org-in-item-p))))) + (insert + (if (org-previous-line-empty-p) "" "\n") + (if (org-in-src-block-p) ",* " "* ")) + (run-hooks 'org-insert-heading-hook)) + ((or arg + (and (not (org-in-item-p)) org-insert-heading-respect-content) + (not (org-insert-item + (save-excursion + (beginning-of-line) + (looking-at org-list-full-item-re) + (match-string 3))))) + (let (begn endn) + (when (org-buffer-narrowed-p) + (setq begn (point-min) endn (point-max)) + (widen)) (let* ((empty-line-p nil) + (eops (equal arg '(16))) ; insert at end of parent subtree + (org-insert-heading-respect-content + (or (not (null arg)) org-insert-heading-respect-content)) (level nil) (on-heading (org-at-heading-p)) + (on-empty-line + (save-excursion (beginning-of-line 1) (looking-at "^\\s-*$"))) (head (save-excursion (condition-case nil (progn @@ -7107,32 +7539,32 @@ This is important for non-interactive uses of the command." (if (org-at-heading-p) (org-back-to-heading invisible-ok) (error "This should not happen"))) - (setq empty-line-p (org-previous-line-empty-p)) + (unless (and (save-excursion + (save-match-data + (org-backward-heading-same-level 1 invisible-ok)) + (= (point) (match-beginning 0))) + (not (org-previous-line-empty-p t))) + (setq empty-line-p (org-previous-line-empty-p))) (match-string 0)) - (error "*")))) + (error "* ")))) (blank-a (cdr (assq 'heading org-blank-before-new-entry))) (blank (if (eq blank-a 'auto) empty-line-p blank-a)) pos hide-previous previous-pos) - (cond - ((and (org-at-heading-p) (bolp) - (or (bobp) - (save-excursion (backward-char 1) (not (outline-invisible-p))))) - ;; insert before the current line - (open-line (if blank 2 1))) - ((and (bolp) - (not org-insert-heading-respect-content) - (or (bobp) - (save-excursion - (backward-char 1) (not (outline-invisible-p))))) - ;; insert right here - nil) - (t - ;; somewhere in the line - (save-excursion + (if ;; At the beginning of a heading, open a new line for insertiong + (and (bolp) (org-at-heading-p) + (not eops) + (or (bobp) + (save-excursion (backward-char 1) (not (outline-invisible-p))))) + (open-line (if blank 2 1)) + (save-excursion (setq previous-pos (point-at-bol)) - (end-of-line) - (setq hide-previous (outline-invisible-p))) - (and org-insert-heading-respect-content (org-show-subtree)) + (end-of-line) + (setq hide-previous (outline-invisible-p))) + (and org-insert-heading-respect-content + (save-excursion + (while (outline-invisible-p) + (org-show-subtree) + (org-up-heading-safe)))) (let ((split (and (org-get-alist-option org-M-RET-may-split-line 'headline) (save-excursion @@ -7143,8 +7575,27 @@ This is important for non-interactive uses of the command." (> p (match-beginning 4))))))) tags pos) (cond + ;; Insert a new line, possibly at end of parent subtree + ((and (not arg) (not on-heading) (not on-empty-line) + (not (save-excursion + (beginning-of-line 1) + (looking-at org-list-full-item-re)))) + (beginning-of-line 1)) (org-insert-heading-respect-content - (org-end-of-subtree nil t) + (if (not eops) + (progn + (org-end-of-subtree nil t) + (and (looking-at "^\\*") (backward-char 1)) + (while (and (not (bobp)) + ;; Don't delete spaces in empty headlines + (not (looking-back org-outline-regexp)) + (member (char-before) '(?\ ?\t ?\n))) + (backward-delete-char 1))) + (let ((p (point))) + (org-up-heading-safe) + (if (= p (point)) + (goto-char (point-max)) + (org-end-of-subtree nil t)))) (when (featurep 'org-inlinetask) (while (and (not (eobp)) (looking-at "\\(\\*+\\)[ \t]+") @@ -7154,7 +7605,8 @@ This is important for non-interactive uses of the command." (or (bolp) (newline)) (or (org-previous-line-empty-p) (and blank (newline))) - (open-line 1)) + (if (or empty-line-p eops) (open-line 1))) + ;; Insert a headling containing text after point ((org-at-heading-p) (when hide-previous (show-children) @@ -7178,16 +7630,20 @@ This is important for non-interactive uses of the command." (org-set-tags nil 'align)))) (t (or split (end-of-line 1)) - (newline (if blank 2 1))))))) + (newline (cond ((and blank (not on-empty-line)) 2) + (blank 1) + (on-empty-line 0) (t 1))))))) (insert head) (just-one-space) (setq pos (point)) (end-of-line 1) (unless (= (point) pos) (just-one-space) (backward-delete-char 1)) - (when (and org-insert-heading-respect-content hide-previous) + (when (and org-insert-heading-respect-content hide-previous) (save-excursion (goto-char previous-pos) (hide-subtree))) - (run-hooks 'org-insert-heading-hook))))) + (when (and begn endn) + (narrow-to-region (min (point) begn) (max (point) endn))) + (run-hooks 'org-insert-heading-hook)))))) (defun org-get-heading (&optional no-tags no-todo) "Return the heading of the current entry, without the stars. @@ -7210,6 +7666,8 @@ When NO-TODO is non-nil, don't include TODO keywords." (t (looking-at org-heading-regexp) (match-string 2))))) +(defvar orgstruct-mode) ; defined below + (defun org-heading-components () "Return the components of the current heading. This is a list with the following elements: @@ -7221,13 +7679,24 @@ This is a list with the following elements: - the tags string, or nil." (save-excursion (org-back-to-heading t) - (if (let (case-fold-search) (looking-at org-complex-heading-regexp)) - (list (length (match-string 1)) - (org-reduced-level (length (match-string 1))) - (org-match-string-no-properties 2) - (and (match-end 3) (aref (match-string 3) 2)) - (org-match-string-no-properties 4) - (org-match-string-no-properties 5))))) + (if (let (case-fold-search) + (looking-at + (if orgstruct-mode + org-heading-regexp + org-complex-heading-regexp))) + (if orgstruct-mode + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + nil + nil + (match-string 2) + nil) + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + (org-match-string-no-properties 2) + (and (match-end 3) (aref (match-string 3) 2)) + (org-match-string-no-properties 4) + (org-match-string-no-properties 5)))))) (defun org-get-entry () "Get the entry text, after heading, entire subtree." @@ -7243,11 +7712,11 @@ This is a list with the following elements: (org-move-subtree-down) (end-of-line 1)) -(defun org-insert-heading-respect-content (invisible-ok) +(defun org-insert-heading-respect-content (&optional arg invisible-ok) "Insert heading with `org-insert-heading-respect-content' set to t." (interactive "P") (let ((org-insert-heading-respect-content t)) - (org-insert-heading t invisible-ok))) + (org-insert-heading arg invisible-ok))) (defun org-insert-todo-heading-respect-content (&optional force-state) "Insert TODO heading with `org-insert-heading-respect-content' set to t." @@ -7258,10 +7727,12 @@ This is a list with the following elements: (defun org-insert-todo-heading (arg &optional force-heading) "Insert a new heading with the same level and TODO state as current heading. If the heading has no TODO state, or if the state is DONE, use the first -state (TODO by default). Also with prefix arg, force first state." +state (TODO by default). Also one prefix arg, force first state. With two +prefix args, force inserting at the end of the parent subtree." (interactive "P") (when (or force-heading (not (org-insert-item 'checkbox))) - (org-insert-heading force-heading) + (org-insert-heading (or (and (equal arg '(16)) '(16)) + force-heading)) (save-excursion (org-back-to-heading) (outline-previous-heading) @@ -7435,7 +7906,7 @@ in the region." org-allow-promoting-top-level-subtree) (replace-match "# " nil t)) ((= level 1) - (error "Cannot promote to level 0. UNDO to recover if necessary")) + (user-error "Cannot promote to level 0. UNDO to recover if necessary")) (t (replace-match up-head nil t))) ;; Fixup tag positioning (unless (= level 1) @@ -7629,7 +8100,7 @@ case." (while (> cnt 0) (or (and (funcall movfunc) (looking-at org-outline-regexp)) (progn (goto-char beg0) - (error "Cannot move past superior level or buffer limit"))) + (user-error "Cannot move past superior level or buffer limit"))) (setq cnt (1- cnt))) (if (> arg 0) ;; Moving forward - still need to move over subtree @@ -7689,7 +8160,7 @@ This is a short-hand for marking the subtree and then cutting it." (interactive "p") (org-copy-subtree n 'cut)) -(defun org-copy-subtree (&optional n cut force-store-markers) +(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. This is a short-hand for marking the subtree and then copying it. @@ -7705,12 +8176,14 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (setq beg (point)) (skip-chars-forward " \t\r\n") (save-match-data - (save-excursion (outline-end-of-heading) - (setq folded (outline-invisible-p))) - (condition-case nil - (org-forward-heading-same-level (1- n) t) - (error nil)) - (org-end-of-subtree t t)) + (if nosubtrees + (outline-next-heading) + (save-excursion (outline-end-of-heading) + (setq folded (outline-invisible-p))) + (condition-case nil + (org-forward-heading-same-level (1- n) t) + (error nil)) + (org-end-of-subtree t t))) (setq end (point)) (goto-char beg0) (when (> end beg) @@ -7729,7 +8202,7 @@ The entire subtree is promoted or demoted in order to match a new headline level. If the cursor is at the beginning of a headline, the same level as -that headline is used to paste the tree +that headline is used to paste the tree. If not, the new level is derived from the *visible* headings before and after the insertion point, and taken to be the inferior headline @@ -7750,7 +8223,7 @@ the inserted text when done." (interactive "P") (setq tree (or tree (and kill-ring (current-kill 0)))) (unless (org-kill-is-subtree-p tree) - (error "%s" + (user-error "%s" (substitute-command-keys "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) (org-with-limited-levels @@ -7911,7 +8384,7 @@ If yes, remember the marker and the distance to BEG." "^[ \t]*#\\+end_.*"))) (if blockp (narrow-to-region (car blockp) (cdr blockp)) - (error "Not in a block")))) + (user-error "Not in a block")))) (eval-when-compile (defvar org-property-drawer-re)) @@ -7922,8 +8395,10 @@ If yes, remember the marker and the distance to BEG." The clones will be inserted as siblings. In interactive use, the user will be prompted for the number of -clones to be produced, and for a time SHIFT, which may be a -repeater as used in time stamps, for example `+3d'. +clones to be produced. When called with a universal prefix argument +and if the entry has a timestamp, the user will also be prompted for +a time shift, which may be a repeater as used in time stamps, for +example `+3d'. When a valid repeater is given and the entry contains any time stamps, the clones will become a sequence in time, with time @@ -7942,10 +8417,22 @@ the following will happen: to past the last clone. In this way you can spell out a number of instances of a repeating task, and still retain the repeater to cover future instances of the task." - (interactive "nNumber of clones to produce: \nsDate shift per clone (e.g. +1w, empty to copy unchanged): ") - (let (beg end template task idprop - shift-n shift-what doshift nmin nmax (n-no-remove -1) - (drawer-re org-drawer-regexp)) + (interactive "nNumber of clones to produce: ") + (let ((shift + (or shift + (if (and (equal current-prefix-arg '(4)) + (save-excursion + (re-search-forward org-ts-regexp-both + (save-excursion + (org-end-of-subtree t) + (point)) t))) + (read-from-minibuffer + "Date shift per clone (e.g. +1w, empty to copy unchanged): ") + ""))) ;; No time shift + (n-no-remove -1) + (drawer-re org-drawer-regexp) + beg end template task idprop + shift-n shift-what doshift nmin nmax) (if (not (and (integerp n) (> n 0))) (error "Invalid number of replications %s" n)) (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift))) @@ -8017,11 +8504,16 @@ Optional argument WITH-CASE means sort case-sensitively." (org-call-with-arg 'org-sort-entries with-case)))) (defun org-sort-remove-invisible (s) + "Remove invisible links from string S." (remove-text-properties 0 (length s) org-rm-props s) (while (string-match org-bracket-link-regexp s) (setq s (replace-match (if (match-end 2) (match-string 3 s) (match-string 1 s)) t t s))) + (let ((st (format " %s " s))) + (while (string-match org-emph-re st) + (setq st (replace-match (format " %s " (match-string 4 st)) t t st))) + (setq s (substring st 1 -1))) s) (defvar org-priority-regexp) ; defined later in the file @@ -8040,7 +8532,7 @@ Else, if the cursor is before the first entry, sort the top-level items. Else, the children of the entry at point are sorted. Sorting can be alphabetically, numerically, by date/time as given by -a time stamp, by a property or by priority. +a time stamp, by a property, by priority order, or by a custom function. The command prompts for the sorting type unless it has been given to the function through the SORTING-TYPE argument, which needs to be a character, @@ -8066,7 +8558,10 @@ called with point at the beginning of the record. It must return either a string or a number that should serve as the sorting key for that record. Comparing entries ignores case by default. However, with an optional argument -WITH-CASE, the sorting considers case as well." +WITH-CASE, the sorting considers case as well. + +Sorting is done against the visible part of the headlines, it ignores hidden +links." (interactive "P") (let ((case-func (if with-case 'identity 'downcase)) (cmstr @@ -8117,7 +8612,7 @@ WITH-CASE, the sorting considers case as well." (show-all))) (setq beg (point)) - (if (>= beg end) (error "Nothing to sort")) + (if (>= beg end) (user-error "Nothing to sort")) (looking-at "\\(\\*+\\)") (setq stars (match-string 1) @@ -8126,7 +8621,7 @@ WITH-CASE, the sorting considers case as well." txt (buffer-substring beg end)) (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) (if (and (not (equal stars "*")) (string-match re2 txt)) - (error "Region to sort contains a level above the first entry")) + (user-error "Region to sort contains a level above the first entry")) (unless sorting-type (message @@ -8136,13 +8631,15 @@ WITH-CASE, the sorting considers case as well." what) (setq sorting-type (read-char-exclusive)) - (and (= (downcase sorting-type) ?f) - (setq getkey-func - (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil)) - (setq getkey-func (intern getkey-func))) + (unless getkey-func + (and (= (downcase sorting-type) ?f) + (setq getkey-func + (org-icompleting-read "Sort using function: " + obarray 'fboundp t nil nil)) + (setq getkey-func (intern getkey-func)))) (and (= (downcase sorting-type) ?r) + (not property) (setq property (org-icompleting-read "Property: " (mapcar 'list (org-buffer-property-keys t)) @@ -8176,11 +8673,11 @@ WITH-CASE, the sorting considers case as well." (cond ((= dcst ?n) (if (looking-at org-complex-heading-regexp) - (string-to-number (match-string 4)) + (string-to-number (org-sort-remove-invisible (match-string 4))) nil)) ((= dcst ?a) (if (looking-at org-complex-heading-regexp) - (funcall case-func (match-string 4)) + (funcall case-func (org-sort-remove-invisible (match-string 4))) nil)) ((= dcst ?t) (let ((end (save-excursion (outline-next-heading) (point)))) @@ -8298,12 +8795,23 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." ;; command. There might be problems if any of the keys is otherwise ;; used as a prefix key. -;; Another challenge is that the key binding for TAB can be tab or \C-i, -;; likewise the binding for RET can be return or \C-m. Orgtbl-mode -;; addresses this by checking explicitly for both bindings. +(defcustom orgstruct-heading-prefix-regexp nil + "Regexp that matches the custom prefix of Org headlines in +orgstruct(++)-mode." + :group 'org + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) +;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) -(defvar orgstruct-mode-map (make-sparse-keymap) - "Keymap for the minor `orgstruct-mode'.") +(defcustom orgstruct-setup-hook nil + "Hook run after orgstruct-mode-map is filled." + :group 'org + :version "24.4" + :package-version '(Org . "8.0") + :type 'hook) + +(defvar orgstruct-initialized nil) (defvar org-local-vars nil "List of local variables, for use by `orgstruct-mode'.") @@ -8314,26 +8822,17 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." This mode is for using Org-mode structure commands in other modes. The following keys behave as if Org-mode were active, if the cursor is on a headline, or on a plain list item (both as -defined by Org-mode). - -M-up Move entry/item up -M-down Move entry/item down -M-left Promote -M-right Demote -M-S-up Move entry/item up -M-S-down Move entry/item down -M-S-left Promote subtree -M-S-right Demote subtree -M-q Fill paragraph and items like in Org-mode -C-c ^ Sort entries -C-c - Cycle list bullet -TAB Cycle item visibility -M-RET Insert new heading/item -S-M-RET Insert new TODO heading / Checkbox item -C-c C-c Set tags / toggle checkbox" - nil " OrgStruct" nil - (org-load-modules-maybe) - (and (orgstruct-setup) (defun orgstruct-setup () nil))) +defined by Org-mode)." + nil " OrgStruct" (make-sparse-keymap) + (funcall (if orgstruct-mode + 'add-to-invisibility-spec + 'remove-from-invisibility-spec) + '(outline . t)) + (when orgstruct-mode + (org-load-modules-maybe) + (unless orgstruct-initialized + (orgstruct-setup) + (setq orgstruct-initialized t)))) ;;;###autoload (defun turn-on-orgstruct () @@ -8381,107 +8880,157 @@ buffer. It will also recognize item context in multiline items." (defun orgstruct-error () "Error when there is no default binding for a structure key." (interactive) - (error "This key has no function outside structure elements")) + (funcall (if (fboundp 'user-error) + 'user-error + 'error) + "This key has no function outside structure elements")) (defun orgstruct-setup () - "Setup orgstruct keymaps." - (let ((nfunc 0) - (bindings - (list - '([(meta up)] org-metaup) - '([(meta down)] org-metadown) - '([(meta left)] org-metaleft) - '([(meta right)] org-metaright) - '([(meta shift up)] org-shiftmetaup) - '([(meta shift down)] org-shiftmetadown) - '([(meta shift left)] org-shiftmetaleft) - '([(meta shift right)] org-shiftmetaright) - '([?\e (up)] org-metaup) - '([?\e (down)] org-metadown) - '([?\e (left)] org-metaleft) - '([?\e (right)] org-metaright) - '([?\e (shift up)] org-shiftmetaup) - '([?\e (shift down)] org-shiftmetadown) - '([?\e (shift left)] org-shiftmetaleft) - '([?\e (shift right)] org-shiftmetaright) - '([(shift up)] org-shiftup) - '([(shift down)] org-shiftdown) - '([(shift left)] org-shiftleft) - '([(shift right)] org-shiftright) - '("\C-c\C-c" org-ctrl-c-ctrl-c) - '("\M-q" fill-paragraph) - '("\C-c^" org-sort) - '("\C-c-" org-cycle-list-bullet))) - elt key fun cmd) - (while (setq elt (pop bindings)) - (setq nfunc (1+ nfunc)) - (setq key (org-key (car elt)) - fun (nth 1 elt) - cmd (orgstruct-make-binding fun nfunc key)) - (org-defkey orgstruct-mode-map key cmd)) + "Setup orgstruct keymap." + (dolist (cell '((org-demote . t) + (org-metaleft . t) + (org-metaright . t) + (org-promote . t) + (org-shiftmetaleft . t) + (org-shiftmetaright . t) + org-backward-element + org-backward-heading-same-level + org-ctrl-c-ret + org-ctrl-c-minus + org-ctrl-c-star + org-cycle + org-forward-heading-same-level + org-insert-heading + org-insert-heading-respect-content + org-kill-note-or-show-branches + org-mark-subtree + org-meta-return + org-metadown + org-metaup + org-narrow-to-subtree + org-promote-subtree + org-reveal + org-shiftdown + org-shiftleft + org-shiftmetadown + org-shiftmetaup + org-shiftright + org-shifttab + org-shifttab + org-shiftup + org-show-subtree + org-sort + org-up-element + outline-demote + outline-next-visible-heading + outline-previous-visible-heading + outline-promote + outline-up-heading + show-children)) + (let ((f (or (car-safe cell) cell)) + (disable-when-heading-prefix (cdr-safe cell))) + (when (fboundp f) + (dolist (binding (nconc (where-is-internal f org-mode-map) + (where-is-internal f outline-mode-map))) + ;; TODO use local-function-key-map + (dolist (rep '(("" . "TAB") + ("" . "RET") + ("" . "ESC") + ("" . "DEL"))) + (setq binding (read-kbd-macro + (let ((case-fold-search)) + (replace-regexp-in-string + (regexp-quote (cdr rep)) + (car rep) + (key-description binding)))))) + (let ((key (lookup-key orgstruct-mode-map binding))) + (when (or (not key) (numberp key)) + (condition-case nil + (org-defkey orgstruct-mode-map + binding + (orgstruct-make-binding f binding disable-when-heading-prefix)) + (error nil)))))))) + (run-hooks 'orgstruct-setup-hook)) - ;; Prevent an error for users who forgot to make autoloads - (require 'org-element) - - ;; Special treatment needed for TAB and RET - (org-defkey orgstruct-mode-map [(tab)] - (orgstruct-make-binding 'org-cycle 102 [(tab)] "\C-i")) - (org-defkey orgstruct-mode-map "\C-i" - (orgstruct-make-binding 'org-cycle 103 "\C-i" [(tab)])) - - (org-defkey orgstruct-mode-map "\M-\C-m" - (orgstruct-make-binding 'org-insert-heading 105 - "\M-\C-m" [(meta return)])) - (org-defkey orgstruct-mode-map [(meta return)] - (orgstruct-make-binding 'org-insert-heading 106 - [(meta return)] "\M-\C-m")) - - (org-defkey orgstruct-mode-map [(shift meta return)] - (orgstruct-make-binding 'org-insert-todo-heading 107 - [(meta return)] "\M-\C-m")) - - (org-defkey orgstruct-mode-map "\e\C-m" - (orgstruct-make-binding 'org-insert-heading 108 - "\e\C-m" [?\e (return)])) - (org-defkey orgstruct-mode-map [?\e (return)] - (orgstruct-make-binding 'org-insert-heading 109 - [?\e (return)] "\e\C-m")) - (org-defkey orgstruct-mode-map [?\e (shift return)] - (orgstruct-make-binding 'org-insert-todo-heading 110 - [?\e (return)] "\e\C-m")) - - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - - t)) - -(defun orgstruct-make-binding (fun n &rest keys) +(defun orgstruct-make-binding (fun key disable-when-heading-prefix) "Create a function for binding in the structure minor mode. -FUN is the command to call inside a table. N is used to create a unique -command name. KEYS are keys that should be checked in for a command -to execute outside of tables." - (eval - (list 'defun - (intern (concat "orgstruct-hijacker-command-" (int-to-string n))) - '(arg) - (concat "In Structure, run `" (symbol-name fun) "'.\n" - "Outside of structure, run the binding of `" - (mapconcat (lambda (x) (format "%s" x)) keys "' or `") - "'.") - '(interactive "p") - (list 'if - `(org-context-p 'headline 'item - (and orgstruct-is-++ - ,(and (memq fun '(org-insert-heading org-insert-todo-heading)) t) - 'item-body)) - (list 'org-run-like-in-org-mode (list 'quote fun)) - (list 'let '(orgstruct-mode) - (list 'call-interactively - (append '(or) - (mapcar (lambda (k) - (list 'key-binding k)) - keys) - '('orgstruct-error)))))))) +FUN is the command to call inside a table. KEY is the key that +should be checked in for a command to execute outside of tables. +Non-nil DISABLE-WHEN-HEADING-PREFIX means to disable the command +if `orgstruct-heading-prefix-regexp' is non-nil." + (let ((name (concat "orgstruct-hijacker-" (symbol-name fun)))) + (let ((nname name) + (i 0)) + (while (fboundp (intern nname)) + (setq nname (format "%s-%d" name (setq i (1+ i))))) + (setq name (intern nname))) + (eval + (let ((bindings '((org-heading-regexp + (concat "^" + orgstruct-heading-prefix-regexp + "\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ ]*$")) + (org-outline-regexp + (concat orgstruct-heading-prefix-regexp "\\*+ ")) + (org-outline-regexp-bol + (concat "^" org-outline-regexp)) + (outline-regexp org-outline-regexp) + (outline-heading-end-regexp "\n") + (outline-level 'org-outline-level) + (outline-heading-alist)))) + `(defun ,name (arg) + ,(concat "In Structure, run `" (symbol-name fun) "'.\n" + "Outside of structure, run the binding of `" + (key-description key) "'." + (when disable-when-heading-prefix + (concat + "\nIf `orgstruct-heading-prefix-regexp' is non-nil, this command will always fall\n" + "back to the default binding due to limitations of Org's implementation of\n" + "`" (symbol-name fun) "'."))) + (interactive "p") + (let* ((disable + ,(when disable-when-heading-prefix + '(and orgstruct-heading-prefix-regexp + (not (string= orgstruct-heading-prefix-regexp ""))))) + (fallback + (or disable + (not + (let* ,bindings + (org-context-p 'headline 'item + ,(when (memq fun '(org-insert-heading)) + '(when orgstruct-is-++ + 'item-body)))))))) + (if fallback + (let* ((orgstruct-mode) + (binding + (loop with key = ,key + for rep in + '(nil + ("<\\([^>]*\\)tab>" . "\\1TAB") + ("<\\([^>]*\\)return>" . "\\1RET") + ("<\\([^>]*\\)escape>" . "\\1ESC") + ("<\\([^>]*\\)delete>" . "\\1DEL")) + do + (when rep + (setq key (read-kbd-macro + (let ((case-fold-search)) + (replace-regexp-in-string + (car rep) + (cdr rep) + (key-description key)))))) + thereis (key-binding key)))) + (if (keymapp binding) + (set-temporary-overlay-map binding) + (let ((func (or binding + (unless disable + 'orgstruct-error)))) + (when func + (call-interactively func))))) + (org-run-like-in-org-mode + (lambda () + (interactive) + (let* ,bindings + (call-interactively ',fun))))))))) + name)) (defun org-contextualize-keys (alist contexts) "Return valid elements in ALIST depending on CONTEXTS. @@ -8545,11 +9094,15 @@ definitions." (string-match (cdr rr) (buffer-file-name))) (and (eq (car rr) 'in-mode) (string-match (cdr rr) (symbol-name major-mode))) + (and (eq (car rr) 'in-buffer) + (string-match (cdr rr) (buffer-name))) (when (and (eq (car rr) 'not-in-file) (buffer-file-name)) (not (string-match (cdr rr) (buffer-file-name)))) (when (eq (car rr) 'not-in-mode) - (not (string-match (cdr rr) (symbol-name major-mode))))))) + (not (string-match (cdr rr) (symbol-name major-mode)))) + (when (eq (car rr) 'not-in-buffer) + (not (string-match (cdr rr) (buffer-name))))))) (push r res))) (car (last r)))) (delete-dups (delq nil res)))) @@ -8578,17 +9131,18 @@ Possible values in the list of contexts are `table', `headline', and `item'." (setq varlist (buffer-local-variables))) (kill-buffer "*Org tmp*") (delq nil - (mapcar - (lambda (x) - (setq x - (if (symbolp x) - (list x) - (list (car x) (list 'quote (cdr x))))) - (if (string-match - "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" - (symbol-name (car x))) - x nil)) - varlist)))) + (mapcar + (lambda (x) + (setq x + (if (symbolp x) + (list x) + (list (car x) (cdr x)))) + (if (and (not (get (car x) 'org-state)) + (string-match + "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" + (symbol-name (car x)))) + x nil)) + varlist)))) (defun org-clone-local-variables (from-buffer &optional regexp) "Clone local variables from FROM-BUFFER. @@ -8611,8 +9165,14 @@ call CMD." (org-load-modules-maybe) (unless org-local-vars (setq org-local-vars (org-get-local-variables))) - (eval (list 'let org-local-vars - (list 'call-interactively (list 'quote cmd))))) + (let (binds) + (dolist (var org-local-vars) + (when (or (not (boundp (car var))) + (eq (symbol-value (car var)) + (default-value (car var)))) + (push (list (car var) `(quote ,(cadr var))) binds))) + (eval `(let ,binds + (call-interactively (quote ,cmd)))))) ;;;; Archiving @@ -8638,7 +9198,7 @@ call CMD." ((symbolp org-category) (symbol-name org-category)) (t org-category))) beg end cat pos optionp) - (org-unmodified + (org-with-silent-modifications (save-excursion (save-restriction (widen) @@ -8663,7 +9223,7 @@ DPROP is the drawer property and TPROP is the corresponding text property to set." (let ((case-fold-search t) (inhibit-read-only t) p) - (org-unmodified + (org-with-silent-modifications (save-excursion (save-restriction (widen) @@ -8694,7 +9254,9 @@ property to set." (cond ((symbolp rpl) (funcall rpl tag)) ((string-match "%(\\([^)]+\\))" rpl) - (replace-match (funcall (intern-soft (match-string 1 rpl)) tag) t t rpl)) + (replace-match + (save-match-data + (funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl)) ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) ((string-match "%h" rpl) (replace-match (url-hexify-string (or tag "")) t t rpl)) @@ -8776,191 +9338,237 @@ type. For a simple example of an export function, see `org-bbdb.el'." This link is added to `org-stored-links' and can later be inserted into an org-buffer with \\[org-insert-link]. -For some link types, a prefix arg is interpreted: -For links to usenet articles, arg negates `org-gnus-prefer-web-links'. -For file links, arg negates `org-context-in-file-links'." +For some link types, a prefix arg is interpreted. +For links to Usenet articles, arg negates `org-gnus-prefer-web-links'. +For file links, arg negates `org-context-in-file-links'. + +A double prefix arg force skipping storing functions that are not +part of Org's core. + +A triple prefix arg force storing a link for each line in the +active region." (interactive "P") (org-load-modules-maybe) - (setq org-store-link-plist nil) ; reset - (org-with-limited-levels - (let (link cpltxt desc description search txt custom-id agenda-link) - (cond - - ((run-hook-with-args-until-success 'org-store-link-functions) - (setq link (plist-get org-store-link-plist :link) - desc (or (plist-get org-store-link-plist :description) link))) - - ((org-src-edit-buffer-p) - (let (label gc) - (while (or (not label) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward - (regexp-quote (format org-coderef-label-format label)) - nil t)))) - (when label (message "Label exists already") (sit-for 2)) - (setq label (read-string "Code line label: " label))) - (end-of-line 1) - (setq link (format org-coderef-label-format label)) - (setq gc (- 79 (length link))) - (if (< (current-column) gc) (org-move-to-column gc t) (insert " ")) - (insert link) - (setq link (concat "(" label ")") desc nil))) - - ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name)) - ;; We are in the agenda, link to referenced location - (let ((m (or (get-text-property (point) 'org-hd-marker) - (get-text-property (point) 'org-marker)))) - (when m - (org-with-point-at m - (setq agenda-link - (if (org-called-interactively-p 'any) - (call-interactively 'org-store-link) - (org-store-link nil))))))) - - ((eq major-mode 'calendar-mode) - (let ((cd (calendar-cursor-to-date))) - (setq link - (format-time-string - (car org-time-stamp-formats) - (apply 'encode-time - (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) - nil nil nil)))) - (org-store-link-props :type "calendar" :date cd))) - - ((eq major-mode 'help-mode) - (setq link (concat "help:" (save-excursion - (goto-char (point-min)) - (looking-at "^[^ ]+") - (match-string 0)))) - (org-store-link-props :type "help")) - - ((eq major-mode 'w3-mode) - (setq cpltxt (if (and (buffer-name) - (not (string-match "Untitled" (buffer-name)))) - (buffer-name) - (url-view-url t)) - link (url-view-url t)) - (org-store-link-props :type "w3" :url (url-view-url t))) - - ((eq major-mode 'w3m-mode) - (setq cpltxt (or w3m-current-title w3m-current-url) - link w3m-current-url) - (org-store-link-props :type "w3m" :url (url-view-url t))) - - ((setq search (run-hook-with-args-until-success - 'org-create-file-search-functions)) - (setq link (concat "file:" (abbreviate-file-name buffer-file-name) - "::" search)) - (setq cpltxt (or description link))) - - ((eq major-mode 'image-mode) - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name)) - link cpltxt) - (org-store-link-props :type "image" :file buffer-file-name)) - - ((eq major-mode 'dired-mode) - ;; link to the file in the current line - (let ((file (dired-get-filename nil t))) - (setq file (if file - (abbreviate-file-name - (expand-file-name (dired-get-filename nil t))) - ;; otherwise, no file so use current directory. - default-directory)) - (setq cpltxt (concat "file:" file) - link cpltxt))) - - ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) - (setq custom-id (org-entry-get nil "CUSTOM_ID")) + (if (and (equal arg '(64)) (org-region-active-p)) + (save-excursion + (let ((end (region-end))) + (goto-char (region-beginning)) + (set-mark (point)) + (while (< (point-at-eol) end) + (move-end-of-line 1) (activate-mark) + (let (current-prefix-arg) + (call-interactively 'org-store-link)) + (move-beginning-of-line 2) + (set-mark (point))))) + (org-with-limited-levels + (setq org-store-link-plist nil) + (let (link cpltxt desc description search + txt custom-id agenda-link sfuns sfunsn) (cond - ((org-in-regexp "<<\\(.*?\\)>>") - (setq cpltxt - (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))) - "::" (match-string 1)) - link cpltxt)) - ((and (featurep 'org-id) - (or (eq org-id-link-to-org-use-id t) - (and (org-called-interactively-p 'any) - (or (eq org-id-link-to-org-use-id 'create-if-interactive) - (and (eq org-id-link-to-org-use-id - 'create-if-interactive-and-no-custom-id) - (not custom-id)))) - (and org-id-link-to-org-use-id (org-entry-get nil "ID")))) - ;; We can make a link using the ID. - (setq link (condition-case nil - (prog1 (org-id-store-link) - (setq desc (plist-get org-store-link-plist :description))) - (error - ;; probably before first headline, link to file only - (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer)))))))) - (t - ;; Just link to current headline + + ;; Store a link using an external link type + ((and (not (equal arg '(16))) + (setq sfuns + (delq + nil (mapcar (lambda (f) + (let (fs) (if (funcall f) (push f fs)))) + org-store-link-functions)) + sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns)) + (or (and (cdr sfuns) + (funcall (intern + (completing-read + "Which function for creating the link? " + sfunsn t (car sfunsn))))) + (funcall (caar sfuns))) + (setq link (plist-get org-store-link-plist :link) + desc (or (plist-get org-store-link-plist + :description) link)))) + + ;; Store a link from a source code buffer + ((org-src-edit-buffer-p) + (let (label gc) + (while (or (not label) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (re-search-forward + (regexp-quote (format org-coderef-label-format label)) + nil t)))) + (when label (message "Label exists already") (sit-for 2)) + (setq label (read-string "Code line label: " label))) + (end-of-line 1) + (setq link (format org-coderef-label-format label)) + (setq gc (- 79 (length link))) + (if (< (current-column) gc) (org-move-to-column gc t) (insert " ")) + (insert link) + (setq link (concat "(" label ")") desc nil))) + + ;; We are in the agenda, link to referenced location + ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name)) + (let ((m (or (get-text-property (point) 'org-hd-marker) + (get-text-property (point) 'org-marker)))) + (when m + (org-with-point-at m + (setq agenda-link + (if (org-called-interactively-p 'any) + (call-interactively 'org-store-link) + (org-store-link nil))))))) + + ((eq major-mode 'calendar-mode) + (let ((cd (calendar-cursor-to-date))) + (setq link + (format-time-string + (car org-time-stamp-formats) + (apply 'encode-time + (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) + nil nil nil)))) + (org-store-link-props :type "calendar" :date cd))) + + ((eq major-mode 'help-mode) + (setq link (concat "help:" (save-excursion + (goto-char (point-min)) + (looking-at "^[^ ]+") + (match-string 0)))) + (org-store-link-props :type "help")) + + ((eq major-mode 'w3-mode) + (setq cpltxt (if (and (buffer-name) + (not (string-match "Untitled" (buffer-name)))) + (buffer-name) + (url-view-url t)) + link (url-view-url t)) + (org-store-link-props :type "w3" :url (url-view-url t))) + + ((eq major-mode 'image-mode) + (setq cpltxt (concat "file:" + (abbreviate-file-name buffer-file-name)) + link cpltxt) + (org-store-link-props :type "image" :file buffer-file-name)) + + ;; In dired, store a link to the file of the current line + ((eq major-mode 'dired-mode) + (let ((file (dired-get-filename nil t))) + (setq file (if file + (abbreviate-file-name + (expand-file-name (dired-get-filename nil t))) + ;; otherwise, no file so use current directory. + default-directory)) + (setq cpltxt (concat "file:" file) + link cpltxt))) + + ((setq search (run-hook-with-args-until-success + 'org-create-file-search-functions)) + (setq link (concat "file:" (abbreviate-file-name buffer-file-name) + "::" search)) + (setq cpltxt (or description link))) + + ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) + (setq custom-id (org-entry-get nil "CUSTOM_ID")) + (cond + ;; Store a link using the target at point + ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1) + (setq cpltxt + (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))) + "::" (match-string 1)) + link cpltxt)) + ((and (featurep 'org-id) + (or (eq org-id-link-to-org-use-id t) + (and (org-called-interactively-p 'any) + (or (eq org-id-link-to-org-use-id 'create-if-interactive) + (and (eq org-id-link-to-org-use-id + 'create-if-interactive-and-no-custom-id) + (not custom-id)))) + (and org-id-link-to-org-use-id (org-entry-get nil "ID")))) + ;; Store a link using the ID at point + (setq link (condition-case nil + (prog1 (org-id-store-link) + (setq desc (plist-get org-store-link-plist + :description))) + (error + ;; Probably before first headline, link only to file + (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer)))))))) + (t + ;; Just link to current headline + (setq cpltxt (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))))) + ;; Add a context search string + (when (org-xor org-context-in-file-links arg) + (let* ((ee (org-element-at-point)) + (et (org-element-type ee)) + (ev (plist-get (cadr ee) :value)) + (ek (plist-get (cadr ee) :key)) + (eok (and (stringp ek) (string-match "name" ek)))) + (setq txt (cond + ((org-at-heading-p) nil) + ((and (eq et 'keyword) eok) ev) + ((org-region-active-p) + (buffer-substring (region-beginning) (region-end))))) + (when (or (null txt) (string-match "\\S-" txt)) + (setq cpltxt + (concat cpltxt "::" + (condition-case nil + (org-make-org-heading-search-string txt) + (error ""))) + desc (or (and (eq et 'keyword) eok ev) + (nth 4 (ignore-errors (org-heading-components))) + "NONE"))))) + (if (string-match "::\\'" cpltxt) + (setq cpltxt (substring cpltxt 0 -2))) + (setq link cpltxt)))) + + ((buffer-file-name (buffer-base-buffer)) + ;; Just link to this file here. (setq cpltxt (concat "file:" (abbreviate-file-name (buffer-file-name (buffer-base-buffer))))) - ;; Add a context search string + ;; Add a context string. (when (org-xor org-context-in-file-links arg) - (setq txt (cond - ((org-at-heading-p) nil) - ((org-region-active-p) - (buffer-substring (region-beginning) (region-end))))) - (when (or (null txt) (string-match "\\S-" txt)) + (setq txt (if (org-region-active-p) + (buffer-substring (region-beginning) (region-end)) + (buffer-substring (point-at-bol) (point-at-eol)))) + ;; Only use search option if there is some text. + (when (string-match "\\S-" txt) (setq cpltxt - (concat cpltxt "::" - (condition-case nil - (org-make-org-heading-search-string txt) - (error ""))) - desc (or (nth 4 (ignore-errors - (org-heading-components))) "NONE")))) - (if (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) - (setq link cpltxt)))) + (concat cpltxt "::" (org-make-org-heading-search-string txt)) + desc "NONE"))) + (setq link cpltxt)) - ((buffer-file-name (buffer-base-buffer)) - ;; Just link to this file here. - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context string - (when (org-xor org-context-in-file-links arg) - (setq txt (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)) - (buffer-substring (point-at-bol) (point-at-eol)))) - ;; Only use search option if there is some text. - (when (string-match "\\S-" txt) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - desc "NONE"))) - (setq link cpltxt)) + ((org-called-interactively-p 'interactive) + (user-error "No method for storing a link from this buffer")) - ((org-called-interactively-p 'interactive) - (error "Cannot link to a buffer which is not visiting a file")) + (t (setq link nil))) - (t (setq link nil))) + ;; We're done setting link and desc, clean up + (if (consp link) (setq cpltxt (car link) link (cdr link))) + (setq link (or link cpltxt) + desc (or desc cpltxt)) + (cond ((equal desc "NONE") (setq desc nil)) + ((string-match org-bracket-link-analytic-regexp desc) + (let ((d0 (match-string 3 desc)) + (p0 (match-string 5 desc))) + (setq desc + (replace-regexp-in-string + org-bracket-link-regexp + (concat (or p0 d0) + (if (equal (length (match-string 0 desc)) + (length desc)) "*" "")) desc))))) - (if (consp link) (setq cpltxt (car link) link (cdr link))) - (setq link (or link cpltxt) - desc (or desc cpltxt)) - (if (equal desc "NONE") (setq desc nil)) - - (if (and (or (org-called-interactively-p 'any) executing-kbd-macro) link) - (progn - (setq org-stored-links - (cons (list link desc) org-stored-links)) - (message "Stored: %s" (or desc link)) - (when custom-id - (setq link (concat "file:" (abbreviate-file-name (buffer-file-name)) - "::#" custom-id)) - (setq org-stored-links - (cons (list link desc) org-stored-links)))) - (or agenda-link (and link (org-make-link-string link desc))))))) + ;; Return the link + (if (not (and (or (org-called-interactively-p 'any) + executing-kbd-macro) link)) + (or agenda-link (and link (org-make-link-string link desc))) + (push (list link desc) org-stored-links) + (message "Stored: %s" (or desc link)) + (when custom-id + (setq link (concat "file:" (abbreviate-file-name + (buffer-file-name)) "::#" custom-id)) + (push (list link desc) org-stored-links))))))) (defun org-store-link-props (&rest plist) "Store link properties, extract names and addresses." @@ -9017,24 +9625,16 @@ according to FMT (default from `org-email-link-description-format')." (setq fmt (replace-match "from %f" t t fmt)))) (org-replace-escapes fmt table))) -(defun org-make-org-heading-search-string (&optional string heading) - "Make search string for STRING or current headline." - (interactive) - (let ((s (or string (org-get-heading))) +(defun org-make-org-heading-search-string (&optional string) + "Make search string for the current headline or STRING." + (let ((s (or string + (and (derived-mode-p 'org-mode) + (save-excursion + (org-back-to-heading t) + (org-element-property :raw-value (org-element-at-point)))))) (lines org-context-in-file-links)) - (unless (and string (not heading)) - ;; We are using a headline, clean up garbage in there. - (if (string-match org-todo-regexp s) - (setq s (replace-match "" t t s))) - (if (string-match (org-re ":[[:alnum:]_@#%:]+:[ \t]*$") s) - (setq s (replace-match "" t t s))) - (setq s (org-trim s)) - (if (string-match (concat "^\\(" org-quote-string "\\|" - org-comment-string "\\)") s) - (setq s (replace-match "" t t s))) - (while (string-match org-ts-regexp s) - (setq s (replace-match "" t t s)))) (or string (setq s (concat "*" s))) ; Add * for headlines + (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s)) (when (and string (integerp lines) (> lines 0)) (let ((slines (org-split-string s "\n"))) (when (< lines (length slines)) @@ -9204,7 +9804,7 @@ This command can be called in any mode to insert a link in Org-mode syntax." (let ((links (copy-sequence org-stored-links)) l) (while (setq l (if keep (pop links) (pop org-stored-links))) (insert "- ") - (org-insert-link nil (car l) (cadr l)) + (org-insert-link nil (car l) (or (cadr l) "")) (insert "\n")))) (defun org-link-fontify-links-to-this-file () @@ -9272,6 +9872,7 @@ If the DEFAULT-DESCRIPTION parameter is non-nil, this value will be used as the default description." (interactive "P") (let* ((wcf (current-window-configuration)) + (origbuf (current-buffer)) (region (if (org-region-active-p) (buffer-substring (region-beginning) (region-end)))) (remove (and region (list (region-beginning) (region-end)))) @@ -9326,20 +9927,17 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (unwind-protect (progn (setq link - (let ((org-completion-use-ido nil) - (org-completion-use-iswitchb nil)) - (org-completing-read - "Link: " - (append - (mapcar (lambda (x) (list (concat x ":"))) - all-prefixes) - (mapcar 'car org-stored-links) - (mapcar 'cadr org-stored-links)) - nil nil nil - 'tmphist - (caar org-stored-links)))) + (org-completing-read + "Link: " + (append + (mapcar (lambda (x) (concat x ":")) + all-prefixes) + (mapcar 'car org-stored-links)) + nil nil nil + 'tmphist + (caar org-stored-links))) (if (not (string-match "\\S-" link)) - (error "No link selected")) + (user-error "No link selected")) (mapc (lambda(l) (when (equal link (cadr l)) (setq link (car l) auto-desc t))) org-stored-links) @@ -9347,7 +9945,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (and (equal ":" (substring link -1)) (member (substring link 0 -1) all-prefixes) (setq link (substring link 0 -1)))) - (setq link (org-link-try-special-completion link)))) + (setq link (with-current-buffer origbuf + (org-link-try-special-completion link))))) (set-window-configuration wcf) (kill-buffer "*Org Links*")) (setq entry (assoc link org-stored-links)) @@ -9431,7 +10030,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (defun org-file-complete-link (&optional arg) "Create a file link using completion." (let (file link) - (setq file (read-file-name "File: ")) + (setq file (org-iread-file-name "File: ")) (let ((pwd (file-name-as-directory (expand-file-name "."))) (pwd1 (file-name-as-directory (abbreviate-file-name (expand-file-name "."))))) @@ -9449,6 +10048,19 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (t (setq link (concat "file:" file))))) link)) +(defun org-iread-file-name (&rest args) + "Read-file-name using `ido-mode' speedup if available. +ARGS are arguments that may be passed to `ido-read-file-name' or `read-file-name'. +See `read-file-name' for a description of parameters." + (org-without-partial-completion + (if (and org-completion-use-ido + (fboundp 'ido-read-file-name) + (boundp 'ido-mode) ido-mode + (listp (second args))) + (let ((ido-enter-matching-directory nil)) + (apply 'ido-read-file-name args)) + (apply 'read-file-name args)))) + (defun org-completing-read (&rest args) "Completing-read with SPACE being a normal character." (let ((enable-recursive-minibuffers t) @@ -9509,23 +10121,6 @@ from." (org-add-props s nil 'org-attr attr)) s)) -(defun org-extract-attributes-from-string (tag) - (let (key value attr) - (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"\\s-?" tag) - (setq key (match-string 1 tag) value (match-string 2 tag) - tag (replace-match "" t t tag) - attr (plist-put attr (intern key) value))) - (cons tag attr))) - -(defun org-attributes-to-string (plist) - "Format a property list into an HTML attribute list." - (let ((s "") key value) - (while plist - (setq key (pop plist) value (pop plist)) - (and value - (setq s (concat s " " (symbol-name key) "=\"" value "\"")))) - s)) - ;;; Opening/following a link (defvar org-link-search-failed nil) @@ -9547,45 +10142,35 @@ If it decides that it is not responsible for this link, it must return nil to indicate that that Org-mode can continue with other options like exact and fuzzy text search.") -(defun org-next-link () +(defun org-next-link (&optional search-backward) "Move forward to the next link. If the link is in hidden text, expose it." - (interactive) + (interactive "P") (when (and org-link-search-failed (eq this-command last-command)) (goto-char (point-min)) (message "Link search wrapped back to beginning of buffer")) (setq org-link-search-failed nil) (let* ((pos (point)) (ct (org-context)) - (a (assoc :link ct))) - (if a (goto-char (nth 2 a))) - (if (re-search-forward org-any-link-re nil t) + (a (assoc :link ct)) + (srch-fun (if search-backward 're-search-backward 're-search-forward))) + (cond (a (goto-char (nth (if search-backward 1 2) a))) + ((looking-at org-any-link-re) + ;; Don't stay stuck at link without an org-link face + (forward-char (if search-backward -1 1)))) + (if (funcall srch-fun org-any-link-re nil t) (progn (goto-char (match-beginning 0)) (if (outline-invisible-p) (org-show-context))) (goto-char pos) (setq org-link-search-failed t) - (error "No further link found")))) + (message "No further link found")))) (defun org-previous-link () "Move backward to the previous link. If the link is in hidden text, expose it." (interactive) - (when (and org-link-search-failed (eq this-command last-command)) - (goto-char (point-max)) - (message "Link search wrapped back to end of buffer")) - (setq org-link-search-failed nil) - (let* ((pos (point)) - (ct (org-context)) - (a (assoc :link ct))) - (if a (goto-char (nth 1 a))) - (if (re-search-backward org-any-link-re nil t) - (progn - (goto-char (match-beginning 0)) - (if (outline-invisible-p) (org-show-context))) - (goto-char pos) - (setq org-link-search-failed t) - (error "No further link found")))) + (funcall 'org-next-link t)) (defun org-translate-link (s) "Translate a link string if a translation function has been defined." @@ -9616,8 +10201,7 @@ This is still an experimental function, your mileage may vary." ;; A typical message link. Planner has the id after the final slash, ;; we separate it with a hash mark (setq path (concat (match-string 1 path) "#" - (org-remove-angle-brackets (match-string 2 path))))) - ) + (org-remove-angle-brackets (match-string 2 path)))))) (cons type path)) (defun org-find-file-at-mouse (ev) @@ -9745,17 +10329,28 @@ application the system uses for this file type." (or (previous-single-property-change pos 'org-linked-text) (point-min)) (or (next-single-property-change pos 'org-linked-text) - (point-max)))) + (point-max))) + ;; Ensure we will search for a <<>> link, not + ;; a simple reference like <> + path (concat "<" path)) (throw 'match t)) (save-excursion - (let ((plinkpos (org-in-regexp org-plain-link-re))) - (when (or (org-in-regexp org-angle-link-re) - (and plinkpos (goto-char (car plinkpos)) - (save-match-data (not (looking-back "\\[\\["))))) - (setq type (match-string 1) - path (org-link-unescape (match-string 2))) - (throw 'match t)))) + (when (or (org-in-regexp org-angle-link-re) + (let ((match (org-in-regexp org-plain-link-re))) + ;; Check a plain link is not within a bracket link + (and match + (save-excursion + (progn + (goto-char (car match)) + (not (org-in-regexp org-bracket-link-regexp)))))) + (let ((line_ending (save-excursion (end-of-line) (point)))) + ;; We are in a line before a plain or bracket link + (or (re-search-forward org-plain-link-re line_ending t) + (re-search-forward org-bracket-link-regexp line_ending t)))) + (setq type (match-string 1) + path (org-link-unescape (match-string 2))) + (throw 'match t))) (save-excursion (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) (setq type "tags" @@ -9960,7 +10555,7 @@ there is one, return it." (setq nth (- c ?0)) (if have-zero (setq nth (1+ nth))) (unless (and (integerp nth) (>= (length links) nth)) - (error "Invalid link selection")) + (user-error "Invalid link selection")) (setq link (nth (1- nth) links))))) (cons link end)))))) @@ -9974,15 +10569,7 @@ there is one, return it." (defun org-open-file-with-emacs (path) "Open file at PATH in Emacs." (org-open-file path 'emacs)) -(defun org-remove-file-link-modifiers () - "Remove the file link modifiers in `file+sys:' and `file+emacs:' links." - (goto-char (point-min)) - (while (re-search-forward "\\>\\)") re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+") "\\)" markers) - re2a_ (concat "\\(" (mapconcat 'downcase words "[ \t\r\n]+") "\\)[ \t\r\n]") + re2a_ (concat "\\(" (mapconcat 'downcase words + "[ \t\r\n]+") "\\)[ \t\r\n]") re2a (concat "[ \t\r\n]" re2a_) - re4_ (concat "\\(" (mapconcat 'downcase words "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") + re4_ (concat "\\(" (mapconcat 'downcase words + "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") re4 (concat "[^a-zA-Z_]" re4_) re1 (concat pre re2 post) @@ -10164,21 +10744,20 @@ visibility around point, thus ignoring re4 (concat pre (if pre re4_ re4)) reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" - re5 "\\)" - )) + re5 "\\)")) (cond ((eq type 'org-occur) (org-occur reall)) ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) (t (goto-char (point-min)) (setq type 'fuzzy) - (if (or (and (org-search-not-self 1 re0 nil t) (setq type 'dedicated)) + (if (or (and (org-search-not-self 1 re0 nil t) + (setq type 'dedicated)) (org-search-not-self 1 re1 nil t) (org-search-not-self 1 re2 nil t) (org-search-not-self 1 re2a nil t) (org-search-not-self 1 re3 nil t) (org-search-not-self 1 re4 nil t) - (org-search-not-self 1 re5 nil t) - ) + (org-search-not-self 1 re5 nil t)) (goto-char (match-beginning 1)) (goto-char pos) (error "No match")))))) @@ -10418,7 +10997,7 @@ If the file does not exist, an error is thrown." (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files (not (file-exists-p file)) (not org-open-non-existing-files)) - (error "No such file: %s" file)) + (user-error "No such file: %s" file)) (cond ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) ;; Remove quotes around the file name - we'll use shell-quote-argument. @@ -10444,9 +11023,9 @@ If the file does not exist, an error is thrown." (setq match-index (+ match-index 1))))) (save-window-excursion + (message "Running %s...done" cmd) (start-process-shell-command cmd nil cmd) - (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)) - )) + (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))) ((or (stringp cmd) (eq cmd 'emacs)) (funcall (cdr (assq 'file org-link-frame-setup)) file) @@ -10583,9 +11162,10 @@ on the system \"/user@host:\"." (let (marker) (catch 'exit (while (and set (setq marker (nth 3 (pop set)))) - ;; if org-refile-use-outline-path is 'file, marker may be nil + ;; If `org-refile-use-outline-path' is 'file, marker may be nil (when (and marker (null (marker-buffer marker))) - (message "not found") (sit-for 3) + (message "Please regenerate the refile cache with `C-0 C-c C-w'") + (sit-for 3) (throw 'exit nil))) t))) @@ -10703,8 +11283,7 @@ on the system \"/user@host:\"." (goto-char (point-at-eol)))))))) (when org-refile-use-cache (org-refile-cache-put tgs (buffer-file-name) descre)) - (setq targets (append tgs targets)) - )))) + (setq targets (append tgs targets)))))) (message "Getting targets...done") (nreverse targets))) @@ -10739,11 +11318,13 @@ avoiding backtracing. Refile target collection makes use of that." (push (org-match-string-no-properties 4) rtn))) rtn))))) -(defun org-format-outline-path (path &optional width prefix) +(defun org-format-outline-path (path &optional width prefix separator) "Format the outline path PATH for display. -Width is the maximum number of characters that is available. -Prefix is a prefix to be included in the returned string, -such as the file name." +WIDTH is the maximum number of characters that is available. +PREFIX is a prefix to be included in the returned string, +such as the file name. +SEPARATOR is inserted between the different parts of the path, +the default is \"/\"." (setq width (or width 79)) (if prefix (setq width (- width (length prefix)))) (if (not path) @@ -10759,6 +11340,7 @@ such as the file name." (total (1+ (length prefix)))) (setq maxwidth (max maxwidth 10)) (concat prefix + (if prefix (or separator "/")) (mapconcat (lambda (h) (setq n (1+ n)) @@ -10775,24 +11357,36 @@ such as the file name." (nth (% (1- n) org-n-level-faces) org-level-faces)) h) - path "/"))))) + path (or separator "/")))))) -(defun org-display-outline-path (&optional file current) - "Display the current outline path in the echo area." +(defun org-display-outline-path (&optional file current separator just-return-string) + "Display the current outline path in the echo area. + +If FILE is non-nil, prepend the output with the file name. +If CURRENT is non-nil, append the current heading to the output. +SEPARATOR is passed through to `org-format-outline-path'. It separates +the different parts of the path and defaults to \"/\". +If JUST-RETURN-STRING is non-nil, return a string, don't display a message." (interactive "P") - (let* ((bfn (buffer-file-name (buffer-base-buffer))) - (case-fold-search nil) - (path (and (derived-mode-p 'org-mode) (org-get-outline-path)))) + (let* (case-fold-search + message-log-max ; Don't populate the *Messages* buffer + (bfn (buffer-file-name (buffer-base-buffer))) + (path (and (derived-mode-p 'org-mode) (org-get-outline-path))) + res) (if current (setq path (append path (save-excursion (org-back-to-heading t) (if (looking-at org-complex-heading-regexp) (list (match-string 4))))))) - (message "%s" - (org-format-outline-path - path - (1- (frame-width)) - (and file bfn (concat (file-name-nondirectory bfn) "/")))))) + (setq res + (org-format-outline-path + path + (1- (frame-width)) + (and file bfn (concat (file-name-nondirectory bfn) separator)) + separator)) + (if just-return-string + (org-no-properties res) + (message "%s" res)))) (defvar org-refile-history nil "History for refiling operations.") @@ -10803,7 +11397,16 @@ Note that this is still *before* the stuff will be removed from the *old* location.") (defvar org-capture-last-stored-marker) -(defun org-refile (&optional goto default-buffer rfloc) +(defvar org-refile-keep nil + "Non-nil means `org-refile' will copy instead of refile.") + +(defun org-copy () + "Like `org-refile', but copy." + (interactive) + (let ((org-refile-keep t)) + (funcall 'org-refile nil nil nil "Copy"))) + +(defun org-refile (&optional goto default-buffer rfloc msg) "Move the entry or entries at point to another heading. The list of target headings is compiled using the information in `org-refile-targets', which see. @@ -10826,6 +11429,9 @@ With a prefix argument of `2', refile to the running clock. RFLOC can be a refile location obtained in a different way. +MSG is a string to replace \"Refile\" in the default prompt with +another verb. E.g. `org-copy' sets this parameter to \"Copy\". + See also `org-refile-use-outline-path' and `org-completion-use-ido'. If you are using target caching (see `org-refile-use-cache'), @@ -10836,7 +11442,8 @@ prefix argument (`C-u C-u C-u C-c C-w')." (interactive "P") (if (member goto '(0 (64))) (org-refile-cache-clear) - (let* ((cbuf (current-buffer)) + (let* ((actionmsg (or msg "Refile")) + (cbuf (current-buffer)) (regionp (org-region-active-p)) (region-start (and regionp (region-beginning))) (region-end (and regionp (region-end))) @@ -10852,7 +11459,7 @@ prefix argument (`C-u C-u C-u C-c C-w')." (buffer-substring region-start region-end)) (prog1 org-refile-active-region-within-subtree (org-toggle-heading))) - (error "The region is not a (sequence of) subtree(s)"))) + (user-error "The region is not a (sequence of) subtree(s)"))) (if (equal goto '(16)) (org-refile-goto-last-stored) (when (or @@ -10872,10 +11479,11 @@ prefix argument (`C-u C-u C-u C-c C-w')." (org-back-to-heading t) (setq heading-text (nth 4 (org-heading-components)))) + (org-refile-get-location (cond (goto "Goto") - (regionp "Refile region to") - (t (concat "Refile subtree \"" + (regionp (concat actionmsg " region to")) + (t (concat actionmsg " subtree \"" heading-text "\" to"))) default-buffer (and (not (equal '(4) goto)) @@ -10949,13 +11557,14 @@ prefix argument (`C-u C-u C-u C-c C-w')." (move-marker org-capture-last-stored-marker (point))) (if (fboundp 'deactivate-mark) (deactivate-mark)) (run-hooks 'org-after-refile-insert-hook)))) - (if regionp - (delete-region (point) (+ (point) region-length)) - (org-cut-subtree)) + (unless org-refile-keep + (if regionp + (delete-region (point) (+ (point) region-length)) + (org-cut-subtree))) (when (featurep 'org-inlinetask) (org-inlinetask-remove-END-maybe)) (setq org-markers-to-move nil) - (message "Refiled to \"%s\" in file %s" (car it) file))))))) + (message (concat actionmsg " to \"%s\" in file %s: done") (car it) file))))))) (defun org-refile-goto-last-stored () "Go to the location where the last refile was stored." @@ -10984,12 +11593,8 @@ this is used for the GOTO interface." (setq org-refile-target-table (org-refile-get-targets default-buffer excluded-entries))) (unless org-refile-target-table - (error "No refile targets")) - (let* ((prompt (concat prompt - (and (car org-refile-history) - (concat " (default " (car org-refile-history) ")")) - ": ")) - (cbuf (current-buffer)) + (user-error "No refile targets")) + (let* ((cbuf (current-buffer)) (partial-completion-mode nil) (cfn (buffer-file-name (buffer-base-buffer cbuf))) (cfunc (if (and org-refile-use-outline-path @@ -10997,6 +11602,7 @@ this is used for the GOTO interface." 'org-olpath-completing-read 'org-icompleting-read)) (extra (if org-refile-use-outline-path "/" "")) + (cbnex (concat (buffer-name) extra)) (filename (and cfn (expand-file-name cfn))) (tbl (mapcar (lambda (x) @@ -11009,10 +11615,16 @@ this is used for the GOTO interface." (cons (concat (car x) extra) (cdr x)))) org-refile-target-table)) (completion-ignore-case t) + cdef + (prompt (concat prompt + (or (and (car org-refile-history) + (concat " (default " (car org-refile-history) ")")) + (and (assoc cbnex tbl) (setq cdef cbnex) + (concat " (default " cbnex ")"))) ": ")) pa answ parent-target child parent old-hist) (setq old-hist org-refile-history) (setq answ (funcall cfunc prompt tbl nil (not new-nodes) - nil 'org-refile-history (car org-refile-history))) + nil 'org-refile-history (or cdef (car org-refile-history)))) (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl))) (org-refile-check-position pa) (if pa @@ -11039,7 +11651,7 @@ this is used for the GOTO interface." (y-or-n-p (format "Create new node \"%s\"? " child))))) (org-refile-new-child parent-target child))) - (error "Invalid target location"))))) + (user-error "Invalid target location"))))) (declare-function org-string-nw-p "org-macs" (s)) (defun org-refile-check-position (refile-pointer) @@ -11049,7 +11661,7 @@ this is used for the GOTO interface." (pos (nth 3 refile-pointer)) buffer) (if (and (not (markerp pos)) (not file)) - (error "Please save the buffer to a file before refiling") + (user-error "Please save the buffer to a file before refiling") (when (org-string-nw-p re) (setq buffer (if (markerp pos) (marker-buffer pos) @@ -11062,7 +11674,7 @@ this is used for the GOTO interface." (goto-char pos) (beginning-of-line 1) (unless (org-looking-at-p re) - (error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))) + (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))) (defun org-refile-new-child (parent-target child) "Use refile target PARENT-TARGET to add new CHILD below it." @@ -11163,7 +11775,7 @@ PLIST must contain a :name entry which is used as name of the block." This empties the block, puts the cursor at the insert position and returns the property list including an extra property :name with the block name." (unless (looking-at org-dblock-start-re) - (error "Not at a dynamic block")) + (user-error "Not at a dynamic block")) (let* ((begdel (1+ (match-end 0))) (name (org-no-properties (match-string 1))) (params (append (list :name name) @@ -11262,49 +11874,29 @@ This function can be used in a hook." ;;;; Completion -(defconst org-additional-option-like-keywords - '("BEGIN_HTML" "END_HTML" "HTML:" "ATTR_HTML:" - "BEGIN_DocBook" "END_DocBook" "DocBook:" "ATTR_DocBook:" - "BEGIN_LaTeX" "END_LaTeX" "LaTeX:" "LATEX_HEADER:" - "LATEX_CLASS:" "LATEX_CLASS_OPTIONS:" "ATTR_LaTeX:" - "BEGIN:" "END:" - "ORGTBL" "TBLFM:" "TBLNAME:" - "BEGIN_EXAMPLE" "END_EXAMPLE" - "BEGIN_VERBATIM" "END_VERBATIM" - "BEGIN_QUOTE" "END_QUOTE" - "BEGIN_VERSE" "END_VERSE" - "BEGIN_CENTER" "END_CENTER" - "BEGIN_SRC" "END_SRC" - "BEGIN_RESULT" "END_RESULT" - "BEGIN_lstlisting" "END_lstlisting" - "NAME:" "RESULTS:" - "HEADER:" "HEADERS:" - "COLUMNS:" "PROPERTY:" - "CAPTION:" "LABEL:" - "SETUPFILE:" - "INCLUDE:" "INDEX:" - "BIND:" - "MACRO:")) +(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))) (defconst org-options-keywords - '("TITLE:" "AUTHOR:" "EMAIL:" "DATE:" - "DESCRIPTION:" "KEYWORDS:" "LANGUAGE:" "OPTIONS:" - "EXPORT_SELECT_TAGS:" "EXPORT_EXCLUDE_TAGS:" - "LINK_UP:" "LINK_HOME:" "LINK:" "TODO:" - "XSLT:" "MATHJAX:" "CATEGORY:" "SEQ_TODO:" "TYP_TODO:" - "PRIORITIES:" "DRAWERS:" "STARTUP:" "TAGS:" "STYLE:" - "FILETAGS:" "ARCHIVE:" "INFOJS_OPT:")) - -(defconst org-additional-option-like-keywords-for-flyspell - (delete-dups - (split-string - (mapconcat (lambda(k) - (replace-regexp-in-string - "_\\|:" " " - (concat k " " (downcase k) " " (upcase k)))) - (append org-options-keywords org-additional-option-like-keywords) - " ") - " +" t))) + '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:" + "DESCRIPTION:" "DRAWERS:" "EMAIL:" "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:" + "INDEX:" "KEYWORDS:" "LANGUAGE:" "MACRO:" "OPTIONS:" "PROPERTY:" + "PRIORITIES:" "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:" + "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:")) (defcustom org-structure-template-alist '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC" @@ -11431,10 +12023,12 @@ nil or a string to be used for the todo mark." ) (let* ((ct (org-current-time)) (dct (decode-time ct)) (ct1 - (if (and org-use-effective-time - (< (nth 2 dct) org-extend-today-until)) - (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) - ct))) + (cond + (org-use-last-clock-out-time-as-effective-time + (or (org-clock-get-last-clock-out-time) ct)) + ((and org-use-effective-time (< (nth 2 dct) org-extend-today-until)) + (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))) + (t ct)))) ct1)) (defun org-todo-yesterday (&optional arg) @@ -11447,6 +12041,9 @@ nil or a string to be used for the todo mark." ) (org-extend-today-until (1+ hour))) (org-todo arg)))) +(defvar org-block-entry-blocking "" + "First entry preventing the TODO state change.") + (defun org-todo (&optional arg) "Change the TODO state of an item. The state of an item is given by a keyword at the start of the heading, @@ -11538,8 +12135,7 @@ For calling through lisp, arg is also interpreted in the following way: (not org-todo-key-trigger))) ;; Read a state with completion (org-icompleting-read - "State: " (mapcar (lambda(x) (list x)) - org-todo-keywords-1) + "State: " (mapcar 'list org-todo-keywords-1) nil t)) ((eq arg 'right) (if this @@ -11570,7 +12166,7 @@ For calling through lisp, arg is also interpreted in the following way: (car org-todo-heads)))) ((car (member arg org-todo-keywords-1))) ((stringp arg) - (error "State `%s' not valid in this file" arg)) + (user-error "State `%s' not valid in this file" arg)) ((nth (1- (prefix-numeric-value arg)) org-todo-keywords-1)))) ((null member) (or head (car org-todo-keywords-1))) @@ -11601,9 +12197,11 @@ For calling through lisp, arg is also interpreted in the following way: (run-hook-with-args-until-failure 'org-blocker-hook change-plist)))) (if (org-called-interactively-p 'interactive) - (error "TODO state change from %s to %s blocked" this org-state) + (user-error "TODO state change from %s to %s blocked (by \"%s\")" + this org-state org-block-entry-blocking) ;; fail silently - (message "TODO state change from %s to %s blocked" this org-state) + (message "TODO state change from %s to %s blocked (by \"%s\")" + this org-state org-block-entry-blocking) (throw 'exit nil)))) (store-match-data match-data) (replace-match next t t) @@ -11634,9 +12232,10 @@ For calling through lisp, arg is also interpreted in the following way: (nth 2 (assoc this org-todo-log-states)))) (if (and (eq dolog 'note) (eq org-inhibit-logging 'note)) (setq dolog 'time)) - (when (and org-state - (member org-state org-not-done-keywords) - (not (member this org-not-done-keywords))) + (when (or (and (not org-state) (not org-closed-keep-when-no-todo)) + (and org-state + (member org-state org-not-done-keywords) + (not (member this org-not-done-keywords)))) ;; This is now a todo state and was not one before ;; If there was a CLOSED time stamp, get rid of it. (org-add-planning-info nil nil 'closed)) @@ -11717,7 +12316,8 @@ changes. Such blocking occurs when: ;; completed (if (and (not (org-entry-is-done-p)) (org-entry-is-todo-p)) - (throw 'dont-block nil)) + (progn (setq org-block-entry-blocking (org-get-heading)) + (throw 'dont-block nil))) (outline-next-heading) (setq child-level (funcall outline-level)))))) ;; Otherwise, if the task's parent has the :ORDERED: property, and @@ -11730,6 +12330,7 @@ changes. Such blocking occurs when: (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) (re-search-forward org-not-done-heading-regexp pos t)) + (setq org-block-entry-blocking (match-string 0)) (throw 'dont-block nil)) ; block, there is an older sibling not done. ;; Search further up the hierarchy, to see if an ancestor is blocked (while t @@ -11741,7 +12342,8 @@ changes. Such blocking occurs when: (if (not parent-pos) (throw 'dont-block t)) ; no parent (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) - (re-search-forward org-not-done-heading-regexp pos t)) + (re-search-forward org-not-done-heading-regexp pos t) + (setq org-block-entry-blocking (org-get-heading))) (throw 'dont-block nil)))))))) ; block, older sibling not done. (defcustom org-track-ordered-property-with-tag nil @@ -11774,7 +12376,7 @@ See variable `org-track-ordered-property-with-tag'." (org-back-to-heading) (if (org-entry-get nil "ORDERED") (progn - (org-delete-property "ORDERED") + (org-delete-property "ORDERED" "PROPERTIES") (and tag (org-toggle-tag tag 'off)) (message "Subtasks can be completed in arbitrary order")) (org-entry-put nil "ORDERED" "t") @@ -11818,16 +12420,15 @@ changes because there are unchecked boxes in this entry." (defun org-entry-blocked-p () "Is the current entry blocked?" - (org-with-buffer-modified-unmodified + (org-with-silent-modifications (if (org-entry-get nil "NOBLOCKING") nil ;; Never block this entry - (not - (run-hook-with-args-until-failure - 'org-blocker-hook - (list :type 'todo-state-change - :position (point) - :from 'todo - :to 'done)))))) + (not (run-hook-with-args-until-failure + 'org-blocker-hook + (list :type 'todo-state-change + :position (point) + :from 'todo + :to 'done)))))) (defun org-update-statistics-cookies (all) "Update the statistics cookie, either from TODO or from checkboxes. @@ -12090,6 +12691,7 @@ Returns the new TODO keyword, or nil if no state change should occur." (member (org-get-todo-state) org-done-keywords)) (defun org-get-todo-state () + "Return the TODO keyword of the current subtree." (save-excursion (org-back-to-heading t) (and (looking-at org-todo-line-regexp) @@ -12182,7 +12784,7 @@ This function is run automatically after each state change to a DONE state." what (match-string 3 ts)) (if (equal what "w") (setq n (* n 7) what "d")) (if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))) - (error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n)) + (user-error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n)) ;; Preparation, see if we need to modify the start date for the change (when (match-end 1) (setq time (save-match-data (org-time-string-to-time ts))) @@ -12209,7 +12811,7 @@ This function is run automatically after each state change to a DONE state." (org-at-timestamp-p t) (setq ts (match-string 1)) (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)))) - (org-timestamp-change n (cdr (assoc what whata))) + (save-excursion (org-timestamp-change n (cdr (assoc what whata)) nil t)) (setq msg (concat msg type " " org-last-changed-timestamp " ")))) (setq org-log-post-message msg) (message "%s" msg)))) @@ -12234,13 +12836,14 @@ of `org-todo-keywords-1'." ((<= (prefix-numeric-value arg) (length org-todo-keywords-1)) (regexp-quote (nth (1- (prefix-numeric-value arg)) org-todo-keywords-1))) - (t (error "Invalid prefix argument: %s" arg))))) + (t (user-error "Invalid prefix argument: %s" arg))))) (message "%d TODO entries found" (org-occur (concat "^" org-outline-regexp " *" kwd-re ))))) -(defun org-deadline (&optional remove time) +(defun org-deadline (arg &optional time) "Insert the \"DEADLINE:\" string with a timestamp to make a deadline. -With argument REMOVE, remove any deadline from the item. +With one universal prefix argument, remove any deadline from the item. +With two universal prefix arguments, prompt for a warning delay. With argument TIME, set the deadline at the corresponding date. TIME can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (interactive "P") @@ -12249,22 +12852,42 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." 'region-start-level 'region)) org-loop-over-headlines-in-active-region) (org-map-entries - `(org-deadline ',remove ,time) + `(org-deadline ',arg ,time) org-loop-over-headlines-in-active-region cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) (let* ((old-date (org-entry-get nil "DEADLINE")) + (old-date-time (if old-date (org-time-string-to-time old-date))) (repeater (and old-date (string-match "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" old-date) (match-string 1 old-date)))) - (if remove - (progn - (when (and old-date org-log-redeadline) - (org-add-log-setup 'deldeadline nil old-date 'findpos - org-log-redeadline)) - (org-remove-timestamp-with-keyword org-deadline-string) - (message "Item no longer has a deadline.")) + (cond + ((equal arg '(4)) + (when (and old-date org-log-redeadline) + (org-add-log-setup 'deldeadline nil old-date 'findpos + org-log-redeadline)) + (org-remove-timestamp-with-keyword org-deadline-string) + (message "Item no longer has a deadline.")) + ((equal arg '(16)) + (save-excursion + (if (re-search-forward + org-deadline-time-regexp + (save-excursion (outline-next-heading) (point)) t) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) + (replace-match + (concat org-deadline-string + " <" rpl + (format " -%dd" + (abs + (- (time-to-days + (save-match-data + (org-read-date nil t nil "Warn starting from" old-date-time))) + (time-to-days old-date-time)))) + ">") t t)) + (user-error "No deadline information to update")))) + (t (org-add-planning-info 'deadline time 'closed) (when (and old-date org-log-redeadline (not (equal old-date @@ -12284,11 +12907,12 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (concat (substring org-last-inserted-timestamp 0 -1) " " repeater (substring org-last-inserted-timestamp -1)))))) - (message "Deadline on %s" org-last-inserted-timestamp))))) + (message "Deadline on %s" org-last-inserted-timestamp)))))) -(defun org-schedule (&optional remove time) +(defun org-schedule (arg &optional time) "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. -With argument REMOVE, remove any scheduling date from the item. +With one universal prefix argument, remove any scheduling date from the item. +With two universal prefix arguments, prompt for a delay cookie. With argument TIME, scheduled at the corresponding date. TIME can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (interactive "P") @@ -12297,22 +12921,43 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." 'region-start-level 'region)) org-loop-over-headlines-in-active-region) (org-map-entries - `(org-schedule ',remove ,time) + `(org-schedule ',arg ,time) org-loop-over-headlines-in-active-region cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) (let* ((old-date (org-entry-get nil "SCHEDULED")) + (old-date-time (if old-date (org-time-string-to-time old-date))) (repeater (and old-date (string-match "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" old-date) (match-string 1 old-date)))) - (if remove - (progn - (when (and old-date org-log-reschedule) - (org-add-log-setup 'delschedule nil old-date 'findpos - org-log-reschedule)) - (org-remove-timestamp-with-keyword org-scheduled-string) - (message "Item is no longer scheduled.")) + (cond + ((equal arg '(4)) + (progn + (when (and old-date org-log-reschedule) + (org-add-log-setup 'delschedule nil old-date 'findpos + org-log-reschedule)) + (org-remove-timestamp-with-keyword org-scheduled-string) + (message "Item is no longer scheduled."))) + ((equal arg '(16)) + (save-excursion + (if (re-search-forward + org-scheduled-time-regexp + (save-excursion (outline-next-heading) (point)) t) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) + (replace-match + (concat org-scheduled-string + " <" rpl + (format " -%dd" + (abs + (- (time-to-days + (save-match-data + (org-read-date nil t nil "Delay until" old-date-time))) + (time-to-days old-date-time)))) + ">") t t)) + (user-error "No scheduled information to update")))) + (t (org-add-planning-info 'scheduled time 'closed) (when (and old-date org-log-reschedule (not (equal old-date @@ -12332,7 +12977,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (concat (substring org-last-inserted-timestamp 0 -1) " " repeater (substring org-last-inserted-timestamp -1)))))) - (message "Scheduled to %s" org-last-inserted-timestamp))))) + (message "Scheduled to %s" org-last-inserted-timestamp)))))) (defun org-get-scheduled-time (pom &optional inherit) "Get the scheduled time as a time tuple, of a format suitable @@ -12580,7 +13225,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (org-switch-to-buffer-other-window "*Org Note*") (erase-buffer) (if (memq org-log-note-how '(time state)) - (let (current-prefix-arg) (org-store-log-note)) + (let (current-prefix-arg) (org-store-log-note)) (let ((org-inhibit-startup t)) (org-mode)) (insert (format "# Insert note for %s. # Finish with C-c C-c, or cancel with C-c C-k.\n\n" @@ -12611,10 +13256,10 @@ EXTRA is additional text that will be inserted into the notes buffer." (defvar org-note-abort nil) ; dynamically scoped (defun org-store-log-note () "Finish taking a log note, and insert it to where it belongs." - (let ((txt (buffer-string)) - (note (cdr (assq org-log-note-purpose org-log-note-headings))) - lines ind bul) + (let ((txt (buffer-string))) (kill-buffer (current-buffer)) + (let ((note (cdr (assq org-log-note-purpose org-log-note-headings))) + lines ind bul) (while (string-match "\\`# .*\n[ \t\n]*" txt) (setq txt (replace-match "" t t txt))) (if (string-match "\\s-+\\'" txt) @@ -12681,12 +13326,19 @@ EXTRA is additional text that will be inserted into the notes buffer." (insert (pop lines)))) (message "Note stored") (org-back-to-heading t) - (org-cycle-hide-drawers 'children))))) - (set-window-configuration org-log-note-window-configuration) - (with-current-buffer (marker-buffer org-log-note-return-to) - (goto-char org-log-note-return-to)) - (move-marker org-log-note-return-to nil) - (and org-log-post-message (message "%s" org-log-post-message))) + (org-cycle-hide-drawers 'children)) + ;; Fix `buffer-undo-list' when `org-store-log-note' is called + ;; from within `org-add-log-note' because `buffer-undo-list' + ;; is then modified outside of `org-with-remote-undo'. + (when (eq this-command 'org-agenda-todo) + (setcdr buffer-undo-list (cddr buffer-undo-list))))))) + ;; Don't add undo information when called from `org-agenda-todo' + (let ((buffer-undo-list (eq this-command 'org-agenda-todo))) + (set-window-configuration org-log-note-window-configuration) + (with-current-buffer (marker-buffer org-log-note-return-to) + (goto-char org-log-note-return-to)) + (move-marker org-log-note-return-to nil) + (and org-log-post-message (message "%s" org-log-post-message)))) (defun org-remove-empty-drawer-at (drawer pos) "Remove an empty drawer DRAWER at position POS. @@ -12727,11 +13379,14 @@ D Show deadlines and scheduled items between a date range." ((eq type 'active) "only active timestamps") ((eq type 'inactive) "only inactive timestamps") ((eq type 'scheduled-or-deadline) "scheduled/deadline") + ((eq type 'closed) "with a closed time-stamp") (t "scheduled/deadline"))) (setq ans (read-char-exclusive)) (cond ((equal ans ?c) - (org-sparse-tree arg (cadr (member type '(scheduled-or-deadline all scheduled deadline active inactive))))) + (org-sparse-tree + arg (cadr (member type '(scheduled-or-deadline + all scheduled deadline active inactive closed))))) ((equal ans ?d) (call-interactively 'org-check-deadlines)) ((equal ans ?b) @@ -12756,7 +13411,7 @@ D Show deadlines and scheduled items between a date range." (org-match-sparse-tree arg (concat kwd "=" value))) ((member ans '(?r ?R ?/)) (call-interactively 'org-occur)) - (t (error "No such sparse tree command \"%c\"" ans))))) + (t (user-error "No such sparse tree command \"%c\"" ans))))) (defvar org-occur-highlights nil "List of overlays used for occur matches.") @@ -12785,7 +13440,7 @@ If CALLBACK is non-nil, it is a function which is called to confirm that the match should indeed be shown." (interactive "sRegexp: \nP") (when (equal regexp "") - (error "Regexp cannot be empty")) + (user-error "Regexp cannot be empty")) (unless keep-previous (org-remove-occur-highlights nil nil t)) (push (cons regexp callback) org-occur-parameters) @@ -12869,7 +13524,7 @@ How much context is shown depends upon the variables (not (bobp))) (org-flag-heading nil) (when siblings-p (org-show-siblings))))) - (org-fix-ellipsis-at-bol))) + (unless (eq key 'agenda) (org-fix-ellipsis-at-bol)))) (defvar org-reveal-start-hook nil "Hook run before revealing a location.") @@ -12942,7 +13597,7 @@ ACTION can be `set', `up', `down', or a character." (if (equal action '(4)) (org-show-priority) (unless org-enable-priority-commands - (error "Priority commands are disabled")) + (user-error "Priority commands are disabled")) (setq action (or action 'set)) (let (current new news have remove) (save-excursion @@ -12966,7 +13621,7 @@ ACTION can be `set', `up', `down', or a character." (setq new (upcase new))) (cond ((equal new ?\ ) (setq remove t)) ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) - (error "Priority must be between `%c' and `%c'" + (user-error "Priority must be between `%c' and `%c'" org-highest-priority org-lowest-priority)))) ((eq action 'up) (setq new (if have @@ -12988,7 +13643,7 @@ ACTION can be `set', `up', `down', or a character." (if org-priority-start-cycle-with-default org-default-priority (1+ org-default-priority)))))) - (t (error "Invalid action"))) + (t (user-error "Invalid action"))) (if (or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) (if (and (memq action '(up down)) @@ -13005,7 +13660,7 @@ ACTION can be `set', `up', `down', or a character." (replace-match "" t t nil 1) (replace-match news t t nil 2)) (if remove - (error "No priority cookie found in line") + (user-error "No priority cookie found in line") (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) (if (match-end 2) @@ -13064,7 +13719,7 @@ a file becomes an N^2 operation - but with this variable set, it scales as N.") (defun org-scan-tags (action matcher todo-only &optional start-level) - "Scan headline tags with inheritance and produce output ACTION. + "Sca headline tags with inheritance and produce output ACTION. ACTION can be `sparse-tree' to produce a sparse tree in the current buffer, or `agenda' to produce an entry list for an agenda view. It can also be @@ -13119,7 +13774,7 @@ headlines matching this string." (setq todo (if (match-end 1) (org-match-string-no-properties 2)) tags (if (match-end 4) (org-match-string-no-properties 4))) (goto-char (setq lspos (match-beginning 0))) - (setq level (org-reduced-level (funcall outline-level)) + (setq level (org-reduced-level (org-outline-level)) category (org-get-category)) (setq i llast llast level) ;; remove tag lists from same and sublevels @@ -13184,7 +13839,7 @@ headlines matching this string." (if (eq org-tags-match-list-sublevels 'indented) (make-string (1- level) ?.) "") (org-get-heading)) - category + level category tags-list) priority (org-get-priority txt)) (goto-char lspos) @@ -13199,7 +13854,7 @@ headlines matching this string." (save-excursion (setq rtn1 (funcall action)) (push rtn1 rtn))) - (t (error "Invalid action"))) + (t (user-error "Invalid action"))) ;; if we are to skip sublevels, jump to end of subtree (unless org-tags-match-list-sublevels @@ -13302,11 +13957,14 @@ See also `org-scan-tags'. " (declare (special todo-only)) (unless (boundp 'todo-only) - (error "org-make-tags-matcher expects todo-only to be scoped in")) + (error "`org-make-tags-matcher' expects todo-only to be scoped in")) (unless match - ;; Get a new match request, with completion + ;; Get a new match request, with completion against the global + ;; tags table and the local tags in current buffer (let ((org-last-tags-completion-table - (org-global-tags-completion-table))) + (org-uniquify + (delq nil (append (org-get-buffer-tags) + (org-global-tags-completion-table)))))) (setq match (org-completing-read-no-i "Match: " 'org-tags-completion-function nil nil nil 'org-tags-history)))) @@ -13318,6 +13976,8 @@ See also `org-scan-tags'. tagsmatch todomatch tagsmatcher todomatcher kwd matcher orterms term orlist re-p str-p level-p level-op time-p prop-p pn pv po gv rest) + ;; Expand group tags + (setq match (org-tags-expand match)) (if (string-match "/+" match) ;; match contains also a todo-matching request (progn @@ -13424,6 +14084,61 @@ See also `org-scan-tags'. matcher))) (cons match0 matcher))) +(defun org-tags-expand (match &optional single-as-list downcased) + "Expand group tags in MATCH. + +This replaces every group tag in MATCH with a regexp tag search. +For example, a group tag \"Work\" defined as { Work : Lab Conf } +will be replaced like this: + + Work => {\\(?:Work\\|Lab\\|Conf\\)} + +Work => +{\\(?:Work\\|Lab\\|Conf\\)} + -Work => -{\\(?:Work\\|Lab\\|Conf\\)} + +Replacing by a regexp preserves the structure of the match. +E.g., this expansion + + Work|Home => {\\(?:Work\\|Lab\\|Conf\\}|Home + +will match anything tagged with \"Lab\" and \"Home\", or tagged +with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\". + +When the optional argument SINGLE-AS-LIST is non-nil, MATCH is +assumed to be a single group tag, and the function will return +the list of tags in this group. + +When DOWNCASE is non-nil, expand downcased TAGS." + (if org-group-tags + (let* ((case-fold-search t) + (stable org-mode-syntax-table) + (tal (or org-tag-groups-alist-for-agenda + org-tag-groups-alist)) + (tal (if downcased + (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal)) + (tml (mapcar 'car tal)) + (rtnmatch match) rpl) + ;; @ and _ are allowed as word-components in tags + (modify-syntax-entry ?@ "w" stable) + (modify-syntax-entry ?_ "w" stable) + (while (and tml + (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))) + (setq tml (delete tag tml)) + (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch))) + (setq rpl (append (org-uniquify rpl) (assoc tag tal))) + (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}")) + (if (stringp rpl) (org-add-props rpl '(grouptag t))) + (setq rtnmatch (replace-match rpl t t rtnmatch))))) + (if single-as-list + (or (reverse rpl) (list rtnmatch)) + rtnmatch)) + (if single-as-list (list (if downcased (downcase match) match)) + match))) + (defun org-op-to-function (op &optional stringp) "Turn an operator into the appropriate function." (setq op @@ -13768,7 +14483,9 @@ This works in the agenda, and also in an org-mode buffer." (list (region-beginning) (region-end) (let ((org-last-tags-completion-table (if (derived-mode-p 'org-mode) - (org-get-buffer-tags) + (org-uniquify + (delq nil (append (org-get-buffer-tags) + (org-global-tags-completion-table)))) (org-global-tags-completion-table)))) (org-icompleting-read "Tag: " 'org-tags-completion-function nil nil nil @@ -13820,15 +14537,14 @@ This works in the agenda, and also in an org-mode buffer." rtn) ((eq flag t) ;; all-completions - (all-completions s2 ctable confirm) - ) + (all-completions s2 ctable confirm)) ((eq flag 'lambda) ;; exact match? - (assoc s2 ctable))) - )) + (assoc s2 ctable))))) (defun org-fast-tag-insert (kwd tags face &optional end) - "Insert KDW, and the TAGS, the latter with face FACE. Also insert END." + "Insert KDW, and the TAGS, the latter with face FACE. +Also insert END." (insert (format "%-12s" (concat kwd ":")) (org-add-props (mapconcat 'identity tags " ") nil 'face face) (or end ""))) @@ -13844,6 +14560,7 @@ This works in the agenda, and also in an org-mode buffer." (insert (org-add-props " Next change exits" nil 'face 'org-warning))))) (defun org-set-current-tags-overlay (current prefix) + "Add an overlay to CURRENT tag with PREFIX." (let ((s (concat ":" (mapconcat 'identity current ":") ":"))) (if (featurep 'xemacs) (org-overlay-display org-tags-overlay (concat prefix s) @@ -13926,6 +14643,7 @@ Returns the new tags string, or nil to not change the current settings." (while (equal (car tbl) '(:newline)) (insert "\n") (setq tbl (cdr tbl))))) + ((equal e '(:grouptags)) nil) (t (setq tg (copy-sequence (car e)) c2 nil) (if (cdr e) @@ -13941,11 +14659,13 @@ Returns the new tags string, or nil to not change the current settings." (setq c (or c2 char))) (if ingroup (push tg (car groups))) (setq tg (org-add-props tg nil 'face - (cond - ((not (assoc tg table)) - (org-get-todo-face tg)) - ((member tg current) c-face) - ((member tg inherited) i-face)))) + (cond + ((not (assoc tg table)) + (org-get-todo-face tg)) + ((member tg current) c-face) + ((member tg inherited) i-face)))) + (if (equal (caar tbl) :grouptags) + (org-add-props tg nil 'face 'org-tag-group)) (if (and (= cnt 0) (not ingroup)) (insert " ")) (insert "[" c "] " tg (make-string (- fwidth 4 (length tg)) ?\ )) @@ -14047,7 +14767,7 @@ Returns the new tags string, or nil to not change the current settings." (defun org-get-tags-string () "Get the TAGS string in the current headline." (unless (org-at-heading-p t) - (error "Not on a heading")) + (user-error "Not on a heading")) (save-excursion (beginning-of-line 1) (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) @@ -14155,7 +14875,7 @@ a *different* entry, you cannot use these techniques." ((eq match nil) (setq matcher t)) (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t)))) - (save-excursion + (save-window-excursion (save-restriction (cond ((eq scope 'tree) (org-back-to-heading t) @@ -14276,13 +14996,15 @@ value for the property." (call-interactively 'org-delete-property-globally)) ((equal c ?c) (call-interactively 'org-compute-property-at-point)) - (t (error "No such property action %c" c))))) + (t (user-error "No such property action %c" c))))) (defun org-inc-effort () "Increment the value of the effort property in the current entry." (interactive) (org-set-effort nil t)) +(defvar org-clock-effort) ;; Defined in org-clock.el +(defvar org-clock-current-task) ;; Defined in org-clock.el (defun org-set-effort (&optional value increment) "Set the effort property of the current entry. With numerical prefix arg, use the nth allowed value, 0 stands for the @@ -14296,6 +15018,7 @@ When INCREMENT is non-nil, set the property to the next allowed value." (cur (org-entry-get nil prop)) (allowed (org-property-get-allowed-values nil prop 'table)) (existing (mapcar 'list (org-property-values prop))) + (heading (nth 4 (org-heading-components))) rpl (val (cond ((stringp value) value) @@ -14304,7 +15027,7 @@ When INCREMENT is non-nil, set the property to the next allowed value." (car (org-last allowed)))) ((and allowed increment) (or (caadr (member (list cur) allowed)) - (error "Allowed effort values are not set"))) + (user-error "Allowed effort values are not set"))) (allowed (message "Select 1-9,0, [RET%s]: %s" (if cur (concat "=" cur) "") @@ -14329,6 +15052,9 @@ When INCREMENT is non-nil, set the property to the next allowed value." (save-excursion (org-back-to-heading t) (put-text-property (point-at-bol) (point-at-eol) 'org-effort val)) + (when (string= heading org-clock-current-task) + (setq org-clock-effort (get-text-property (point-at-bol) 'org-effort)) + (org-clock-update-mode-line)) (message "%s is now %s" prop val))) (defun org-at-property-p () @@ -14537,8 +15263,10 @@ If yes, return this value. If not, return the current value of the variable." (read prop) (symbol-value var)))) -(defun org-entry-delete (pom property) - "Delete the property PROPERTY from entry at point-or-marker POM." +(defun org-entry-delete (pom property &optional delete-empty-drawer) + "Delete the property PROPERTY from entry at point-or-marker POM. +When optional argument DELETE-EMPTY-DRAWER is a string, it defines +an empty drawer to delete." (org-with-point-at pom (if (member property org-special-properties) nil ; cannot delete these properties. @@ -14550,6 +15278,9 @@ If yes, return this value. If not, return the current value of the variable." (cdr range) t)) (progn (delete-region (match-beginning 0) (1+ (point-at-eol))) + (and delete-empty-drawer + (org-remove-empty-drawer-at + delete-empty-drawer (car range))) t) nil))))) @@ -14561,7 +15292,7 @@ If yes, return this value. If not, return the current value of the variable." (values (and old (org-split-string old "[ \t]")))) (setq value (org-entry-protect-space value)) (unless (member value values) - (setq values (cons value values)) + (setq values (append values (list value))) (org-entry-put pom property (mapconcat 'identity values " "))))) @@ -14662,7 +15393,7 @@ and the new value.") ((equal property "TODO") (when (and (stringp value) (string-match "\\S-" value) (not (member value org-todo-keywords-1))) - (error "\"%s\" is not a valid TODO state" value)) + (user-error "\"%s\" is not a valid TODO state" value)) (if (or (not value) (not (string-match "\\S-" value))) (setq value 'none)) @@ -14672,6 +15403,15 @@ and the new value.") (org-priority (if (and value (stringp value) (string-match "\\S-" value)) (string-to-char value) ?\ )) (org-set-tags nil 'align)) + ((equal property "CLOCKSUM") + (if (not (re-search-forward + (concat org-clock-string ".*\\]--\\(\\[[^]]+\\]\\)") nil t)) + (error "Cannot find a clock log") + (goto-char (- (match-end 1) 2)) + (cond + ((eq value 'earlier) (org-timestamp-down)) + ((eq value 'later) (org-timestamp-up))) + (org-clock-sum-current-item))) ((equal property "SCHEDULED") (if (re-search-forward org-scheduled-time-regexp end t) (cond @@ -14851,7 +15591,7 @@ Point is left between drawer's boundaries." (beginning-of-line) (when (save-excursion (re-search-forward org-outline-regexp-bol rend t)) - (error "Drawers cannot contain headlines")) + (user-error "Drawers cannot contain headlines")) ;; Position point at the beginning of the first ;; non-blank line in region. Insert drawer's opening ;; there, then indent it. @@ -14909,6 +15649,7 @@ This is computed according to `org-property-set-functions-alist'." val))) (defvar org-last-set-property nil) +(defvar org-last-set-property-value nil) (defun org-read-property-name () "Read a property name." (let* ((completion-ignore-case t) @@ -14926,8 +15667,7 @@ This is computed according to `org-property-set-functions-alist'." ": ") (mapcar 'list keys) nil nil nil nil - default-prop - ))) + default-prop))) (if (member property keys) property (or (cdr (assoc (downcase property) @@ -14935,6 +15675,23 @@ This is computed according to `org-property-set-functions-alist'." keys))) property)))) +(defun org-set-property-and-value (use-last) + "Allow to set [PROPERTY]: [value] direction from prompt. +When use-default, don't even ask, just use the last +\"[PROPERTY]: [value]\" string from the history." + (interactive "P") + (let* ((completion-ignore-case t) + (pv (or (and use-last org-last-set-property-value) + (org-completing-read + "Enter a \"[Property]: [value]\" pair: " + nil nil nil nil nil + org-last-set-property-value))) + prop val) + (when (string-match "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*$" pv) + (setq prop (match-string 1 pv) + val (match-string 2 pv)) + (org-set-property prop val)))) + (defun org-set-property (property value) "In the current entry, set PROPERTY to VALUE. When called interactively, this will prompt for a property name, offering @@ -14947,20 +15704,23 @@ in the current file." (value (or value (org-read-property-value property))) (fn (cdr (assoc property org-properties-postprocess-alist)))) (setq org-last-set-property property) + (setq org-last-set-property-value (concat property ": " value)) ;; Possibly postprocess the inserted value: (when fn (setq value (funcall fn value))) (unless (equal (org-entry-get nil property) value) (org-entry-put nil property value)))) -(defun org-delete-property (property) - "In the current entry, delete PROPERTY." +(defun org-delete-property (property &optional delete-empty-drawer) + "In the current entry, delete PROPERTY. +When optional argument DELETE-EMPTY-DRAWER is a string, it defines +an empty drawer to delete." (interactive (let* ((completion-ignore-case t) (prop (org-icompleting-read "Property: " (org-entry-properties nil 'standard)))) (list prop))) (message "Property %s %s" property - (if (org-entry-delete nil property) + (if (org-entry-delete nil property delete-empty-drawer) "deleted" "was not present in the entry"))) @@ -14992,11 +15752,11 @@ This looks for an enclosing column format, extracts the operator and then applies it to the property in the column format's scope." (interactive) (unless (org-at-property-p) - (error "Not at a property")) + (user-error "Not at a property")) (let ((prop (org-match-string-no-properties 2))) (org-columns-get-format-and-top-level) (unless (nth 3 (assoc prop org-columns-current-fmt-compiled)) - (error "No operator defined for property %s" prop)) + (user-error "No operator defined for property %s" prop)) (org-columns-compute prop))) (defvar org-property-allowed-value-functions nil @@ -15049,22 +15809,23 @@ completion." "Switch to the next allowed value for this property." (interactive) (unless (org-at-property-p) - (error "Not at a property")) + (user-error "Not at a property")) (let* ((prop (car (save-match-data (org-split-string (match-string 1) ":")))) (key (match-string 2)) (value (match-string 3)) (allowed (or (org-property-get-allowed-values (point) key) (and (member value '("[ ]" "[-]" "[X]")) '("[ ]" "[X]")))) + (heading (save-match-data (nth 4 (org-heading-components)))) nval) (unless allowed - (error "Allowed values for this property have not been defined")) + (user-error "Allowed values for this property have not been defined")) (if previous (setq allowed (reverse allowed))) (if (member value allowed) (setq nval (car (cdr (member value allowed))))) (setq nval (or nval (car allowed))) (if (equal nval value) - (error "Only one allowed value for this property")) + (user-error "Only one allowed value for this property")) (org-at-property-p) (replace-match (concat " :" key ": " nval) t t) (org-indent-line) @@ -15073,7 +15834,10 @@ completion." (when (equal prop org-effort-property) (save-excursion (org-back-to-heading t) - (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval))) + (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval)) + (when (string= org-clock-current-task heading) + (setq org-clock-effort nval) + (org-clock-update-mode-line))) (run-hook-with-args 'org-property-changed-functions key nval))) (defun org-find-olp (path &optional this-buffer) @@ -15301,6 +16065,69 @@ So these are more for recording a certain time/date." (defvar org-read-date-analyze-forced-year nil) (defvar org-read-date-inactive) +(defvar org-read-date-minibuffer-local-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (org-defkey map (kbd ".") + (lambda () (interactive) + (org-eval-in-calendar '(calendar-goto-today)))) + (org-defkey map [(meta shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) + (org-defkey map [(meta shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) + (org-defkey map [(meta shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + (org-defkey map [(meta shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) + (org-defkey map [?\e (shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) + (org-defkey map [?\e (shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) + (org-defkey map [?\e (shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + (org-defkey map [?\e (shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) + (org-defkey map [(shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-week 1)))) + (org-defkey map [(shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-week 1)))) + (org-defkey map [(shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-day 1)))) + (org-defkey map [(shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-day 1)))) + (org-defkey map "!" + (lambda () (interactive) + (org-eval-in-calendar '(diary-view-entries)) + (message ""))) + (org-defkey map ">" + (lambda () (interactive) + (org-eval-in-calendar '(scroll-calendar-left 1)))) + (org-defkey map "<" + (lambda () (interactive) + (org-eval-in-calendar '(scroll-calendar-right 1)))) + (org-defkey map "\C-v" + (lambda () (interactive) + (org-eval-in-calendar + '(calendar-scroll-left-three-months 1)))) + (org-defkey map "\M-v" + (lambda () (interactive) + (org-eval-in-calendar + '(calendar-scroll-right-three-months 1)))) + map) + "Keymap for minibuffer commands when using `org-read-date'.") + (defun org-read-date (&optional org-with-time to-time from-string prompt default-time default-input inactive) "Read a date, possibly a time, and make things smooth for the user. @@ -15321,7 +16148,8 @@ mean next year. For details, see the manual. A few examples: 12:45 --> today 12:45 22 sept 0:34 --> currentyear-09-22 0:34 12 --> currentyear-currentmonth-12 - Fri --> nearest Friday (today or later) + Fri --> nearest Friday after today + -Tue --> last Tuesday etc. Furthermore you can specify a relative date by giving, as the *first* thing @@ -15393,61 +16221,11 @@ user." (org-eval-in-calendar nil t) (let* ((old-map (current-local-map)) (map (copy-keymap calendar-mode-map)) - (minibuffer-local-map (copy-keymap minibuffer-local-map))) + (minibuffer-local-map + (copy-keymap org-read-date-minibuffer-local-map))) (org-defkey map (kbd "RET") 'org-calendar-select) (org-defkey map [mouse-1] 'org-calendar-select-mouse) (org-defkey map [mouse-2] 'org-calendar-select-mouse) - (org-defkey minibuffer-local-map [(meta shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (org-defkey minibuffer-local-map [(meta shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - (org-defkey minibuffer-local-map [(meta shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - (org-defkey minibuffer-local-map [(meta shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) - (org-defkey minibuffer-local-map [?\e (shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (org-defkey minibuffer-local-map [?\e (shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - (org-defkey minibuffer-local-map [?\e (shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - (org-defkey minibuffer-local-map [?\e (shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) - (org-defkey minibuffer-local-map [(shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-week 1)))) - (org-defkey minibuffer-local-map [(shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-week 1)))) - (org-defkey minibuffer-local-map [(shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-day 1)))) - (org-defkey minibuffer-local-map [(shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-day 1)))) - (org-defkey minibuffer-local-map ">" - (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-left 1)))) - (org-defkey minibuffer-local-map "<" - (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-right 1)))) - (org-defkey minibuffer-local-map "\C-v" - (lambda () (interactive) - (org-eval-in-calendar - '(calendar-scroll-left-three-months 1)))) - (org-defkey minibuffer-local-map "\M-v" - (lambda () (interactive) - (org-eval-in-calendar - '(calendar-scroll-right-three-months 1)))) - (run-hooks 'org-read-date-minibuffer-setup-hook) (unwind-protect (progn (use-local-map map) @@ -15759,7 +16537,11 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to (if wday1 (progn (setq delta (mod (+ 7 (- wday1 wday)) 7)) - (if (= dir ?-) (setq delta (- delta 7))) + (if (= delta 0) (setq delta 7)) + (if (= dir ?-) + (progn + (setq delta (- delta 7)) + (if (= delta 0) (setq delta -7)))) (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) (list delta "d" rel)) (list (* n (if (= dir ?-) -1 1)) what rel))))) @@ -15915,32 +16697,44 @@ Don't touch the rest." (let ((n 0)) (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time))) -(defun org-days-to-time (timestamp-string) - "Difference between TIMESTAMP-STRING and now in days." - (- (time-to-days (org-time-string-to-time timestamp-string)) - (time-to-days (current-time)))) +(define-obsolete-function-alias 'org-days-to-time 'org-time-stamp-to-now "24.4") + +(defun org-time-stamp-to-now (timestamp-string &optional seconds) + "Difference between TIMESTAMP-STRING and now in days. +If SECONDS is non-nil, return the difference in seconds." + (let ((fdiff (if seconds 'org-float-time 'time-to-days))) + (- (funcall fdiff (org-time-string-to-time timestamp-string)) + (funcall fdiff (current-time))))) (defun org-deadline-close (timestamp-string &optional ndays) "Is the time in TIMESTAMP-STRING close to the current date?" (setq ndays (or ndays (org-get-wdays timestamp-string))) - (and (< (org-days-to-time timestamp-string) ndays) + (and (< (org-time-stamp-to-now timestamp-string) ndays) (not (org-entry-is-done-p)))) -(defun org-get-wdays (ts) - "Get the deadline lead time appropriate for timestring TS." - (cond - ((<= org-deadline-warning-days 0) - ;; 0 or negative, enforce this value no matter what - (- org-deadline-warning-days)) - ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts) - ;; lead time is specified. - (floor (* (string-to-number (match-string 1 ts)) - (cdr (assoc (match-string 2 ts) - '(("d" . 1) ("w" . 7) - ("m" . 30.4) ("y" . 365.25) - ("h" . 0.041667))))))) - ;; go for the default. - (t org-deadline-warning-days))) +(defun org-get-wdays (ts &optional delay zero-delay) + "Get the deadline lead time appropriate for timestring TS. +When DELAY is non-nil, get the delay time for scheduled items +instead of the deadline lead time. When ZERO-DELAY is non-nil +and `org-scheduled-delay-days' is 0, enforce 0 as the delay, +don't try to find the delay cookie in the scheduled timestamp." + (let ((tv (if delay org-scheduled-delay-days + org-deadline-warning-days))) + (cond + ((or (and delay (< tv 0)) + (and delay zero-delay (<= tv 0)) + (and (not delay) (<= tv 0))) + ;; Enforce this value no matter what + (- tv)) + ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts) + ;; lead time is specified. + (floor (* (string-to-number (match-string 1 ts)) + (cdr (assoc (match-string 2 ts) + '(("d" . 1) ("w" . 7) + ("m" . 30.4) ("y" . 365.25) + ("h" . 0.041667))))))) + ;; go for the default. + (t tv)))) (defun org-calendar-select-mouse (ev) "Return to `org-read-date' with the date currently selected. @@ -15983,6 +16777,7 @@ Allowed values for TYPE are: inactive: only inactive timestamps ([...]) scheduled: only scheduled timestamps deadline: only deadline timestamps + closed: only closed time-stamps When TYPE is nil, fall back on returning a regexp that matches both scheduled and deadline timestamps." @@ -15991,6 +16786,7 @@ both scheduled and deadline timestamps." ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]") ((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) ((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) + ((eq type 'closed) (concat org-closed-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]")) ((eq type 'scheduled-or-deadline) (concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>")))) @@ -16054,7 +16850,7 @@ days in order to avoid rounding problems." (goto-char (point-at-bol)) (re-search-forward org-tr-regexp-both (point-at-eol) t)) (if (not (org-at-date-range-p t)) - (error "Not at a time-stamp range, and none found in current line"))) + (user-error "Not at a time-stamp range, and none found in current line"))) (let* ((ts1 (match-string 1)) (ts2 (match-string 2)) (havetime (or (> (length ts1) 15) (> (length ts2) 15))) @@ -16131,10 +16927,10 @@ days in order to avoid rounding problems." (defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos) "Convert a time stamp to an absolute day number. -If there is a specifier for a cyclic time stamp, get the closest date to -DAYNR. +If there is a specifier for a cyclic time stamp, get the closest +date to DAYNR. PREFER and SHOW-ALL are passed through to `org-closest-date'. -The variable date is bound by the calendar when this is called." +The variable `date' is bound by the calendar when this is called." (cond ((and daynr (string-match "\\`%%\\((.*)\\)" s)) (if (org-diary-sexp-entry (match-string 1 s) "" date) @@ -16160,7 +16956,7 @@ The variable date is bound by the calendar when this is called." (defun org-small-year-to-year (year) "Convert 2-digit years into 4-digit years. -38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2007. +38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2037. The year 2000 cannot be abbreviated. Any year larger than 99 is returned unchanged." (if (< year 38) @@ -16258,7 +17054,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp." (if (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change) (setq dn (string-to-number (match-string 1 change)) dw (cdr (assoc (match-string 2 change) a1))) - (error "Invalid change specifier: %s" change)) + (user-error "Invalid change specifier: %s" change)) (if (eq dw 'week) (setq dw 'day dn (* 7 dn))) (cond ((eq dw 'hour) @@ -16325,17 +17121,19 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp." This should be a lot faster than the normal `parse-time-string'. If time is not given, defaults to 0:00. However, with optional NODEFAULT, hour and minute fields will be nil if not given." - (if (string-match org-ts-regexp0 s) - (list 0 - (if (or (match-beginning 8) (not nodefault)) - (string-to-number (or (match-string 8 s) "0"))) - (if (or (match-beginning 7) (not nodefault)) - (string-to-number (or (match-string 7 s) "0"))) - (string-to-number (match-string 4 s)) - (string-to-number (match-string 3 s)) - (string-to-number (match-string 2 s)) - nil nil nil) - (error "Not a standard Org-mode time string: %s" s))) + (cond ((string-match org-ts-regexp0 s) + (list 0 + (if (or (match-beginning 8) (not nodefault)) + (string-to-number (or (match-string 8 s) "0"))) + (if (or (match-beginning 7) (not nodefault)) + (string-to-number (or (match-string 7 s) "0"))) + (string-to-number (match-string 4 s)) + (string-to-number (match-string 3 s)) + (string-to-number (match-string 2 s)) + nil nil nil)) + ((string-match "^<[^>]+>$" s) + (decode-time (seconds-to-time (org-matcher-time s)))) + (t (error "Not a standard Org-mode time string: %s" s)))) (defun org-timestamp-up (&optional arg) "Increase the date item at the cursor by one. @@ -16425,11 +17223,12 @@ With prefix ARG, change that many days." (defvar org-clock-history) ; defined in org-clock.el (defvar org-clock-adjust-closest nil) ; defined in org-clock.el -(defun org-timestamp-change (n &optional what updown) +(defun org-timestamp-change (n &optional what updown suppress-tmp-delay) "Change the date in the time stamp at point. The date will be changed by N times WHAT. WHAT can be `day', `month', `year', `minute', `second'. If WHAT is not given, the cursor position -in the timestamp determines what will be changed." +in the timestamp determines what will be changed. +When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (let ((origin (point)) origin-cat with-hm inactive (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) @@ -16437,7 +17236,7 @@ in the timestamp determines what will be changed." extra rem ts time time0 fixnext clrgx) (if (not (org-at-timestamp-p t)) - (error "Not at a timestamp")) + (user-error "Not at a timestamp")) (if (and (not what) (eq org-ts-what 'bracket)) (org-toggle-timestamp-type) ;; Point isn't on brackets. Remember the part of the time-stamp @@ -16453,10 +17252,12 @@ in the timestamp determines what will be changed." inactive (= (char-after (match-beginning 0)) ?\[) ts (match-string 0)) (replace-match "") - (if (string-match - "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]" - ts) - (setq extra (match-string 1 ts))) + (when (string-match + "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]" + ts) + (setq extra (match-string 1 ts)) + (if suppress-tmp-delay + (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra)))) (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) (setq with-hm t)) (setq time0 (org-parse-time-string ts)) @@ -16520,7 +17321,7 @@ in the timestamp determines what will be changed." ;; Maybe adjust the closest clock in `org-clock-history' (when org-clock-adjust-closest (if (not (and (org-at-clock-log-p) - (< 1 (length (delq nil (mapcar (lambda(m) (marker-position m)) + (< 1 (length (delq nil (mapcar 'marker-position org-clock-history)))))) (message "No clock to adjust") (cond ((save-excursion ; fix previous clock? @@ -16639,27 +17440,6 @@ If there is already a time stamp at the cursor position, update it." (org-insert-time-stamp (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date)))))) -(defun org-minutes-to-hh:mm-string (m) - "Compute H:MM from a number of minutes." - (let ((h (/ m 60))) - (setq m (- m (* 60 h))) - (format org-time-clocksum-format h m))) - -(defun org-hh:mm-string-to-minutes (s) - "Convert a string H:MM to a number of minutes. -If the string is just a number, interpret it as minutes. -In fact, the first hh:mm or number in the string will be taken, -there can be extra stuff in the string. -If no number is found, the return value is 0." - (cond - ((integerp s) s) - ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s) - (+ (* (string-to-number (match-string 1 s)) 60) - (string-to-number (match-string 2 s)))) - ((string-match "\\([0-9]+\\)" s) - (string-to-number (match-string 1 s))) - (t 0))) - (defcustom org-effort-durations `(("h" . 60) ("d" . ,(* 60 8)) @@ -16681,7 +17461,146 @@ effort string \"2hours\" is equivalent to 120 minutes." :type '(alist :key-type (string :tag "Modifier") :value-type (number :tag "Minutes"))) -(defcustom org-agenda-inhibit-startup t +(defun org-minutes-to-clocksum-string (m) + "Format number of minutes as a clocksum string. +The format is determined by `org-time-clocksum-format', +`org-time-clocksum-use-fractional' and +`org-time-clocksum-fractional-format' and +`org-time-clocksum-use-effort-durations'." + (let ((clocksum "") + (m (round m)) ; Don't allow fractions of minutes + h d w mo y fmt n) + (setq h (if org-time-clocksum-use-effort-durations + (cdr (assoc "h" org-effort-durations)) 60) + d (if org-time-clocksum-use-effort-durations + (/ (cdr (assoc "d" org-effort-durations)) h) 24) + w (if org-time-clocksum-use-effort-durations + (/ (cdr (assoc "w" org-effort-durations)) (* d h)) 7) + mo (if org-time-clocksum-use-effort-durations + (/ (cdr (assoc "m" org-effort-durations)) (* d h)) 30) + y (if org-time-clocksum-use-effort-durations + (/ (cdr (assoc "y" org-effort-durations)) (* d h)) 365)) + ;; fractional format + (if org-time-clocksum-use-fractional + (cond + ;; single format string + ((stringp org-time-clocksum-fractional-format) + (format org-time-clocksum-fractional-format (/ m (float h)))) + ;; choice of fractional formats for different time units + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :years)) + (> (/ (truncate m) (* y d h)) 0)) + (format fmt (/ m (* y d (float h))))) + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :months)) + (> (/ (truncate m) (* mo d h)) 0)) + (format fmt (/ m (* mo d (float h))))) + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :weeks)) + (> (/ (truncate m) (* w d h)) 0)) + (format fmt (/ m (* w d (float h))))) + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :days)) + (> (/ (truncate m) (* d h)) 0)) + (format fmt (/ m (* d (float h))))) + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :hours)) + (> (/ (truncate m) h) 0)) + (format fmt (/ m (float h)))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :minutes)) + (format fmt m)) + ;; fall back to smallest time unit with a format + ((setq fmt (plist-get org-time-clocksum-fractional-format :hours)) + (format fmt (/ m (float h)))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :days)) + (format fmt (/ m (* d (float h))))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :weeks)) + (format fmt (/ m (* w d (float h))))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :months)) + (format fmt (/ m (* mo d (float h))))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :years)) + (format fmt (/ m (* y d (float h)))))) + ;; standard (non-fractional) format, with single format string + (if (stringp org-time-clocksum-format) + (format org-time-clocksum-format (setq n (/ m h)) (- m (* h n))) + ;; separate formats components + (and (setq fmt (plist-get org-time-clocksum-format :years)) + (or (> (setq n (/ (truncate m) (* y d h))) 0) + (plist-get org-time-clocksum-format :require-years)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n y d h)))) + (and (setq fmt (plist-get org-time-clocksum-format :months)) + (or (> (setq n (/ (truncate m) (* mo d h))) 0) + (plist-get org-time-clocksum-format :require-months)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n mo d h)))) + (and (setq fmt (plist-get org-time-clocksum-format :weeks)) + (or (> (setq n (/ (truncate m) (* w d h))) 0) + (plist-get org-time-clocksum-format :require-weeks)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n w d h)))) + (and (setq fmt (plist-get org-time-clocksum-format :days)) + (or (> (setq n (/ (truncate m) (* d h))) 0) + (plist-get org-time-clocksum-format :require-days)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n d h)))) + (and (setq fmt (plist-get org-time-clocksum-format :hours)) + (or (> (setq n (/ (truncate m) h)) 0) + (plist-get org-time-clocksum-format :require-hours)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n h)))) + (and (setq fmt (plist-get org-time-clocksum-format :minutes)) + (or (> m 0) (plist-get org-time-clocksum-format :require-minutes)) + (setq clocksum (concat clocksum (format fmt m)))) + ;; return formatted time duration + clocksum)))) + +(defalias 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string) +(make-obsolete 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string + "Org mode version 8.0") + +(defun org-hours-to-clocksum-string (n) + (org-minutes-to-clocksum-string (* n 60))) + +(defun org-hh:mm-string-to-minutes (s) + "Convert a string H:MM to a number of minutes. +If the string is just a number, interpret it as minutes. +In fact, the first hh:mm or number in the string will be taken, +there can be extra stuff in the string. +If no number is found, the return value is 0." + (cond + ((integerp s) s) + ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s) + (+ (* (string-to-number (match-string 1 s)) 60) + (string-to-number (match-string 2 s)))) + ((string-match "\\([0-9]+\\)" s) + (string-to-number (match-string 1 s))) + (t 0))) + +(defcustom org-image-actual-width t + "Should we use the actual width of images when inlining them? + +When set to `t', always use the image width. + +When set to a number, use imagemagick (when available) to set +the image's width to this value. + +When set to a number in a list, try to get the width from any +#+ATTR.* keyword if it matches a width specification like + + #+ATTR_HTML: :width 300px + +and fall back on that number if none is found. + +When set to nil, try to get the width from an #+ATTR.* keyword +and fall back on the original width if none is found. + +This requires Emacs >= 24.1, build with imagemagick support." + :group 'org-appearance + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Use the image width" t) + (integer :tag "Use a number of pixels") + (list :tag "Use #+ATTR* or a number of pixels" (integer)) + (const :tag "Use #+ATTR* or don't resize" nil))) + +(defcustom org-agenda-inhibit-startup nil "Inhibit startup when preparing agenda buffers. When this variable is `t' (the default), the initialization of the Org agenda buffers is inhibited: e.g. the visibility state @@ -16735,7 +17654,7 @@ changes from another. I believe the procedure must be like this: 3. M-x org-revert-all-org-buffers" (interactive) (unless (yes-or-no-p "Revert all Org buffers from their files? ") - (error "Abort")) + (user-error "Abort")) (save-excursion (save-window-excursion (mapc @@ -16925,7 +17844,7 @@ If the current buffer does not, find the first agenda file." (files (append fs (list (car fs)))) (tcf (if buffer-file-name (file-truename buffer-file-name))) file) - (unless files (error "No agenda files")) + (unless files (user-error "No agenda files")) (catch 'exit (while (setq file (pop files)) (if (equal (file-truename file) tcf) @@ -16947,7 +17866,7 @@ end of the list." (org-agenda-files t))) (ctf (file-truename (or buffer-file-name - (error "Please save the current buffer to a file")))) + (user-error "Please save the current buffer to a file")))) x had) (setq x (assoc ctf file-alist) had x) @@ -16967,7 +17886,7 @@ Optional argument FILE means use this file instead of the current." (interactive) (let* ((org-agenda-skip-unavailable-files nil) (file (or file buffer-file-name - (error "Current buffer does not visit a file"))) + (user-error "Current buffer does not visit a file"))) (true-file (file-truename file)) (afile (abbreviate-file-name file)) (files (delq nil (mapcar @@ -17031,7 +17950,9 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (inhibit-read-only t) (org-inhibit-startup org-agenda-inhibit-startup) (rea (concat ":" org-archive-tag ":")) - bmp file re) + file re) + (setq org-tag-alist-for-agenda nil + org-tag-groups-alist-for-agenda nil) (save-excursion (save-restriction (while (setq file (pop files)) @@ -17041,7 +17962,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (org-check-agenda-file file) (set-buffer (org-get-agenda-file-buffer file))) (widen) - (setq bmp (buffer-modified-p)) + (org-set-regexps-and-options-for-tags) (org-refresh-category-properties) (org-refresh-properties org-effort-property 'org-effort) (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime) @@ -17053,30 +17974,34 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (append org-todo-keyword-alist-for-agenda org-todo-key-alist)) (setq org-drawers-for-agenda (append org-drawers-for-agenda org-drawers)) - (setq org-tag-alist-for-agenda - (append org-tag-alist-for-agenda org-tag-alist)) - - (save-excursion - (remove-text-properties (point-min) (point-max) pall) - (when org-agenda-skip-archived-trees - (goto-char (point-min)) - (while (re-search-forward rea nil t) - (if (org-at-heading-p t) - (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) - (goto-char (point-min)) - (setq re (format org-heading-keyword-regexp-format - org-comment-string)) - (while (re-search-forward re nil t) - (add-text-properties - (match-beginning 0) (org-end-of-subtree t) pc))) - (set-buffer-modified-p bmp))))) + (unless (equal org-tag-alist-for-agenda org-tag-alist) + (setq org-tag-alist-for-agenda + (append org-tag-alist-for-agenda org-tag-alist))) + (if org-group-tags + (setq org-tag-groups-alist-for-agenda + (org-uniquify-alist + (append org-tag-groups-alist-for-agenda org-tag-groups-alist)))) + (org-with-silent-modifications + (save-excursion + (remove-text-properties (point-min) (point-max) pall) + (when org-agenda-skip-archived-trees + (goto-char (point-min)) + (while (re-search-forward rea nil t) + (if (org-at-heading-p t) + (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) + (goto-char (point-min)) + (setq re (format org-heading-keyword-regexp-format + org-comment-string)) + (while (re-search-forward re nil t) + (add-text-properties + (match-beginning 0) (org-end-of-subtree t) pc)))))))) (setq org-todo-keywords-for-agenda (org-uniquify org-todo-keywords-for-agenda)) (setq org-todo-keyword-alist-for-agenda - (org-uniquify org-todo-keyword-alist-for-agenda) - org-tag-alist-for-agenda (org-uniquify org-tag-alist-for-agenda)))) + (org-uniquify org-todo-keyword-alist-for-agenda)))) -;;;; Embedded LaTeX + +;;;; CDLaTeX minor mode (defvar org-cdlatex-mode-map (make-sparse-keymap) "Keymap for the minor `org-cdlatex-mode'.") @@ -17126,6 +18051,58 @@ an embedded LaTeX fragment, let texmathp do its job. "Unconditionally turn on `org-cdlatex-mode'." (org-cdlatex-mode 1)) +(defun org-try-cdlatex-tab () + "Check if it makes sense to execute `cdlatex-tab', and do it if yes. +It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is + - inside a LaTeX fragment, or + - after the first word in a line, where an abbreviation expansion could + insert a LaTeX environment." + (when org-cdlatex-mode + (cond + ;; Before any word on the line: No expansion possible. + ((save-excursion (skip-chars-backward " \t") (bolp)) nil) + ;; Just after first word on the line: Expand it. Make sure it + ;; cannot happen on headlines, though. + ((save-excursion + (skip-chars-backward "a-zA-Z0-9*") + (skip-chars-backward " \t") + (and (bolp) (not (org-at-heading-p)))) + (cdlatex-tab) t) + ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t)))) + +(defun org-cdlatex-underscore-caret (&optional arg) + "Execute `cdlatex-sub-superscript' in LaTeX fragments. +Revert to the normal definition outside of these fragments." + (interactive "P") + (if (org-inside-LaTeX-fragment-p) + (call-interactively 'cdlatex-sub-superscript) + (let (org-cdlatex-mode) + (call-interactively (key-binding (vector last-input-event)))))) + +(defun org-cdlatex-math-modify (&optional arg) + "Execute `cdlatex-math-modify' in LaTeX fragments. +Revert to the normal definition outside of these fragments." + (interactive "P") + (if (org-inside-LaTeX-fragment-p) + (call-interactively 'cdlatex-math-modify) + (let (org-cdlatex-mode) + (call-interactively (key-binding (vector last-input-event)))))) + + + +;;;; LaTeX fragments + +(defvar org-latex-regexps + '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) + ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) + ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p + ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) + ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) + ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) + ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) + ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) + "Regular expressions for matching embedded LaTeX.") + (defun org-inside-LaTeX-fragment-p () "Test if point is inside a LaTeX fragment. I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing @@ -17176,43 +18153,6 @@ looks only before point, not after." (org-in-regexp "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*"))) -(defun org-try-cdlatex-tab () - "Check if it makes sense to execute `cdlatex-tab', and do it if yes. -It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is - - inside a LaTeX fragment, or - - after the first word in a line, where an abbreviation expansion could - insert a LaTeX environment." - (when org-cdlatex-mode - (cond - ;; Before any word on the line: No expansion possible. - ((save-excursion (skip-chars-backward " \t") (bolp)) nil) - ;; Just after first word on the line: Expand it. Make sure it - ;; cannot happen on headlines, though. - ((save-excursion - (skip-chars-backward "a-zA-Z0-9*") - (skip-chars-backward " \t") - (and (bolp) (not (org-at-heading-p)))) - (cdlatex-tab) t) - ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t)))) - -(defun org-cdlatex-underscore-caret (&optional arg) - "Execute `cdlatex-sub-superscript' in LaTeX fragments. -Revert to the normal definition outside of these fragments." - (interactive "P") - (if (org-inside-LaTeX-fragment-p) - (call-interactively 'cdlatex-sub-superscript) - (let (org-cdlatex-mode) - (call-interactively (key-binding (vector last-input-event)))))) - -(defun org-cdlatex-math-modify (&optional arg) - "Execute `cdlatex-math-modify' in LaTeX fragments. -Revert to the normal definition outside of these fragments." - (interactive "P") - (if (org-inside-LaTeX-fragment-p) - (call-interactively 'cdlatex-math-modify) - (let (org-cdlatex-mode) - (call-interactively (key-binding (vector last-input-event)))))) - (defvar org-latex-fragment-image-overlays nil "List of overlays carrying the images of latex fragments.") (make-variable-buffer-local 'org-latex-fragment-image-overlays) @@ -17234,7 +18174,7 @@ display all fragments in the buffer. The images can be removed again with \\[org-ctrl-c-ctrl-c]." (interactive "P") (unless buffer-file-name - (error "Can't preview LaTeX fragment in a non-file buffer")) + (user-error "Can't preview LaTeX fragment in a non-file buffer")) (org-remove-latex-fragment-image-overlays) (save-excursion (save-restriction @@ -17267,18 +18207,6 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." org-latex-create-formula-image-program) (message msg "done. Use `C-c C-c' to remove images."))))) -(defvar org-latex-regexps - '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) - ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) - ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p - ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) - ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) - ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) - ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) - ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) - "Regular expressions for matching embedded LaTeX.") - -(defvar org-export-have-math nil) ;; dynamic scoping (defun org-format-latex (prefix &optional dir overlays msg at forbuffer processing-type) "Replace LaTeX fragments with links to an image, and produce images. @@ -17289,12 +18217,11 @@ Some of the options can be changed using the variable (absprefix (expand-file-name prefix dir)) (todir (file-name-directory absprefix)) (opt org-format-latex-options) + (optnew org-format-latex-options) (matchers (plist-get opt :matchers)) (re-list org-latex-regexps) - (org-format-latex-header-extra - (plist-get (org-infile-export-plist) :latex-header-extra)) (cnt 0) txt hash link beg end re e checkdir - executables-checked string + string m n block-type block linkfile movefile ov) ;; Check the different regular expressions (while (setq e (pop re-list)) @@ -17304,71 +18231,58 @@ Some of the options can be changed using the variable (goto-char (point-min)) (while (re-search-forward re nil t) (when (and (or (not at) (equal (cdr at) (match-beginning n))) - (not (get-text-property (match-beginning n) - 'org-protected)) (or (not overlays) (not (eq (get-char-property (match-beginning n) 'org-overlay-type) 'org-latex-overlay)))) - (setq org-export-have-math t) (cond - ((eq processing-type 'verbatim) - ;; Leave the text verbatim, just protect it - (add-text-properties (match-beginning n) (match-end n) - '(org-protected t))) + ((eq processing-type 'verbatim)) ((eq processing-type 'mathjax) - ;; Prepare for MathJax processing + ;; Prepare for MathJax processing. (setq string (match-string n)) - (if (member m '("$" "$1")) - (save-excursion - (delete-region (match-beginning n) (match-end n)) - (goto-char (match-beginning n)) - (insert (org-add-props (concat "\\(" (substring string 1 -1) - "\\)") - '(org-protected t)))) - (add-text-properties (match-beginning n) (match-end n) - '(org-protected t)))) + (when (member m '("$" "$1")) + (save-excursion + (delete-region (match-beginning n) (match-end n)) + (goto-char (match-beginning n)) + (insert (concat "\\(" (substring string 1 -1) "\\)"))))) ((or (eq processing-type 'dvipng) (eq processing-type 'imagemagick)) - ;; Process to an image + ;; Process to an image. (setq txt (match-string n) beg (match-beginning n) end (match-end n) cnt (1+ cnt)) - (let (print-length print-level) ; make sure full list is printed + (let ((face (face-at-point)) + (fg (plist-get opt :foreground)) + (bg (plist-get opt :background)) + ;; Ensure full list is printed. + print-length print-level) + (when forbuffer + ;; Get the colors from the face at point. + (goto-char beg) + (when (eq fg 'auto) + (setq fg (face-attribute face :foreground nil 'default))) + (when (eq bg 'auto) + (setq bg (face-attribute face :background nil 'default))) + (setq optnew (copy-sequence opt)) + (plist-put optnew :foreground fg) + (plist-put optnew :background bg)) (setq hash (sha1 (prin1-to-string (list org-format-latex-header - org-format-latex-header-extra - org-export-latex-default-packages-alist - org-export-latex-packages-alist + org-latex-default-packages-alist + org-latex-packages-alist org-format-latex-options - forbuffer txt))) + forbuffer txt fg bg))) linkfile (format "%s_%s.png" prefix hash) movefile (format "%s_%s.png" absprefix hash))) (setq link (concat block "[[file:" linkfile "]]" block)) (if msg (message msg cnt)) (goto-char beg) - (unless checkdir ; make sure the directory exists + (unless checkdir ; Ensure the directory exists. (setq checkdir t) (or (file-directory-p todir) (make-directory todir t))) - (cond - ((eq processing-type 'dvipng) - (unless executables-checked - (org-check-external-command - "latex" "needed to convert LaTeX fragments to images") - (org-check-external-command - "dvipng" "needed to convert LaTeX fragments to images") - (setq executables-checked t)) - (unless (file-exists-p movefile) - (org-create-formula-image-with-dvipng - txt movefile opt forbuffer))) - ((eq processing-type 'imagemagick) - (unless executables-checked - (org-check-external-command - "convert" "you need to install imagemagick") - (setq executables-checked t)) - (unless (file-exists-p movefile) - (org-create-formula-image-with-imagemagick - txt movefile opt forbuffer)))) + (unless (file-exists-p movefile) + (org-create-formula-image + txt movefile optnew forbuffer processing-type)) (if overlays (progn (mapc (lambda (o) @@ -17398,10 +18312,8 @@ Some of the options can be changed using the variable (if block-type 'paragraph 'character)))))) ((eq processing-type 'mathml) ;; Process to MathML - (unless executables-checked - (unless (save-match-data (org-format-latex-mathml-available-p)) - (error "LaTeX to MathML converter not configured")) - (setq executables-checked t)) + (unless (save-match-data (org-format-latex-mathml-available-p)) + (user-error "LaTeX to MathML converter not configured")) (setq txt (match-string n) beg (match-beginning n) end (match-end n) cnt (1+ cnt)) @@ -17411,7 +18323,7 @@ Some of the options can be changed using the variable (insert (org-format-latex-as-mathml txt block-type prefix dir))) (t - (error "Unknown conversion type %s for latex fragments" + (error "Unknown conversion type %s for LaTeX fragments" processing-type))))))))) (defun org-create-math-formula (latex-frag &optional mathml-file) @@ -17427,7 +18339,7 @@ inspection." (buffer-substring-no-properties (region-beginning) (region-end))))) (read-string "LaTeX Fragment: " frag nil frag)))) - (unless latex-frag (error "Invalid latex-frag")) + (unless latex-frag (error "Invalid LaTeX fragment")) (let* ((tmp-in-file (file-relative-name (make-temp-name (expand-file-name "ltxmathml-in")))) (ignore (write-region latex-frag nil tmp-in-file)) @@ -17442,7 +18354,7 @@ inspection." mathml shell-command-output) (when (org-called-interactively-p 'any) (unless (org-format-latex-mathml-available-p) - (error "LaTeX to MathML converter not configured"))) + (user-error "LaTeX to MathML converter not configured"))) (message "Running %s" cmd) (setq shell-command-output (shell-command-to-string cmd)) (setq mathml @@ -17499,14 +18411,52 @@ inspection." 'org-latex-src-embed-type (if latex-frag-type 'paragraph 'character))) ;; Failed conversion. Return the LaTeX fragment verbatim - (add-text-properties - 0 (1- (length latex-frag)) '(org-protected t) latex-frag) latex-frag))) +(defun org-create-formula-image (string tofile options buffer &optional type) + "Create an image from LaTeX source using dvipng or convert. +This function calls either `org-create-formula-image-with-dvipng' +or `org-create-formula-image-with-imagemagick' depending on the +value of `org-latex-create-formula-image-program' or on the value +of the optional TYPE variable. + +Note: ultimately these two function should be combined as they +share a good deal of logic." + (org-check-external-command + "latex" "needed to convert LaTeX fragments to images") + (funcall + (case (or type org-latex-create-formula-image-program) + ('dvipng + (org-check-external-command + "dvipng" "needed to convert LaTeX fragments to images") + #'org-create-formula-image-with-dvipng) + ('imagemagick + (org-check-external-command + "convert" "you need to install imagemagick") + #'org-create-formula-image-with-imagemagick) + (t (error + "Invalid value of `org-latex-create-formula-image-program'"))) + string tofile options buffer)) + +(declare-function org-export--get-global-options "ox" (&optional backend)) +(declare-function org-export--get-inbuffer-options "ox" (&optional backend)) +(defun org-create-formula--latex-header () + "Return LaTeX header appropriate for previewing a LaTeX snippet." + (org-latex-guess-inputenc + (org-splice-latex-header + org-format-latex-header + org-latex-default-packages-alist + org-latex-packages-alist t + (plist-get + (org-combine-plists + (org-export--get-global-options 'latex) + (org-export--get-inbuffer-options 'latex)) + :latex-header)))) + ;; This function borrows from Ganesh Swami's latex2png.el (defun org-create-formula-image-with-dvipng (string tofile options buffer) "This calls dvipng." - (require 'org-latex) + (require 'ox-latex) (let* ((tmpdir (if (featurep 'xemacs) (temp-directory) temporary-file-directory)) @@ -17524,17 +18474,14 @@ inspection." "Black")) (bg (or (plist-get options (if buffer :background :html-background)) "Transparent"))) - (if (eq fg 'default) (setq fg (org-dvipng-color :foreground))) - (if (eq bg 'default) (setq bg (org-dvipng-color :background))) - (with-temp-file texfile - (insert (org-splice-latex-header - org-format-latex-header - org-export-latex-default-packages-alist - org-export-latex-packages-alist t - org-format-latex-header-extra)) - (insert "\n\\begin{document}\n" string "\n\\end{document}\n") - (require 'org-latex) - (org-export-latex-fix-inputenc)) + (if (eq fg 'default) (setq fg (org-dvipng-color :foreground)) + (unless (string= fg "Transparent") (setq fg (org-dvipng-color-format fg)))) + (if (eq bg 'default) (setq bg (org-dvipng-color :background)) + (unless (string= bg "Transparent") (setq bg (org-dvipng-color-format bg)))) + (let ((latex-header (org-create-formula--latex-header))) + (with-temp-file texfile + (insert latex-header) + (insert "\n\\begin{document}\n" string "\n\\end{document}\n"))) (let ((dir default-directory)) (condition-case nil (progn @@ -17571,10 +18518,10 @@ inspection." (delete-file (concat texfilebase e)))) pngfile)))) -(defvar org-latex-to-pdf-process) ;; Defined in org-latex.el +(declare-function org-latex-compile "ox-latex" (texfile &optional snippet)) (defun org-create-formula-image-with-imagemagick (string tofile options buffer) "This calls convert, which is included into imagemagick." - (require 'org-latex) + (require 'ox-latex) (let* ((tmpdir (if (featurep 'xemacs) (temp-directory) temporary-file-directory)) @@ -17596,54 +18543,19 @@ inspection." (setq fg (org-latex-color-format fg))) (if (eq bg 'default) (setq bg (org-latex-color :background)) (setq bg (org-latex-color-format - (if (string= bg "Transparent")(setq bg "white"))))) - (with-temp-file texfile - (insert (org-splice-latex-header - org-format-latex-header - org-export-latex-default-packages-alist - org-export-latex-packages-alist t - org-format-latex-header-extra)) - (insert "\n\\begin{document}\n" - "\\definecolor{fg}{rgb}{" fg "}\n" - "\\definecolor{bg}{rgb}{" bg "}\n" - "\n\\pagecolor{bg}\n" - "\n{\\color{fg}\n" - string - "\n}\n" - "\n\\end{document}\n" ) - (require 'org-latex) - (org-export-latex-fix-inputenc)) - (let ((dir default-directory) cmd cmds latex-frags-cmds) - (condition-case nil - (progn - (cd tmpdir) - (setq cmds org-latex-to-pdf-process) - (while cmds - (setq latex-frags-cmds (pop cmds)) - (if (listp latex-frags-cmds) - (setq cmds nil) - (setq latex-frags-cmds (list (car org-latex-to-pdf-process))))) - (while latex-frags-cmds - (setq cmd (pop latex-frags-cmds)) - (while (string-match "%b" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument texfile)) - t t cmd))) - (while (string-match "%f" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument (file-name-nondirectory texfile))) - t t cmd))) - (while (string-match "%o" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument (file-name-directory texfile))) - t t cmd))) - (setq cmd (split-string cmd)) - (eval (append (list 'call-process (pop cmd) nil nil nil) cmd)))) - (error nil)) - (cd dir)) + (if (string= bg "Transparent") "white" bg)))) + (let ((latex-header (org-create-formula--latex-header))) + (with-temp-file texfile + (insert latex-header) + (insert "\n\\begin{document}\n" + "\\definecolor{fg}{rgb}{" fg "}\n" + "\\definecolor{bg}{rgb}{" bg "}\n" + "\n\\pagecolor{bg}\n" + "\n{\\color{fg}\n" + string + "\n}\n" + "\n\\end{document}\n"))) + (org-latex-compile texfile t) (if (not (file-exists-p pdffile)) (progn (message "Failed to create pdf file from %s" texfile) nil) (condition-case nil @@ -17654,7 +18566,7 @@ inspection." "-antialias" pdffile "-quality" "100" - ;; "-sharpen" "0x1.0" + ;; "-sharpen" "0x1.0" pngfile) (call-process "convert" nil nil nil "-density" dpi @@ -17662,7 +18574,7 @@ inspection." "-antialias" pdffile "-quality" "100" - ; "-sharpen" "0x1.0" + ;; "-sharpen" "0x1.0" pngfile)) (error nil)) (if (not (file-exists-p pngfile)) @@ -17747,6 +18659,12 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." ((eq attr :background) 'background)))) (color-values (face-attribute 'default attr nil)))))) +(defun org-dvipng-color-format (color-name) + "Convert COLOR-NAME to a RGB color value for dvipng." + (apply 'format "rgb %s %s %s" + (mapcar 'org-normalize-color + (color-values color-name)))) + (defun org-latex-color (attr) "Return a RGB color for the LaTeX color package." (apply 'format "%s,%s,%s" @@ -17768,8 +18686,9 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." "Return string to be used as color value for an RGB component." (format "%g" (/ value 65535.0))) -;; Image display + +;; Image display (defvar org-inline-image-overlays nil) (make-variable-buffer-local 'org-inline-image-overlays) @@ -17783,7 +18702,8 @@ INCLUDE-LINKED is passed to `org-display-inline-images'." (org-remove-inline-images) (message "Inline image display turned off")) (org-display-inline-images include-linked) - (if org-inline-image-overlays + (if (and (org-called-interactively-p) + org-inline-image-overlays) (message "%d images displayed inline" (length org-inline-image-overlays)) (message "No images to display inline")))) @@ -17818,16 +18738,34 @@ BEG and END default to the buffer boundaries." (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" (substring (org-image-file-name-regexp) 0 -2) "\\)\\]" (if include-linked "" "\\]"))) - old file ov img) + (case-fold-search t) + old file ov img type attrwidth width) (while (re-search-forward re end t) (setq old (get-char-property-and-overlay (match-beginning 1) - 'org-image-overlay)) - (setq file (expand-file-name + 'org-image-overlay) + file (expand-file-name (concat (or (match-string 3) "") (match-string 4)))) + (when (image-type-available-p 'imagemagick) + (setq attrwidth (if (or (listp org-image-actual-width) + (null org-image-actual-width)) + (save-excursion + (save-match-data + (when (re-search-backward + "#\\+attr.*:width[ \t]+\\([^ ]+\\)" + (save-excursion + (re-search-backward "^[ \t]*$\\|\\`" nil t)) t) + (string-to-number (match-string 1)))))) + width (cond ((eq org-image-actual-width t) nil) + ((null org-image-actual-width) attrwidth) + ((numberp org-image-actual-width) + org-image-actual-width) + ((listp org-image-actual-width) + (or attrwidth (car org-image-actual-width)))) + type (if width 'imagemagick))) (when (file-exists-p file) (if (and (car-safe old) refresh) (image-refresh (overlay-get (cdr old) 'display)) - (setq img (save-match-data (create-image file))) + (setq img (save-match-data (create-image file type nil :width width))) (when img (setq ov (make-overlay (match-beginning 0) (match-end 0))) (overlay-put ov 'display img) @@ -17998,6 +18936,8 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-_" 'org-down-element) (org-defkey org-mode-map "\C-c\C-f" 'org-forward-heading-same-level) (org-defkey org-mode-map "\C-c\C-b" 'org-backward-heading-same-level) +(org-defkey org-mode-map "\C-c\M-f" 'org-next-block) +(org-defkey org-mode-map "\C-c\M-b" 'org-previous-block) (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default) @@ -18005,6 +18945,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag) (org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling) (org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) +(org-defkey org-mode-map "\C-c\C-xq" 'org-toggle-tags-groups) (org-defkey org-mode-map "\C-c\C-j" 'org-goto) (org-defkey org-mode-map "\C-c\C-t" 'org-todo) (org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command) @@ -18012,6 +18953,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-d" 'org-deadline) (org-defkey org-mode-map "\C-c;" 'org-toggle-comment) (org-defkey org-mode-map "\C-c\C-w" 'org-refile) +(org-defkey org-mode-map "\C-c\M-w" 'org-copy) (org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved (org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res. (org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) @@ -18046,6 +18988,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) (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 "\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) @@ -18060,7 +19003,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-a" 'org-attach) (org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays) (org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger) -(org-defkey org-mode-map "\C-c\C-e" 'org-export) +(org-defkey org-mode-map "\C-c\C-e" 'org-export-dispatch) (org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) (org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) (org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action) @@ -18091,6 +19034,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities) (org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) +(org-defkey org-mode-map "\C-c\C-xP" 'org-set-property-and-value) (org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort) (org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort) (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) @@ -18125,6 +19069,8 @@ BEG and END default to the buffer boundaries." ("p" . (org-speed-move-safe 'outline-previous-visible-heading)) ("f" . (org-speed-move-safe 'org-forward-heading-same-level)) ("b" . (org-speed-move-safe 'org-backward-heading-same-level)) + ("F" . org-next-block) + ("B" . org-previous-block) ("u" . (org-speed-move-safe 'outline-up-heading)) ("j" . org-goto) ("g" . (org-refile t)) @@ -18132,6 +19078,7 @@ BEG and END default to the buffer boundaries." ("c" . org-cycle) ("C" . org-shifttab) (" " . org-display-outline-path) + ("s" . org-narrow-to-subtree) ("=" . org-columns) ("Outline Structure Editing") ("U" . org-shiftmetaup) @@ -18145,7 +19092,7 @@ BEG and END default to the buffer boundaries." ("^" . org-sort) ("w" . org-refile) ("a" . org-archive-subtree-default-with-confirmation) - ("." . org-mark-subtree) + ("@" . org-mark-subtree) ("#" . org-toggle-comment) ("Clock Commands") ("I" . org-clock-in) @@ -18192,7 +19139,7 @@ BEG and END default to the buffer boundaries." "Show the available speed commands." (interactive) (if (not org-use-speed-commands) - (error "Speed commands are not activated, customize `org-use-speed-commands'") + (user-error "Speed commands are not activated, customize `org-use-speed-commands'") (with-output-to-temp-buffer "*Help*" (princ "User-defined Speed commands\n===========================\n") (mapc 'org-print-speed-command org-speed-commands-user) @@ -18340,7 +19287,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'." (when (or (memq invisible-at-point '(outline org-hide-block t)) (memq invisible-before-point '(outline org-hide-block t))) (if (eq org-catch-invisible-edits 'error) - (error "Editing in invisible areas is prohibited - make visible first")) + (user-error "Editing in invisible areas is prohibited, make them visible first")) (if (and org-custom-properties-overlays (y-or-n-p "Display invisible properties in this buffer? ")) (org-toggle-custom-properties-visibility) @@ -18361,7 +19308,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'." (message "Unfolding invisible region around point before editing")) (t ;; Don't do the edit, make the user repeat it in full visibility - (error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) + (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) (defun org-fix-tags-on-the-fly () (when (and (equal (char-after (point-at-bol)) ?*) @@ -18413,9 +19360,8 @@ because, in this case the deletion might narrow the column." (let ((pos (point)) (noalign (looking-at "[^|\n\r]* |")) (c org-table-may-need-update)) - (replace-match (concat - (substring (match-string 0) 1 -1) - " |")) + (replace-match + (concat (substring (match-string 0) 1 -1) " |") nil t) (goto-char pos) ;; noalign: if there were two spaces at the end, this field ;; does not determine the width of the column. @@ -18454,6 +19400,16 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (org-defkey map (vector 'remap old) new) (substitute-key-definition old new map global-map))))) +(defun org-transpose-words () + "Transpose words for Org. +This uses the `org-mode-transpose-word-syntax-table' syntax +table, which interprets characters in `org-emphasis-alist' as +word constituants." + (interactive) + (with-syntax-table org-mode-transpose-word-syntax-table + (call-interactively 'transpose-words))) +(org-remap org-mode-map 'transpose-words 'org-transpose-words) + (when (eq org-enable-table-editor 'optimized) ;; If the user wants maximum table support, we need to hijack ;; some standard editing functions @@ -18579,13 +19535,13 @@ See `org-ctrl-c-ctrl-c-hook' for more information.") (defun org-modifier-cursor-error () "Throw an error, a modified cursor command was applied in wrong context." - (error "This command is active in special context like tables, headlines or items")) + (user-error "This command is active in special context like tables, headlines or items")) (defun org-shiftselect-error () "Throw an error because Shift-Cursor command was applied in wrong context." (if (and (boundp 'shift-select-mode) shift-select-mode) - (error "To use shift-selection with Org-mode, customize `org-support-shift-select'") - (error "This command works only in special context like headlines or timestamps"))) + (user-error "To use shift-selection with Org-mode, customize `org-support-shift-select'") + (user-error "This command works only in special context like headlines or timestamps"))) (defun org-call-for-shift-select (cmd) (let ((this-command-keys-shift-translated t)) @@ -18593,9 +19549,9 @@ See `org-ctrl-c-ctrl-c-hook' for more information.") (defun org-shifttab (&optional arg) "Global visibility cycling or move to previous table field. -Calls `org-cycle' with argument t, or `org-table-previous-field', depending -on context. -See the individual commands for more information." +Call `org-table-previous-field' within a table. +When ARG is nil, cycle globally through visibility states. +When ARG is a numeric prefix, show contents of this level." (interactive "P") (cond ((org-at-table-p) (call-interactively 'org-table-previous-field)) @@ -18603,6 +19559,7 @@ See the individual commands for more information." (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg))) (message "Content view to level: %d" arg) (org-content (prefix-numeric-value arg2)) + (org-cycle-show-empty-lines t) (setq org-cycle-global-status 'overview))) (t (call-interactively 'org-global-cycle)))) @@ -18651,7 +19608,7 @@ See the individual commands for more information." ((org-at-item-p) (call-interactively 'org-move-item-up)) ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) (call-interactively 'org-timestamp-up))) - (t (org-modifier-cursor-error)))) + (t (call-interactively 'org-drag-line-backward)))) (defun org-shiftmetadown (&optional arg) "Move subtree down or insert table row. @@ -18666,10 +19623,10 @@ See the individual commands for more information." ((org-at-item-p) (call-interactively 'org-move-item-down)) ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) (call-interactively 'org-timestamp-down))) - (t (org-modifier-cursor-error)))) + (t (call-interactively 'org-drag-line-forward)))) (defsubst org-hidden-tree-error () - (error + (user-error "Hidden subtree, open with TAB or use subtree command M-S-/")) (defun org-metaleft (&optional arg) @@ -18759,18 +19716,6 @@ this function returns t, nil otherwise." (throw 'exit t)))) nil)))) -(org-autoload "org-element" '(org-element-at-point org-element-type)) - -(declare-function org-element-at-point "org-element" (&optional keep-trail)) -(declare-function org-element-type "org-element" (element)) -(declare-function org-element-contents "org-element" (element)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion)) -(declare-function org-element-nested-p "org-element" (elem-a elem-b)) -(declare-function org-element-swap-A-B "org-element" (elem-a elem-b)) -(declare-function org-element--parse-objects "org-element" (beg end acc restriction)) -(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) - (defun org-metaup (&optional arg) "Move subtree up or move table row up. Calls `org-move-subtree-up' or `org-table-move-row' or @@ -18961,22 +19906,24 @@ Depending on context, this does one of the following: (org-call-for-shift-select 'backward-word)) (t (org-shiftselect-error)))) -(defun org-shiftcontrolup () - "Change timestamps synchronously up in CLOCK log lines." - (interactive) +(defun org-shiftcontrolup (&optional n) + "Change timestamps synchronously up in CLOCK log lines. +Optional argument N tells to change by that many units." + (interactive "P") (cond ((and (not org-support-shift-select) (org-at-clock-log-p) (org-at-timestamp-p t)) - (org-clock-timestamps-up)) + (org-clock-timestamps-up n)) (t (org-shiftselect-error)))) -(defun org-shiftcontroldown () - "Change timestamps synchronously down in CLOCK log lines." - (interactive) +(defun org-shiftcontroldown (&optional n) + "Change timestamps synchronously down in CLOCK log lines. +Optional argument N tells to change by that many units." + (interactive "P") (cond ((and (not org-support-shift-select) (org-at-clock-log-p) (org-at-timestamp-p t)) - (org-clock-timestamps-down)) + (org-clock-timestamps-down n)) (t (org-shiftselect-error)))) (defun org-ctrl-c-ret () @@ -19042,38 +19989,51 @@ See the individual commands for more information." (eq 'fixed-width (org-element-type (org-element-at-point))))) (defun org-edit-special (&optional arg) - "Call a special editor for the stuff at point. + "Call a special editor for the element at point. When at a table, call the formula editor with `org-table-edit-formulas'. When in a source code block, call `org-edit-src-code'. When in a fixed-width region, call `org-edit-fixed-width-region'. -When in an #+include line, visit the included file. +When at an #+INCLUDE keyword, visit the included file. On a link, call `ffap' to visit the link at point. Otherwise, return a user error." - (interactive) - ;; possibly prep session before editing source - (when (and (org-in-src-block-p) arg) - (let* ((info (org-babel-get-src-block-info)) - (lang (nth 0 info)) - (params (nth 2 info)) - (session (cdr (assoc :session params)))) - (when (and info session) ;; we are in a source-code block with a session - (funcall - (intern (concat "org-babel-prep-session:" lang)) session params)))) - (cond ;; proceed with `org-edit-special' - ((save-excursion - (beginning-of-line 1) - (looking-at "\\(?:#\\+\\(?:setupfile\\|include\\):?[ \t]+\"?\\|[ \t]*.*?file=\"\\)\\([^\"\n>]+\\)")) - (find-file (org-trim (match-string 1)))) - ((org-at-table.el-p) (org-edit-src-code)) - ((or (org-at-table-p) - (save-excursion - (beginning-of-line 1) - (let ((case-fold-search )) (looking-at "[ \t]*#\\+tblfm:")))) - (call-interactively 'org-table-edit-formulas)) - ((org-in-block-p '("src" "example" "latex" "html")) (org-edit-src-code)) - ((org-in-fixed-width-region-p) (org-edit-fixed-width-region)) - ((org-at-regexp-p org-any-link-re) (call-interactively 'ffap)) - (t (user-error "No special environment to edit here")))) + (interactive "P") + (let ((element (org-element-at-point))) + (assert (not buffer-read-only) nil + "Buffer is read-only: %s" (buffer-name)) + (case (org-element-type element) + (src-block + (if (not arg) (org-edit-src-code) + (let* ((info (org-babel-get-src-block-info)) + (lang (nth 0 info)) + (params (nth 2 info)) + (session (cdr (assq :session params)))) + (if (not session) (org-edit-src-code) + ;; At a src-block with a session and function called with + ;; an ARG: switch to the buffer related to the inferior + ;; process. + (switch-to-buffer + (funcall (intern (concat "org-babel-prep-session:" lang)) + session params)))))) + (keyword + (if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE")) + (find-file + (org-remove-double-quotes + (car (org-split-string (org-element-property :value element))))) + (user-error "No special environment to edit here"))) + (table + (if (eq (org-element-property :type element) 'table.el) + (org-edit-src-code) + (call-interactively 'org-table-edit-formulas))) + ;; Only Org tables contain `table-row' type elements. + (table-row (call-interactively 'org-table-edit-formulas)) + ((example-block export-block) (org-edit-src-code)) + (fixed-width (org-edit-fixed-width-region)) + (otherwise + ;; No notable element at point. Though, we may be at a link, + ;; which is an object. Thus, scan deeper. + (if (eq (org-element-type (org-element-context element)) 'link) + (call-interactively 'ffap) + (user-error "No special environment to edit here")))))) (defvar org-table-coordinate-overlays) ; defined in org-table.el (defun org-ctrl-c-ctrl-c (&optional arg) @@ -19121,136 +20081,155 @@ This command does many different things, depending on context: evaluation requires confirmation. Code block evaluation can be inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." (interactive "P") - (let ((org-enable-table-editor t)) - (cond - ((or (and (boundp 'org-clock-overlays) org-clock-overlays) - org-occur-highlights - org-latex-fragment-image-overlays) - (and (boundp 'org-clock-overlays) (org-clock-remove-overlays)) - (org-remove-occur-highlights) - (org-remove-latex-fragment-image-overlays) - (message "Temporary highlights/overlays removed from current buffer")) - ((and (local-variable-p 'org-finish-function (current-buffer)) - (fboundp org-finish-function)) - (funcall org-finish-function)) - ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) - ((org-in-regexp org-ts-regexp-both) - (org-timestamp-change 0 'day)) - ((or (looking-at org-property-start-re) - (org-at-property-p)) - (call-interactively 'org-property-action)) - ((org-at-target-p) (call-interactively 'org-update-radio-target-regexp)) - ((and (org-in-regexp "\\[\\([0-9]*%\\|[0-9]*/[0-9]*\\)\\]") - (or (org-at-heading-p) (org-at-item-p))) - (call-interactively 'org-update-statistics-cookies)) - ((org-at-heading-p) (call-interactively 'org-set-tags)) - ((org-at-table.el-p) - (message "Use C-c ' to edit table.el tables")) - ((org-at-table-p) - (org-table-maybe-eval-formula) - (if arg - (call-interactively 'org-table-recalculate) - (org-table-maybe-recalculate-line)) - (call-interactively 'org-table-align) - (orgtbl-send-table 'maybe)) - ((or (org-footnote-at-reference-p) - (org-footnote-at-definition-p)) - (call-interactively 'org-footnote-action)) - ((org-at-item-checkbox-p) - ;; Cursor at a checkbox: repair list and update checkboxes. Send - ;; list only if at top item. - (let* ((cbox (match-string 1)) - (struct (org-list-struct)) - (old-struct (copy-tree struct)) - (parents (org-list-parents-alist struct)) - (orderedp (org-entry-get nil "ORDERED")) - (firstp (= (org-list-get-top-point struct) (point-at-bol))) - block-item) - ;; Use a light version of `org-toggle-checkbox' to avoid - ;; computing list structure twice. - (let ((new-box (cond - ((equal arg '(16)) "[-]") - ((equal arg '(4)) nil) - ((equal "[X]" cbox) "[ ]") - (t "[X]")))) - (if (and firstp arg) - ;; If at first item of sub-list, remove check-box from - ;; every item at the same level. - (mapc - (lambda (pos) (org-list-set-checkbox pos struct new-box)) - (org-list-get-all-items - (point-at-bol) struct (org-list-prevs-alist struct))) - (org-list-set-checkbox (point-at-bol) struct new-box))) - ;; Replicate `org-list-write-struct', while grabbing a return - ;; value from `org-list-struct-fix-box'. - (org-list-struct-fix-ind struct parents 2) - (org-list-struct-fix-item-end struct) - (let ((prevs (org-list-prevs-alist struct))) - (org-list-struct-fix-bul struct prevs) - (org-list-struct-fix-ind struct parents) - (setq block-item - (org-list-struct-fix-box struct parents prevs orderedp))) - (if (equal struct old-struct) - (user-error "Cannot toggle this checkbox (unchecked subitems?)") - (org-list-struct-apply-struct struct old-struct) - (org-update-checkbox-count-maybe)) - (when block-item - (message - "Checkboxes were removed due to unchecked box at line %d" - (org-current-line block-item))) - (when firstp (org-list-send-list 'maybe)))) - ((org-at-item-p) - ;; Cursor at an item: repair list. Do checkbox related actions - ;; only if function was called with an argument. Send list only - ;; if at top item. - (let* ((struct (org-list-struct)) - (firstp (= (org-list-get-top-point struct) (point-at-bol))) - old-struct) - (when arg - (setq old-struct (copy-tree struct)) - (if firstp - ;; If at first item of sub-list, add check-box to every - ;; item at the same level. - (mapc - (lambda (pos) - (unless (org-list-get-checkbox pos struct) - (org-list-set-checkbox pos struct "[ ]"))) - (org-list-get-all-items - (point-at-bol) struct (org-list-prevs-alist struct))) - (org-list-set-checkbox (point-at-bol) struct "[ ]"))) - (org-list-write-struct - struct (org-list-parents-alist struct) old-struct) - (when arg (org-update-checkbox-count-maybe)) - (when firstp (org-list-send-list 'maybe)))) - ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re)) - ;; Dynamic block - (beginning-of-line 1) - (save-excursion (org-update-dblock))) - ((save-excursion - (let ((case-fold-search t)) - (beginning-of-line 1) - (looking-at "[ \t]*#\\+\\([a-z]+\\)"))) - (cond - ((or (equal (match-string 1) "TBLFM") - (equal (match-string 1) "tblfm")) - ;; Recalculate the table before this line - (save-excursion - (beginning-of-line 1) - (skip-chars-backward " \r\n\t") - (if (org-at-table-p) - (org-call-with-arg 'org-table-recalculate (or arg t))))) - (t - (let ((org-inhibit-startup-visibility-stuff t) - (org-startup-align-all-tables nil)) - (when (boundp 'org-table-coordinate-overlays) - (mapc 'delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil)) - (org-save-outline-visibility 'use-markers (org-mode-restart))) - (message "Local setup has been refreshed")))) - ((org-clock-update-time-maybe)) - (t - (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) - (error "C-c C-c can do nothing useful at this location")))))) + (cond + ((or (and (boundp 'org-clock-overlays) org-clock-overlays) + org-occur-highlights + org-latex-fragment-image-overlays) + (and (boundp 'org-clock-overlays) (org-clock-remove-overlays)) + (org-remove-occur-highlights) + (org-remove-latex-fragment-image-overlays) + (message "Temporary highlights/overlays removed from current buffer")) + ((and (local-variable-p 'org-finish-function (current-buffer)) + (fboundp org-finish-function)) + (funcall org-finish-function)) + ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) + (t + (let* ((context (org-element-context)) (type (org-element-type context))) + ;; Test if point is within a blank line. + (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$")) + (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) + (user-error "C-c C-c can do nothing useful at this location")) + ;; For convenience: at the first line of a paragraph on the + ;; same line as an item, apply function on that item instead. + (when (eq type 'paragraph) + (let ((parent (org-element-property :parent context))) + (when (and (eq (org-element-type parent) 'item) + (= (point-at-bol) (org-element-property :begin parent))) + (setq context parent type 'item)))) + ;; Act according to type of element or object at point. + (case type + (clock (org-clock-update-time-maybe)) + (dynamic-block + (save-excursion + (goto-char (org-element-property :post-affiliated context)) + (org-update-dblock))) + (footnote-definition + (goto-char (org-element-property :post-affiliated context)) + (call-interactively 'org-footnote-action)) + (footnote-reference (call-interactively 'org-footnote-action)) + ((headline inlinetask) + (save-excursion (goto-char (org-element-property :begin context)) + (call-interactively 'org-set-tags))) + (item + ;; At an item: a double C-u set checkbox to "[-]" + ;; unconditionally, whereas a single one will toggle its + ;; presence. Without an universal argument, if the item + ;; has a checkbox, toggle it. Otherwise repair the list. + (let* ((box (org-element-property :checkbox context)) + (struct (org-element-property :structure context)) + (old-struct (copy-tree struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + (orderedp (org-not-nil (org-entry-get nil "ORDERED")))) + (org-list-set-checkbox + (org-element-property :begin context) struct + (cond ((equal arg '(16)) "[-]") + ((and (not box) (equal arg '(4))) "[ ]") + ((or (not box) (equal arg '(4))) nil) + ((eq box 'on) "[ ]") + (t "[X]"))) + ;; Mimic `org-list-write-struct' but with grabbing + ;; a return value from `org-list-struct-fix-box'. + (org-list-struct-fix-ind struct parents 2) + (org-list-struct-fix-item-end struct) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-fix-ind struct parents) + (let ((block-item + (org-list-struct-fix-box struct parents prevs orderedp))) + (if (and box (equal struct old-struct)) + (if (equal arg '(16)) + (message "Checkboxes already reset") + (user-error "Cannot toggle this checkbox: %s" + (if (eq box 'on) + "all subitems checked" + "unchecked subitems"))) + (org-list-struct-apply-struct struct old-struct) + (org-update-checkbox-count-maybe)) + (when block-item + (message "Checkboxes were removed due to empty box at line %d" + (org-current-line block-item)))))) + (keyword + (let ((org-inhibit-startup-visibility-stuff t) + (org-startup-align-all-tables nil)) + (when (boundp 'org-table-coordinate-overlays) + (mapc 'delete-overlay org-table-coordinate-overlays) + (setq org-table-coordinate-overlays nil)) + (org-save-outline-visibility 'use-markers (org-mode-restart))) + (message "Local setup has been refreshed")) + (plain-list + ;; At a plain list, with a double C-u argument, set + ;; checkboxes of each item to "[-]", whereas a single one + ;; will toggle their presence according to the state of the + ;; first item in the list. Without an argument, repair the + ;; list. + (let* ((begin (org-element-property :contents-begin context)) + (beginm (move-marker (make-marker) begin)) + (struct (org-element-property :structure context)) + (old-struct (copy-tree struct)) + (first-box (save-excursion + (goto-char begin) + (looking-at org-list-full-item-re) + (match-string-no-properties 3))) + (new-box (cond ((equal arg '(16)) "[-]") + ((equal arg '(4)) (unless first-box "[ ]")) + ((equal first-box "[X]") "[ ]") + (t "[X]")))) + (cond + (arg + (mapc (lambda (pos) (org-list-set-checkbox pos struct new-box)) + (org-list-get-all-items + begin struct (org-list-prevs-alist struct)))) + ((and first-box (eq (point) begin)) + ;; For convenience, when point is at bol on the first + ;; item of the list and no argument is provided, simply + ;; toggle checkbox of that item, if any. + (org-list-set-checkbox begin struct new-box))) + (org-list-write-struct + struct (org-list-parents-alist struct) old-struct) + (org-update-checkbox-count-maybe) + (save-excursion (goto-char beginm) (org-list-send-list 'maybe)))) + ((property-drawer node-property) + (call-interactively 'org-property-action)) + ((radio-target target) + (call-interactively 'org-update-radio-target-regexp)) + (statistics-cookie + (call-interactively 'org-update-statistics-cookies)) + ((table table-cell table-row) + ;; At a table, recalculate every field and align it. Also + ;; send the table if necessary. If the table has + ;; a `table.el' type, just give up. At a table row or + ;; cell, maybe recalculate line but always align table. + (if (eq (org-element-property :type context) 'table.el) + (message "Use C-c ' to edit table.el tables") + (let ((org-enable-table-editor t)) + (if (or (eq type 'table) + ;; Check if point is at a TBLFM line. + (and (eq type 'table-row) + (= (point) (org-element-property :end context)))) + (save-excursion + (if (org-at-TBLFM-p) (org-calc-current-TBLFM) + (goto-char (org-element-property :contents-begin context)) + (org-call-with-arg 'org-table-recalculate (or arg t)) + (orgtbl-send-table 'maybe))) + (org-table-maybe-eval-formula) + (cond (arg (call-interactively 'org-table-recalculate)) + ((org-table-maybe-recalculate-line)) + (t (org-table-align))))))) + (timestamp (org-timestamp-change 0 'day)) + (otherwise + (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) + (user-error + "C-c C-c can do nothing useful at this location"))))))))) (defun org-mode-restart () "Restart Org-mode, to scan again for special lines. @@ -19269,6 +20248,13 @@ Also updates the keyword regular expressions." (let ((org-note-abort t)) (funcall org-finish-function)))) +(defun org-open-line (n) + "Insert a new row in tables, call `open-line' elsewhere." + (interactive "*p") + (if (org-at-table-p) + (org-table-insert-row) + (open-line n))) + (defun org-return (&optional indent) "Goto next table row or insert a newline. Calls `org-table-next-row' or `newline', depending on context. @@ -19349,13 +20335,13 @@ Calls `org-table-insert-hline', `org-toggle-item', or "Convert headings or normal lines to items, items to normal lines. If there is no active region, only the current line is considered. -If the first non blank line in the region is an headline, convert +If the first non blank line in the region is a headline, convert all headlines to items, shifting text accordingly. If it is an item, convert all items to normal lines. -If it is normal text, change region into an item. With a prefix -argument ARG, change each line in region into an item." +If it is normal text, change region into a list of items. +With a prefix argument ARG, change the region in a single item." (interactive "P") (let ((shift-text (function @@ -19448,19 +20434,10 @@ argument ARG, change each line in region into an item." (funcall shift-text (+ start-ind (* (1+ delta) bul-len)) (min end section-end))))))) - ;; Case 3. Normal line with ARG: turn each non-item line into - ;; an item. - (arg - (while (< (point) end) - (unless (or (org-at-heading-p) (org-at-item-p)) - (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") - (replace-match - (concat "\\1" (org-list-bullet-string "-") "\\2")))) - (forward-line))) - ;; Case 4. Normal line without ARG: make the first line of - ;; region an item, and shift indentation of others - ;; lines to set them as item's body. - (t (let* ((bul (org-list-bullet-string "-")) + ;; Case 3. Normal line with ARG: make the first line of region + ;; an item, and shift indentation of others lines to + ;; set them as item's body. + (arg (let* ((bul (org-list-bullet-string "-")) (bul-len (length bul)) (ref-ind (org-get-indentation))) (skip-chars-forward " \t") @@ -19473,29 +20450,40 @@ argument ARG, change each line in region into an item." (+ ref-ind bul-len) (min end (save-excursion (or (outline-next-heading) (point))))) - (forward-line))))))))) + (forward-line)))) + ;; Case 4. Normal line without ARG: turn each non-item line + ;; into an item. + (t + (while (< (point) end) + (unless (or (org-at-heading-p) (org-at-item-p)) + (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") + (replace-match + (concat "\\1" (org-list-bullet-string "-") "\\2")))) + (forward-line)))))))) (defun org-toggle-heading (&optional nstars) "Convert headings to normal text, or items or text to headings. -If there is no active region, only the current line is considered. +If there is no active region, only convert the current line. With a \\[universal-argument] prefix, convert the whole list at point into heading. In a region: -- If the first non blank line is an headline, remove the stars +- If the first non blank line is a headline, remove the stars from all headlines in the region. -- If it is a normal line turn each and every normal line (i.e. not an - heading or an item) in the region into a heading. +- If it is a normal line, turn each and every normal line (i.e., + not an heading or an item) in the region into headings. If you + want to convert only the first line of this region, use one + universal prefix argument. - If it is a plain list item, turn all plain list items into headings. When converting a line into a heading, the number of stars is chosen such that the lines become children of the current entry. However, -when a prefix argument is given, its value determines the number of -stars to add." +when a numeric prefix argument is given, its value determines the +number of stars to add." (interactive "P") (let ((skip-blanks (function @@ -19513,7 +20501,7 @@ stars to add." ;; do not consider the last line to be in the region. (when (and current-prefix-arg (org-at-item-p)) - (if (equal current-prefix-arg '(4)) (setq current-prefix-arg 1)) + (if (listp current-prefix-arg) (setq current-prefix-arg 1)) (org-mark-element)) (if (org-region-active-p) @@ -19539,10 +20527,9 @@ stars to add." ;; One star will be added by `org-list-to-subtree'. ((org-at-item-p) (let* ((stars (make-string - (if nstars - ;; subtract the star that will be added again by - ;; `org-list-to-subtree' - (1- (prefix-numeric-value current-prefix-arg)) + ;; subtract the star that will be added again by + ;; `org-list-to-subtree' + (if (numberp nstars) (1- nstars) (or (org-current-level) 0)) ?*)) (add-stars @@ -19566,18 +20553,17 @@ stars to add." (forward-line)))) ;; Case 3. Started at normal text: make every line an heading, ;; skipping headlines and items. - (t (let* ((stars (make-string - (if nstars - (prefix-numeric-value current-prefix-arg) - (or (org-current-level) 0)) - ?*)) + (t (let* ((stars + (make-string + (if (numberp nstars) nstars (or (org-current-level) 0)) ?*)) (add-stars (cond (nstars "") ; stars from prefix only ((equal stars "") "*") ; before first heading (org-odd-levels-only "**") ; inside heading, odd (t "*"))) ; inside heading, oddeven - (rpl (concat stars add-stars " "))) - (while (< (point) end) + (rpl (concat stars add-stars " ")) + (lend (if (listp nstars) (save-excursion (end-of-line) (point))))) + (while (< (point) (if (equal nstars '(4)) lend end)) (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p))) (looking-at "\\([ \t]*\\)\\(\\S-\\)")) (replace-match (concat rpl (match-string 2))) (setq toggled t)) @@ -19828,7 +20814,7 @@ See the individual commands for more information." ["Timeline" org-timeline t] ["Tags/Property tree" org-match-sparse-tree t]) "--" - ["Export/Publish..." org-export t] + ["Export/Publish..." org-export-dispatch t] ("LaTeX" ["Org CDLaTeX mode" org-cdlatex-mode :style toggle :selected org-cdlatex-mode] @@ -19838,8 +20824,7 @@ See the individual commands for more information." (org-inside-LaTeX-fragment-p)] ["Insert citation" org-reftex-citation t] "--" - ["Template for BEAMER" (progn (require 'org-beamer) - (org-insert-beamer-options-template)) t]) + ["Template for BEAMER" (org-beamer-insert-options-template) t]) "--" ("MobileOrg" ["Push Files and Views" org-mobile-push t] @@ -19954,55 +20939,63 @@ Your bug report will be posted to the Org-mode mailing list. (defun org-require-autoloaded-modules () (interactive) (mapc 'require - '(org-agenda org-archive org-ascii org-attach org-clock org-colview - org-docbook org-exp org-html org-icalendar - org-id org-latex - org-publish org-remember org-table - org-timer org-xoxo))) + '(org-agenda org-archive org-attach org-clock org-colview org-id + org-remember org-table org-timer))) ;;;###autoload (defun org-reload (&optional uncompiled) "Reload all org lisp files. With prefix arg UNCOMPILED, load the uncompiled versions." (interactive "P") - (require 'find-func) - (let* ((file-re "^org\\(-.*\\)?\\.el") - (dir-org (file-name-directory (org-find-library-dir "org"))) - (dir-org-contrib (ignore-errors - (file-name-directory - (org-find-library-dir "org-contribdir")))) - (babel-files - (mapcar (lambda (el) (concat "ob" (when el (format "-%s" el)) ".el")) - (append (list nil "comint" "eval" "exp" "keys" - "lob" "ref" "table" "tangle") - (delq nil - (mapcar - (lambda (lang) - (when (cdr lang) (symbol-name (car lang)))) - org-babel-load-languages))))) - (files - (append babel-files - (and dir-org-contrib - (directory-files dir-org-contrib t file-re)) - (directory-files dir-org t file-re))) - (remove-re (concat (if (featurep 'xemacs) - "org-colview" "org-colview-xemacs") - "\\'"))) - (setq files (mapcar 'file-name-sans-extension files)) - (setq files (mapcar - (lambda (x) (if (string-match remove-re x) nil x)) - files)) - (setq files (delq nil files)) - (mapc - (lambda (f) - (when (featurep (intern (file-name-nondirectory f))) - (if (and (not uncompiled) - (file-exists-p (concat f ".elc"))) - (load (concat f ".elc") nil nil 'nosuffix) - (load (concat f ".el") nil nil 'nosuffix)))) - files) - (load (concat dir-org "org-version.el") 'noerror nil 'nosuffix)) - (org-version nil 'full 'message)) + (require 'loadhist) + (let* ((org-dir (org-find-library-dir "org")) + (contrib-dir (or (org-find-library-dir "org-contribdir") org-dir)) + (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?") + (remove-re (mapconcat 'identity + (mapcar (lambda (f) (concat "^" f "$")) + (list (if (featurep 'xemacs) + "org-colview" + "org-colview-xemacs") + "org" "org-loaddefs" "org-version")) + "\\|")) + (feats (delete-dups + (mapcar 'file-name-sans-extension + (mapcar 'file-name-nondirectory + (delq nil + (mapcar 'feature-file + features)))))) + (lfeat (append + (sort + (setq feats + (delq nil (mapcar + (lambda (f) + (if (and (string-match feature-re f) + (not (string-match remove-re f))) + f nil)) + feats))) + 'string-lessp) + (list "org-version" "org"))) + (load-suffixes (when (boundp 'load-suffixes) load-suffixes)) + (load-suffixes (if uncompiled (reverse load-suffixes) load-suffixes)) + load-uncore load-misses) + (setq load-misses + (delq 't + (mapcar (lambda (f) + (or (org-load-noerror-mustsuffix (concat org-dir f)) + (and (string= org-dir contrib-dir) + (org-load-noerror-mustsuffix (concat contrib-dir f))) + (and (org-load-noerror-mustsuffix (concat (org-find-library-dir f) f)) + (add-to-list 'load-uncore f 'append) + 't) + f)) + lfeat))) + (if load-uncore + (message "The following feature%s found in load-path, please check if that's correct:\n%s" + (if (> (length load-uncore) 1) "s were" " was") load-uncore)) + (if load-misses + (message "Some error occured while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s" + (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full)) + (message "Successfully reloaded Org\n%s" (org-version nil 'full))))) ;;;###autoload (defun org-customize () @@ -20090,7 +21083,10 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (defun org-in-verbatim-emphasis () (save-match-data - (and (org-in-regexp org-emph-re 2) (member (match-string 3) '("=" "~"))))) + (and (org-in-regexp org-emph-re 2) + (>= (point) (match-beginning 3)) + (<= (point) (match-end 4)) + (member (match-string 3) '("=" "~"))))) (defun org-goto-marker-or-bmk (marker &optional bookmark) "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK." @@ -20600,11 +21596,36 @@ for the search purpose." (error "Unable to create a link to here")))) (org-occur-in-agenda-files (regexp-quote link)))) -(defun org-uniquify (list) - "Remove duplicate elements from LIST." - (let (res) - (mapc (lambda (x) (add-to-list 'res x 'append)) list) - res)) +(defun org-reverse-string (string) + "Return the reverse of STRING." + (apply 'string (reverse (string-to-list string)))) + +(defsubst org-uniquify (list) + "Non-destructively remove duplicate elements from LIST." + (let ((res (copy-sequence list))) (delete-dups res))) + +(defun org-uniquify-alist (alist) + "Merge elements of ALIST with the same key. + +For example, in this alist: + +\(org-uniquify-alist '((a 1) (b 2) (a 3))) + => '((a 1 3) (b 2)) + +merge (a 1) and (a 3) into (a 1 3). + +The function returns the new ALIST." + (let (rtn) + (mapc + (lambda (e) + (let (n) + (if (not (assoc (car e) rtn)) + (push e rtn) + (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e)))) + (setq rtn (assq-delete-all (car e) rtn)) + (push n rtn)))) + alist) + rtn)) (defun org-delete-all (elts list) "Remove all elements in ELTS from LIST." @@ -20766,21 +21787,31 @@ If EXTENSIONS is given, only match these." (save-match-data (string-match (org-image-file-name-regexp extensions) file))) -(defun org-get-cursor-date () +(defun org-get-cursor-date (&optional with-time) "Return the date at cursor in as a time. This works in the calendar and in the agenda, anywhere else it just -returns the current time." - (let (date day defd) +returns the current time. +If WITH-TIME is non-nil, returns the time of the event at point (in +the agenda) or the current time of the day." + (let (date day defd tp tm hod mod) + (when with-time + (setq tp (get-text-property (point) 'time)) + (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp)) + (setq hod (string-to-number (match-string 1 tp)) + mod (string-to-number (match-string 2 tp)))) + (or tp (setq hod (nth 2 (decode-time (current-time))) + mod (nth 1 (decode-time (current-time)))))) (cond ((eq major-mode 'calendar-mode) (setq date (calendar-cursor-to-date) - defd (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) + defd (encode-time 0 (or mod 0) (or hod 0) + (nth 1 date) (nth 0 date) (nth 2 date)))) ((eq major-mode 'org-agenda-mode) (setq day (get-text-property (point) 'day)) (if day (setq date (calendar-gregorian-from-absolute day) - defd (encode-time 0 0 0 (nth 1 date) (nth 0 date) - (nth 2 date)))))) + defd (encode-time 0 (or mod 0) (or hod 0) + (nth 1 date) (nth 0 date) (nth 2 date)))))) (or defd (current-time)))) (defun org-mark-subtree (&optional up) @@ -20791,13 +21822,14 @@ hierarchy of headlines by UP levels before marking the subtree." (interactive "P") (org-with-limited-levels (cond ((org-at-heading-p) (beginning-of-line)) - ((org-before-first-heading-p) (error "Not in a subtree")) + ((org-before-first-heading-p) (user-error "Not in a subtree")) (t (outline-previous-visible-heading 1)))) (when up (while (and (> up 0) (org-up-heading-safe)) (decf up))) (if (org-called-interactively-p 'any) (call-interactively 'org-mark-element) (org-mark-element))) + ;;; Indentation (defun org-indent-line () @@ -20819,8 +21851,6 @@ hierarchy of headlines by UP levels before marking the subtree." (cond ;; Headings ((looking-at org-outline-regexp) (setq column 0)) - ;; Included files - ((looking-at "#\\+include:") (setq column 0)) ;; Footnote definition ((looking-at org-footnote-definition-re) (setq column 0)) ;; Literal examples @@ -20876,15 +21906,19 @@ hierarchy of headlines by UP levels before marking the subtree." (re-search-backward "[ \t]*#\\+begin_"nil t)) (looking-at "[ \t]*[\n:#|]") (looking-at org-footnote-definition-re) - (and (ignore-errors (goto-char (org-in-item-p))) - (goto-char - (org-list-get-top-point (org-list-struct)))) (and (not inline-task-p) (featurep 'org-inlinetask) (org-inlinetask-in-task-p) (or (org-inlinetask-goto-beginning) t)))) (beginning-of-line 0)) (cond + ;; There was a list item above. + ((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)))) ;; There was an heading above. ((looking-at "\\*+[ \t]+") (if (not org-adapt-indentation) @@ -21017,7 +22051,6 @@ hierarchy of headlines by UP levels before marking the subtree." (not (looking-at org-ts-regexp-both)))) (declare-function message-in-body-p "message" ()) -(defvar org-element--affiliated-re) ; From org-element.el (defvar orgtbl-line-start-regexp) ; From org-table.el (defun org-adaptive-fill-function () "Compute a fill prefix for the current line. @@ -21037,19 +22070,22 @@ meant to be filled." (throw 'exit (make-string (length (match-string 0)) ? )))))) (org-with-wide-buffer (let* ((p (line-beginning-position)) - (element (save-excursion (beginning-of-line) (org-element-at-point))) + (element (save-excursion + (beginning-of-line) + (or (ignore-errors (org-element-at-point)) + (user-error "An element cannot be parsed line %d" + (line-number-at-pos (point)))))) (type (org-element-type element)) - (post-affiliated - (save-excursion - (goto-char (org-element-property :begin element)) - (while (looking-at org-element--affiliated-re) (forward-line)) - (point)))) - (unless (< p post-affiliated) + (post-affiliated (org-element-property :post-affiliated element))) + (unless (and post-affiliated (< p post-affiliated)) (case type (comment (looking-at "[ \t]*# ?") (match-string 0)) (footnote-definition "") ((item plain-list) - (make-string (org-list-item-body-column post-affiliated) ? )) + (make-string (org-list-item-body-column + (or post-affiliated + (org-element-property :begin element))) + ? )) (paragraph ;; Fill prefix is usually the same as the current line, ;; except if the paragraph is at the beginning of an item. @@ -21077,7 +22113,6 @@ meant to be filled." (declare-function message-goto-body "message" ()) (defvar message-cite-prefix-regexp) ; From message.el -(defvar org-element-all-objects) ; From org-element.el (defun org-fill-paragraph (&optional justify) "Fill element at point, when applicable. @@ -21106,94 +22141,93 @@ a footnote definition, try to fill the first paragraph within." (paragraph-separate (cadadr (assoc 'paragraph-separate org-fb-vars)))) (fill-paragraph nil)) - (save-excursion + (with-syntax-table org-mode-transpose-word-syntax-table ;; Move to end of line in order to get the first paragraph ;; within a plain list or a footnote definition. - (end-of-line) - (let ((element (org-element-at-point))) + (let ((element (save-excursion + (end-of-line) + (or (ignore-errors (org-element-at-point)) + (user-error "An element cannot be parsed line %d" + (line-number-at-pos (point))))))) ;; First check if point is in a blank line at the beginning of ;; the buffer. In that case, ignore filling. - (if (< (point) (org-element-property :begin element)) t - (case (org-element-type element) - ;; Use major mode filling function is src blocks. - (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) - ;; Align Org tables, leave table.el tables as-is. - (table-row (org-table-align) t) - (table - (when (eq (org-element-property :type element) 'org) - (org-table-align)) - t) - (paragraph - ;; Paragraphs may contain `line-break' type objects. - (let ((beg (max (point-min) - (org-element-property :contents-begin element))) - (end (min (point-max) - (org-element-property :contents-end element)))) - ;; Do nothing if point is at an affiliated keyword. - (if (< (point) beg) t - (when (derived-mode-p 'message-mode) - ;; In `message-mode', do not fill following - ;; citation in current paragraph nor text before - ;; message body. - (let ((body-start (save-excursion (message-goto-body)))) - (when body-start (setq beg (max body-start beg)))) - (when (save-excursion - (re-search-forward - (concat "^" message-cite-prefix-regexp) end t)) - (setq end (match-beginning 0)))) - ;; Fill paragraph, taking line breaks into - ;; consideration. For that, slice the paragraph - ;; using line breaks as separators, and fill the - ;; parts in reverse order to avoid messing with - ;; markers. - (save-excursion - (goto-char end) - (mapc - (lambda (pos) - (fill-region-as-paragraph pos (point) justify) - (goto-char pos)) - ;; Find the list of ending positions for line - ;; breaks in the current paragraph. Add paragraph - ;; beginning to include first slice. - (nreverse - (cons - beg - (org-element-map - (org-element--parse-objects - beg end nil org-element-all-objects) - 'line-break - (lambda (lb) (org-element-property :end lb))))))) - t))) - ;; Contents of `comment-block' type elements should be - ;; filled as plain text, but only if point is within block - ;; markers. - (comment-block - (let* ((case-fold-search t) - (beg (save-excursion - (goto-char (org-element-property :begin element)) - (re-search-forward "^[ \t]*#\\+begin_comment" nil t) - (forward-line) - (point))) - (end (save-excursion - (goto-char (org-element-property :end element)) - (re-search-backward "^[ \t]*#\\+end_comment" nil t) - (line-beginning-position)))) - (when (and (>= (point) beg) (< (point) end)) - (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) - ;; Fill comments. - (comment (fill-comment-paragraph justify)) - ;; Ignore every other element. - (otherwise t))))))) + (case (org-element-type element) + ;; Use major mode filling function is src blocks. + (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) + ;; Align Org tables, leave table.el tables as-is. + (table-row (org-table-align) t) + (table + (when (eq (org-element-property :type element) 'org) + (org-table-align)) + t) + (paragraph + ;; Paragraphs may contain `line-break' type objects. + (let ((beg (max (point-min) + (org-element-property :contents-begin element))) + (end (min (point-max) + (org-element-property :contents-end element)))) + ;; Do nothing if point is at an affiliated keyword. + (if (< (line-end-position) beg) t + (when (derived-mode-p 'message-mode) + ;; In `message-mode', do not fill following citation + ;; in current paragraph nor text before message body. + (let ((body-start (save-excursion (message-goto-body)))) + (when body-start (setq beg (max body-start beg)))) + (when (save-excursion + (re-search-forward + (concat "^" message-cite-prefix-regexp) end t)) + (setq end (match-beginning 0)))) + ;; Fill paragraph, taking line breaks into account. + ;; For that, slice the paragraph using line breaks as + ;; separators, and fill the parts in reverse order to + ;; avoid messing with markers. + (save-excursion + (goto-char end) + (mapc + (lambda (pos) + (fill-region-as-paragraph pos (point) justify) + (goto-char pos)) + ;; Find the list of ending positions for line breaks + ;; in the current paragraph. Add paragraph + ;; beginning to include first slice. + (nreverse + (cons beg + (org-element-map + (org-element--parse-objects + beg end nil (org-element-restriction 'paragraph)) + 'line-break + (lambda (lb) (org-element-property :end lb))))))) + t))) + ;; Contents of `comment-block' type elements should be + ;; filled as plain text, but only if point is within block + ;; markers. + (comment-block + (let* ((case-fold-search t) + (beg (save-excursion + (goto-char (org-element-property :begin element)) + (re-search-forward "^[ \t]*#\\+begin_comment" nil t) + (forward-line) + (point))) + (end (save-excursion + (goto-char (org-element-property :end element)) + (re-search-backward "^[ \t]*#\\+end_comment" nil t) + (line-beginning-position)))) + (when (and (>= (point) beg) (< (point) end)) + (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) + ;; Fill comments. + (comment (fill-comment-paragraph justify)) + ;; Ignore every other element. + (otherwise t)))))) (defun org-auto-fill-function () "Auto-fill function." @@ -21300,11 +22334,102 @@ contains commented lines. Otherwise, comment them." (goto-char (point-min)) (while (not (eobp)) (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) - (org-move-to-column min-indent t) + ;; Don't get fooled by invisible text (e.g. link path) + ;; when moving to column MIN-INDENT. + (let ((buffer-invisibility-spec nil)) + (org-move-to-column min-indent t)) (insert comment-start)) (forward-line)))))))) +;;; Planning + +;; This section contains tools to operate on timestamp objects, as +;; returned by, e.g. `org-element-context'. + +(defun org-timestamp-has-time-p (timestamp) + "Non-nil when TIMESTAMP has a time specified." + (org-element-property :hour-start timestamp)) + +(defun org-timestamp-format (timestamp format &optional end utc) + "Format a TIMESTAMP element into a string. + +FORMAT is a format specifier to be passed to +`format-time-string'. + +When optional argument END is non-nil, use end of date-range or +time-range, if possible. + +When optional argument UTC is non-nil, time will be expressed as +Universal Time." + (format-time-string + format + (apply 'encode-time + (cons 0 + (mapcar + (lambda (prop) (or (org-element-property prop timestamp) 0)) + (if end '(:minute-end :hour-end :day-end :month-end :year-end) + '(:minute-start :hour-start :day-start :month-start + :year-start))))) + utc)) + +(defun org-timestamp-split-range (timestamp &optional end) + "Extract a timestamp object from a date or time range. + +TIMESTAMP is a timestamp object. END, when non-nil, means extract +the end of the range. Otherwise, extract its start. + +Return a new timestamp object sharing the same parent as +TIMESTAMP." + (let ((type (org-element-property :type timestamp))) + (if (memq type '(active inactive diary)) timestamp + (let ((split-ts (list 'timestamp (copy-sequence (nth 1 timestamp))))) + ;; Set new type. + (org-element-put-property + split-ts :type (if (eq type 'active-range) 'active 'inactive)) + ;; Copy start properties over end properties if END is + ;; non-nil. Otherwise, copy end properties over `start' ones. + (let ((p-alist '((:minute-start . :minute-end) + (:hour-start . :hour-end) + (:day-start . :day-end) + (:month-start . :month-end) + (:year-start . :year-end)))) + (dolist (p-cell p-alist) + (org-element-put-property + split-ts + (funcall (if end 'car 'cdr) p-cell) + (org-element-property + (funcall (if end 'cdr 'car) p-cell) split-ts))) + ;; Eventually refresh `:raw-value'. + (org-element-put-property split-ts :raw-value nil) + (org-element-put-property + split-ts :raw-value (org-element-interpret-data split-ts))))))) + +(defun org-timestamp-translate (timestamp &optional boundary) + "Apply `org-translate-time' on a TIMESTAMP object. +When optional argument BOUNDARY is non-nil, it is either the +symbol `start' or `end'. In this case, only translate the +starting or ending part of TIMESTAMP if it is a date or time +range. Otherwise, translate both parts." + (if (and (not boundary) + (memq (org-element-property :type timestamp) + '(active-range inactive-range))) + (concat + (org-translate-time + (org-element-property :raw-value + (org-timestamp-split-range timestamp))) + "--" + (org-translate-time + (org-element-property :raw-value + (org-timestamp-split-range timestamp t)))) + (org-translate-time + (org-element-property + :raw-value + (if (not boundary) timestamp + (org-timestamp-split-range timestamp (eq boundary 'end))))))) + + + ;;; Other stuff. (defun org-toggle-fixed-width-section (arg) @@ -21524,7 +22649,7 @@ depending on context." org-ctrl-k-protect-subtree) (if (or (eq org-ctrl-k-protect-subtree 'error) (not (y-or-n-p "Kill hidden subtree along with headline? "))) - (error "C-k aborted - would kill hidden subtree"))) + (user-error "C-k aborted as it would kill a hidden subtree"))) (call-interactively (if (org-bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line))) ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")) @@ -21743,7 +22868,7 @@ make a significant difference in outlines with very many siblings." (let ((re org-outline-regexp-bol) level l) (unless (org-at-heading-p t) - (error "Not at a heading")) + (user-error "Not at a heading")) (setq level (funcall outline-level)) (save-excursion (if (not (re-search-backward re nil t)) @@ -21901,56 +23026,77 @@ clocking lines, and drawers." (point))) (defun org-forward-heading-same-level (arg &optional invisible-ok) - "Move forward to the arg'th subheading at same level as this one. + "Move forward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading. Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil it will also look at invisible ones." (interactive "p") - (org-back-to-heading invisible-ok) - (org-at-heading-p) - (let* ((level (- (match-end 0) (match-beginning 0) 1)) - (re (format "^\\*\\{1,%d\\} " level)) - l) - (forward-char 1) - (while (> arg 0) - (while (and (re-search-forward re nil 'move) - (setq l (- (match-end 0) (match-beginning 0) 1)) - (= l level) - (not invisible-ok) - (progn (backward-char 1) (outline-invisible-p))) - (if (< l level) (setq arg 1))) - (setq arg (1- arg))) + (if (not (ignore-errors (org-back-to-heading invisible-ok))) + (if (and arg (< arg 0)) + (goto-char (point-min)) + (outline-next-heading)) + (org-at-heading-p) + (let ((level (- (match-end 0) (match-beginning 0) 1)) + (f (if (and arg (< arg 0)) + 're-search-backward + 're-search-forward)) + (count (if arg (abs arg) 1)) + (result (point))) + (while (and (prog1 (> count 0) + (forward-char (if (and arg (< arg 0)) -1 1))) + (funcall f org-outline-regexp-bol nil 'move)) + (let ((l (- (match-end 0) (match-beginning 0) 1))) + (cond ((< l level) (setq count 0)) + ((and (= l level) + (or invisible-ok + (progn + (goto-char (line-beginning-position)) + (not (outline-invisible-p))))) + (setq count (1- count)) + (when (eq l level) + (setq result (point))))))) + (goto-char result)) (beginning-of-line 1))) (defun org-backward-heading-same-level (arg &optional invisible-ok) - "Move backward to the arg'th subheading at same level as this one. + "Move backward to the ARG'th subheading at same level as this one. Stop at the first and last subheadings of a superior heading." (interactive "p") - (org-back-to-heading) - (org-at-heading-p) - (let* ((level (- (match-end 0) (match-beginning 0) 1)) - (re (format "^\\*\\{1,%d\\} " level)) - l) - (while (> arg 0) - (while (and (re-search-backward re nil 'move) - (setq l (- (match-end 0) (match-beginning 0) 1)) - (= l level) - (not invisible-ok) - (outline-invisible-p)) - (if (< l level) (setq arg 1))) - (setq arg (1- arg))))) + (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok)) + +(defun org-next-block (arg &optional backward block-regexp) + "Jump to the next block. +With a prefix argument ARG, jump forward ARG many source blocks. +When BACKWARD is non-nil, jump to the previous block. +When BLOCK-REGEXP is non-nil, use this regexp to find blocks." + (interactive "p") + (let ((re (or block-regexp org-block-regexp)) + (re-search-fn (or (and backward 're-search-backward) + 're-search-forward))) + (if (looking-at re) (forward-char 1)) + (condition-case nil + (funcall re-search-fn re nil nil arg) + (error (error "No %s code blocks" (if backward "previous" "further" )))) + (goto-char (match-beginning 0)) (org-show-context))) + +(defun org-previous-block (arg &optional block-regexp) + "Jump to the previous block. +With a prefix argument ARG, jump backward ARG many source blocks. +When BLOCK-REGEXP is non-nil, use this regexp to find blocks." + (interactive "p") + (org-next-block arg t block-regexp)) (defun org-forward-element () "Move forward by one element. Move to the next element at the same level, when possible." (interactive) - (cond ((eobp) (error "Cannot move further down")) + (cond ((eobp) (user-error "Cannot move further down")) ((org-with-limited-levels (org-at-heading-p)) (let ((origin (point))) - (org-forward-heading-same-level 1) + (goto-char (org-end-of-subtree nil t)) (unless (org-with-limited-levels (org-at-heading-p)) (goto-char origin) - (error "Cannot move further down")))) + (user-error "Cannot move further down")))) (t (let* ((elem (org-element-at-point)) (end (org-element-property :end elem)) @@ -21963,15 +23109,18 @@ Move to the next element at the same level, when possible." "Move backward by one element. Move to the previous element at the same level, when possible." (interactive) - (cond ((bobp) (error "Cannot move further up")) + (cond ((bobp) (user-error "Cannot move further up")) ((org-with-limited-levels (org-at-heading-p)) - ;; At an headline, move to the previous one, if any, or stay + ;; At a headline, move to the previous one, if any, or stay ;; here. (let ((origin (point))) - (org-backward-heading-same-level 1) - (unless (org-with-limited-levels (org-at-heading-p)) - (goto-char origin) - (error "Cannot move further up")))) + (org-with-limited-levels (org-backward-heading-same-level 1)) + ;; When current headline has no sibling above, move to its + ;; parent. + (when (= (point) origin) + (or (org-with-limited-levels (org-up-heading-safe)) + (progn (goto-char origin) + (user-error "Cannot move further up")))))) (t (let* ((trail (org-element-at-point 'keep-trail)) (elem (car trail)) @@ -21989,12 +23138,12 @@ Move to the previous element at the same level, when possible." "Move to upper element." (interactive) (if (org-with-limited-levels (org-at-heading-p)) - (unless (org-up-heading-safe) (error "No surrounding element")) + (unless (org-up-heading-safe) (user-error "No surrounding element")) (let* ((elem (org-element-at-point)) (parent (org-element-property :parent elem))) (if parent (goto-char (org-element-property :begin parent)) (if (org-with-limited-levels (org-before-first-heading-p)) - (error "No surrounding element") + (user-error "No surrounding element") (org-with-limited-levels (org-back-to-heading))))))) (defvar org-element-greater-elements) @@ -22010,8 +23159,8 @@ Move to the previous element at the same level, when possible." ;; If contents are hidden, first disclose them. (when (org-element-property :hiddenp element) (org-cycle)) (goto-char (or (org-element-property :contents-begin element) - (error "No content for this element")))) - (t (error "No inner element"))))) + (user-error "No content for this element")))) + (t (user-error "No inner element"))))) (defun org-drag-element-backward () "Move backward element at point." @@ -22023,7 +23172,7 @@ Move to the previous element at the same level, when possible." ;; Error out if no previous element or previous element is ;; a parent of the current one. (if (or (not prev-elem) (org-element-nested-p elem prev-elem)) - (error "Cannot drag element backward") + (user-error "Cannot drag element backward") (let ((pos (point))) (org-element-swap-A-B prev-elem elem) (goto-char (+ (org-element-property :begin prev-elem) @@ -22035,14 +23184,14 @@ Move to the previous element at the same level, when possible." (let* ((pos (point)) (elem (org-element-at-point))) (when (= (point-max) (org-element-property :end elem)) - (error "Cannot drag element forward")) + (user-error "Cannot drag element forward")) (goto-char (org-element-property :end elem)) (let ((next-elem (org-element-at-point))) (when (or (org-element-nested-p elem next-elem) (and (eq (org-element-type next-elem) 'headline) (not (eq (org-element-type elem) 'headline)))) (goto-char pos) - (error "Cannot drag element forward")) + (user-error "Cannot drag element forward")) ;; Compute new position of point: it's shifted by NEXT-ELEM ;; body's length (without final blanks) and by the length of ;; blanks between ELEM and NEXT-ELEM. @@ -22063,6 +23212,25 @@ Move to the previous element at the same level, when possible." (org-element-swap-A-B elem next-elem) (goto-char (+ pos size-next size-blank)))))) +(defun org-drag-line-forward (arg) + "Drag the line at point ARG lines forward." + (interactive "p") + (dotimes (n (abs arg)) + (let ((c (current-column))) + (if (< 0 arg) + (progn + (beginning-of-line 2) + (transpose-lines 1) + (beginning-of-line 0)) + (transpose-lines 1) + (beginning-of-line -1)) + (org-move-to-column c)))) + +(defun org-drag-line-backward (arg) + "Drag the line at point ARG lines backward." + (interactive "p") + (org-drag-line-forward (- arg))) + (defun org-mark-element () "Put point at beginning of this element, mark at end. @@ -22116,7 +23284,7 @@ Relative indentation (between items, inside blocks, etc.) isn't modified." (interactive) (unless (eq major-mode 'org-mode) - (error "Cannot un-indent a buffer not in Org mode")) + (user-error "Cannot un-indent a buffer not in Org mode")) (let* ((parse-tree (org-element-parse-buffer 'greater-element)) unindent-tree ; For byte-compiler. (unindent-tree @@ -22246,8 +23414,8 @@ Show the heading too, if it is currently invisible." (org-show-context 'org-goto)))))) (defun org-link-display-format (link) - "Replace a link with either the description, or the link target -if no description is present" + "Replace a link with its the description. +If there is no description, use the link target." (save-match-data (if (string-match org-bracket-link-analytic-regexp link) (replace-match (if (match-end 5) @@ -22304,9 +23472,9 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (let ((default-directory dir)) (expand-file-name txt))) (unless (derived-mode-p 'org-mode) - (error "Cannot restrict to non-Org-mode file")) + (user-error "Cannot restrict to non-Org-mode file")) (org-agenda-set-restriction-lock 'file))) - (t (error "Don't know how to restrict Org-mode's agenda"))) + (t (user-error "Don't know how to restrict Org-mode's agenda"))) (move-overlay org-speedbar-restriction-lock-overlay (point-at-bol) (point-at-eol)) (setq current-prefix-arg nil) @@ -22325,9 +23493,12 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." ;;; Fixes and Hacks for problems with other packages ;; Make flyspell not check words in links, to not mess up our keymap +(defvar org-element-affiliated-keywords) ; From org-element.el +(defvar org-element-block-name-alist) ; From org-element.el (defun org-mode-flyspell-verify () "Don't let flyspell put overlays at active buttons, or on {todo,all-time,additional-option-like}-keywords." + (require 'org-element) ; For `org-element-affiliated-keywords' (let ((pos (max (1- (point)) (point-min))) (word (thing-at-point 'word))) (and (not (get-text-property pos 'keymap)) @@ -22336,7 +23507,11 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (not (member word org-all-time-keywords)) (not (member word org-options-keywords)) (not (member word (mapcar 'car org-startup-options))) - (not (member word org-additional-option-like-keywords-for-flyspell))))) + (not (member-ignore-case word org-element-affiliated-keywords)) + (not (member-ignore-case word (org-get-export-keywords))) + (not (member-ignore-case + word (mapcar 'car org-element-block-name-alist))) + (not (member-ignore-case word '("BEGIN" "END" "ATTR")))))) (defun org-remove-flyspell-overlays-in (beg end) "Remove flyspell overlays in region." @@ -22380,29 +23555,6 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (eval-after-load "session" '(add-to-list 'session-globals-exclude 'org-mark-ring)) -;;;; Experimental code - -(defun org-closed-in-range () - "Sparse tree of items closed in a certain time range. -Still experimental, may disappear in the future." - (interactive) - ;; Get the time interval from the user. - (let* ((time1 (org-float-time - (org-read-date nil 'to-time nil "Starting date: "))) - (time2 (org-float-time - (org-read-date nil 'to-time nil "End date:"))) - ;; callback function - (callback (lambda () - (let ((time - (org-float-time - (apply 'encode-time - (org-parse-time-string - (match-string 1)))))) - ;; check if time in interval - (and (>= time time1) (<= time time2)))))) - ;; make tree, check each match with the callback - (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) - ;;;; Finish up (provide 'org) diff --git a/contrib/lisp/org-e-ascii.el b/lisp/ox-ascii.el similarity index 59% rename from contrib/lisp/org-e-ascii.el rename to lisp/ox-ascii.el index 8391664cb..2191539bf 100644 --- a/contrib/lisp/org-e-ascii.el +++ b/lisp/ox-ascii.el @@ -1,33 +1,35 @@ -;;; org-e-ascii.el --- ASCII Back-End For Org Export Engine +;;; ox-ascii.el --- ASCII Back-End for Org Export Engine ;; Copyright (C) 2012, 2013 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou ;; Keywords: outlines, hypermedia, calendar, wp -;; This program is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; ;; This library implements an ASCII back-end for Org generic exporter. ;; ;; It provides two commands for export, depending on the desired -;; output: `org-e-ascii-export-as-ascii' (temporary buffer) and -;; `org-e-ascii-export-to-ascii' ("txt" file). +;; output: `org-ascii-export-as-ascii' (temporary buffer) and +;; `org-ascii-export-to-ascii' ("txt" file). Also, three publishing +;; functions are available: `org-ascii-publish-to-ascii', +;; `org-ascii-publish-to-latin1' and `org-ascii-publish-to-utf8'. ;; -;; Output encoding is specified through `org-e-ascii-charset' -;; variable, among `ascii', `latin1' and `utf-8' symbols. +;; Output encoding is specified through `org-ascii-charset' variable, +;; among `ascii', `latin1' and `utf-8' symbols. ;; ;; By default, horizontal rules span over the full text with, but with ;; a given width attribute (set though #+ATTR_ASCII: :width ) @@ -36,7 +38,8 @@ ;;; Code: (eval-when-compile (require 'cl)) -(require 'org-export) +(require 'ox) +(require 'ox-publish) (declare-function aa2u "ext:ascii-art-to-unicode" ()) @@ -45,106 +48,140 @@ ;; The following setting won't allow to modify preferred charset ;; through a buffer keyword or an option item, but, since the property ;; will appear in communication channel nonetheless, it allows to -;; override `org-e-ascii-charset' variable on the fly by the ext-plist +;; override `org-ascii-charset' variable on the fly by the ext-plist ;; mechanism. ;; ;; We also install a filter for headlines and sections, in order to ;; control blank lines separating them in output string. -(org-export-define-backend e-ascii - ((bold . org-e-ascii-bold) - (center-block . org-e-ascii-center-block) - (clock . org-e-ascii-clock) - (code . org-e-ascii-code) - (drawer . org-e-ascii-drawer) - (dynamic-block . org-e-ascii-dynamic-block) - (entity . org-e-ascii-entity) - (example-block . org-e-ascii-example-block) - (export-block . org-e-ascii-export-block) - (export-snippet . org-e-ascii-export-snippet) - (fixed-width . org-e-ascii-fixed-width) - (footnote-definition . org-e-ascii-footnote-definition) - (footnote-reference . org-e-ascii-footnote-reference) - (headline . org-e-ascii-headline) - (horizontal-rule . org-e-ascii-horizontal-rule) - (inline-src-block . org-e-ascii-inline-src-block) - (inlinetask . org-e-ascii-inlinetask) - (italic . org-e-ascii-italic) - (item . org-e-ascii-item) - (keyword . org-e-ascii-keyword) - (latex-environment . org-e-ascii-latex-environment) - (latex-fragment . org-e-ascii-latex-fragment) - (line-break . org-e-ascii-line-break) - (link . org-e-ascii-link) - (macro . org-e-ascii-macro) - (paragraph . org-e-ascii-paragraph) - (plain-list . org-e-ascii-plain-list) - (plain-text . org-e-ascii-plain-text) - (planning . org-e-ascii-planning) - (quote-block . org-e-ascii-quote-block) - (quote-section . org-e-ascii-quote-section) - (radio-target . org-e-ascii-radio-target) - (section . org-e-ascii-section) - (special-block . org-e-ascii-special-block) - (src-block . org-e-ascii-src-block) - (statistics-cookie . org-e-ascii-statistics-cookie) - (strike-through . org-e-ascii-strike-through) - (subscript . org-e-ascii-subscript) - (superscript . org-e-ascii-superscript) - (table . org-e-ascii-table) - (table-cell . org-e-ascii-table-cell) - (table-row . org-e-ascii-table-row) - (target . org-e-ascii-target) - (template . org-e-ascii-template) - (timestamp . org-e-ascii-timestamp) - (underline . org-e-ascii-underline) - (verbatim . org-e-ascii-verbatim) - (verse-block . org-e-ascii-verse-block)) +(org-export-define-backend 'ascii + '((bold . org-ascii-bold) + (center-block . org-ascii-center-block) + (clock . org-ascii-clock) + (code . org-ascii-code) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (drawer . org-ascii-drawer) + (dynamic-block . org-ascii-dynamic-block) + (entity . org-ascii-entity) + (example-block . org-ascii-example-block) + (export-block . org-ascii-export-block) + (export-snippet . org-ascii-export-snippet) + (fixed-width . org-ascii-fixed-width) + (footnote-definition . org-ascii-footnote-definition) + (footnote-reference . org-ascii-footnote-reference) + (headline . org-ascii-headline) + (horizontal-rule . org-ascii-horizontal-rule) + (inline-src-block . org-ascii-inline-src-block) + (inlinetask . org-ascii-inlinetask) + (inner-template . org-ascii-inner-template) + (italic . org-ascii-italic) + (item . org-ascii-item) + (keyword . org-ascii-keyword) + (latex-environment . org-ascii-latex-environment) + (latex-fragment . org-ascii-latex-fragment) + (line-break . org-ascii-line-break) + (link . org-ascii-link) + (paragraph . org-ascii-paragraph) + (plain-list . org-ascii-plain-list) + (plain-text . org-ascii-plain-text) + (planning . org-ascii-planning) + (quote-block . org-ascii-quote-block) + (quote-section . org-ascii-quote-section) + (radio-target . org-ascii-radio-target) + (section . org-ascii-section) + (special-block . org-ascii-special-block) + (src-block . org-ascii-src-block) + (statistics-cookie . org-ascii-statistics-cookie) + (strike-through . org-ascii-strike-through) + (subscript . org-ascii-subscript) + (superscript . org-ascii-superscript) + (table . org-ascii-table) + (table-cell . org-ascii-table-cell) + (table-row . org-ascii-table-row) + (target . org-ascii-target) + (template . org-ascii-template) + (timestamp . org-ascii-timestamp) + (underline . org-ascii-underline) + (verbatim . org-ascii-verbatim) + (verse-block . org-ascii-verse-block)) :export-block "ASCII" - :filters-alist ((:filter-headline . org-e-ascii-filter-headline-blank-lines) - (:filter-section . org-e-ascii-filter-headline-blank-lines)) - :options-alist ((:ascii-charset nil nil org-e-ascii-charset))) + :menu-entry + '(?t "Export to Plain Text" + ((?A "As ASCII buffer" + (lambda (a s v b) + (org-ascii-export-as-ascii a s v b '(:ascii-charset ascii)))) + (?a "As ASCII file" + (lambda (a s v b) + (org-ascii-export-to-ascii a s v b '(:ascii-charset ascii)))) + (?L "As Latin1 buffer" + (lambda (a s v b) + (org-ascii-export-as-ascii a s v b '(:ascii-charset latin1)))) + (?l "As Latin1 file" + (lambda (a s v b) + (org-ascii-export-to-ascii a s v b '(:ascii-charset latin1)))) + (?U "As UTF-8 buffer" + (lambda (a s v b) + (org-ascii-export-as-ascii a s v b '(:ascii-charset utf-8)))) + (?u "As UTF-8 file" + (lambda (a s v b) + (org-ascii-export-to-ascii a s v b '(:ascii-charset utf-8)))))) + :filters-alist '((:filter-headline . org-ascii-filter-headline-blank-lines) + (:filter-parse-tree org-ascii-filter-paragraph-spacing + org-ascii-filter-comment-spacing) + (:filter-section . org-ascii-filter-headline-blank-lines)) + :options-alist '((:ascii-charset nil nil org-ascii-charset))) ;;; User Configurable Variables -(defgroup org-export-e-ascii nil +(defgroup org-export-ascii nil "Options for exporting Org mode files to ASCII." :tag "Org Export ASCII" :group 'org-export) -(defcustom org-e-ascii-text-width 72 +(defcustom org-ascii-text-width 72 "Maximum width of exported text. This number includes margin size, as set in -`org-e-ascii-global-margin'." - :group 'org-export-e-ascii +`org-ascii-global-margin'." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type 'integer) -(defcustom org-e-ascii-global-margin 0 +(defcustom org-ascii-global-margin 0 "Width of the left margin, in number of characters." - :group 'org-export-e-ascii + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type 'integer) -(defcustom org-e-ascii-inner-margin 2 +(defcustom org-ascii-inner-margin 2 "Width of the inner margin, in number of characters. Inner margin is applied between each headline." - :group 'org-export-e-ascii + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type 'integer) -(defcustom org-e-ascii-quote-margin 6 +(defcustom org-ascii-quote-margin 6 "Width of margin used for quoting text, in characters. This margin is applied on both sides of the text." - :group 'org-export-e-ascii + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type 'integer) -(defcustom org-e-ascii-inlinetask-width 30 +(defcustom org-ascii-inlinetask-width 30 "Width of inline tasks, in number of characters. This number ignores any margin." - :group 'org-export-e-ascii + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type 'integer) -(defcustom org-e-ascii-headline-spacing '(1 . 2) +(defcustom org-ascii-headline-spacing '(1 . 2) "Number of blank lines inserted around headlines. This variable can be set to a cons cell. In that case, its car @@ -154,28 +191,56 @@ contents. A nil value replicates the number of blank lines found in the original Org buffer at the same place." - :group 'org-export-e-ascii + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type '(choice (const :tag "Replicate original spacing" nil) (cons :tag "Set an uniform spacing" (integer :tag "Number of blank lines before contents") (integer :tag "Number of blank lines after contents")))) -(defcustom org-e-ascii-charset 'ascii +(defcustom org-ascii-indented-line-width 'auto + "Additional indentation width for the first line in a paragraph. +If the value is an integer, indent the first line of each +paragraph by this number. If it is the symbol `auto' preserve +indentation from original document." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (integer :tag "Number of white spaces characters") + (const :tag "Preserve original width" auto))) + +(defcustom org-ascii-paragraph-spacing 'auto + "Number of white lines between paragraphs. +If the value is an integer, add this number of blank lines +between contiguous paragraphs. If is it the symbol `auto', keep +the same number of blank lines as in the original document." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (integer :tag "Number of blank lines") + (const :tag "Preserve original spacing" auto))) + +(defcustom org-ascii-charset 'ascii "The charset allowed to represent various elements and objects. Possible values are: `ascii' Only use plain ASCII characters `latin1' Include Latin-1 characters `utf-8' Use all UTF-8 characters" - :group 'org-export-e-ascii + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type '(choice (const :tag "ASCII" ascii) (const :tag "Latin-1" latin1) (const :tag "UTF-8" utf-8))) -(defcustom org-e-ascii-underline '((ascii ?= ?~ ?-) - (latin1 ?= ?~ ?-) - (utf-8 ?═ ?─ ?╌ ?┄ ?┈)) +(defcustom org-ascii-underline '((ascii ?= ?~ ?-) + (latin1 ?= ?~ ?-) + (utf-8 ?═ ?─ ?╌ ?┄ ?┈)) "Characters for underlining headings in ASCII export. Alist whose key is a symbol among `ascii', `latin1' and `utf-8' @@ -185,7 +250,9 @@ For each supported charset, this variable associates a sequence of underline characters. In a sequence, the characters will be used in order for headlines level 1, 2, ... If no character is available for a given level, the headline won't be underlined." - :group 'org-export-e-ascii + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type '(list (cons :tag "Underline characters sequence" (const :tag "ASCII charset" ascii) @@ -197,9 +264,9 @@ available for a given level, the headline won't be underlined." (const :tag "UTF-8 charset" utf-8) (repeat character)))) -(defcustom org-e-ascii-bullets '((ascii ?* ?+ ?-) - (latin1 ?§ ?¶) - (utf-8 ?◊)) +(defcustom org-ascii-bullets '((ascii ?* ?+ ?-) + (latin1 ?§ ?¶) + (utf-8 ?◊)) "Bullet characters for headlines converted to lists in ASCII export. Alist whose key is a symbol among `ascii', `latin1' and `utf-8' @@ -211,7 +278,9 @@ here, the list will be repeated. Note that this variable doesn't affect plain lists representation." - :group 'org-export-e-ascii + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type '(list (cons :tag "Bullet characters for low level headlines" (const :tag "ASCII charset" ascii) @@ -223,51 +292,65 @@ representation." (const :tag "UTF-8 charset" utf-8) (repeat character)))) -(defcustom org-e-ascii-links-to-notes t +(defcustom org-ascii-links-to-notes t "Non-nil means convert links to notes before the next headline. When nil, the link will be exported in place. If the line becomes long in this way, it will be wrapped." - :group 'org-export-e-ascii + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) -(defcustom org-e-ascii-table-keep-all-vertical-lines nil +(defcustom org-ascii-table-keep-all-vertical-lines nil "Non-nil means keep all vertical lines in ASCII tables. When nil, vertical lines will be removed except for those needed for column grouping." - :group 'org-export-e-ascii + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) -(defcustom org-e-ascii-table-widen-columns t +(defcustom org-ascii-table-widen-columns t "Non-nil means widen narrowed columns for export. When nil, narrowed columns will look in ASCII export just like in Org mode, i.e. with \"=>\" as ellipsis." - :group 'org-export-e-ascii + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) -(defcustom org-e-ascii-table-use-ascii-art nil +(defcustom org-ascii-table-use-ascii-art nil "Non-nil means table.el tables are turned into ascii-art. It only makes sense when export charset is `utf-8'. It is nil by default since it requires ascii-art-to-unicode.el package. You can download it here: - http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el.") - -(defcustom org-e-ascii-caption-above nil - "When non-nil, place caption string before the element. -Otherwise, place it right after it." - :group 'org-export-e-ascii + http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) -(defcustom org-e-ascii-verbatim-format "`%s'" +(defcustom org-ascii-caption-above nil + "When non-nil, place caption string before the element. +Otherwise, place it right after it." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-ascii-verbatim-format "`%s'" "Format string used for verbatim text and inline code." - :group 'org-export-e-ascii + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type 'string) -(defcustom org-e-ascii-format-drawer-function nil +(defcustom org-ascii-format-drawer-function nil "Function called to format a drawer in ASCII. -The function must accept two parameters: +The function must accept three parameters: NAME the drawer name, like \"LOGBOOK\" CONTENTS the contents of the drawer. WIDTH the text width within the drawer. @@ -278,13 +361,15 @@ nil to ignore the drawer. For example, the variable could be set to the following function in order to mimic default behaviour: -\(defun org-e-ascii-format-drawer-default \(name contents width\) +\(defun org-ascii-format-drawer-default (name contents width) \"Format a drawer element for ASCII export.\" - contents\)" - :group 'org-export-e-ascii + contents)" + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type 'function) -(defcustom org-e-ascii-format-inlinetask-function nil +(defcustom org-ascii-format-inlinetask-function nil "Function called to format an inlinetask in ASCII. The function must accept six parameters: @@ -301,20 +386,20 @@ nil to ignore the inline task. For example, the variable could be set to the following function in order to mimic default behaviour: -\(defun org-e-ascii-format-inlinetask-default +\(defun org-ascii-format-inlinetask-default \(todo type priority name tags contents\) \"Format an inline task element for ASCII export.\" \(let* \(\(utf8p \(eq \(plist-get info :ascii-charset\) 'utf-8\)\) - \(width org-e-ascii-inlinetask-width\) - \(org-e-ascii--indent-string + \(width org-ascii-inlinetask-width\) + \(org-ascii--indent-string \(concat ;; Top line, with an additional blank line if not in UTF-8. \(make-string width \(if utf8p ?━ ?_\)\) \"\\n\" \(unless utf8p \(concat \(make-string width ? \) \"\\n\"\)\) ;; Add title. Fill it if wider than inlinetask. - \(let \(\(title \(org-e-ascii--build-title inlinetask info width\)\)\) + \(let \(\(title \(org-ascii--build-title inlinetask info width\)\)\) \(if \(<= \(length title\) width\) title - \(org-e-ascii--fill-string title width info\)\)\) + \(org-ascii--fill-string title width info\)\)\) \"\\n\" ;; If CONTENTS is not empty, insert it along with ;; a separator. @@ -326,8 +411,10 @@ in order to mimic default behaviour: \(- \(plist-get info :ascii-width\) \(plist-get info :ascii-margin\) \(plist-get info :ascii-inner-margin\) - \(org-e-ascii--current-text-width inlinetask info\)\)" - :group 'org-export-e-ascii + \(org-ascii--current-text-width inlinetask info\)\)" + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") :type 'function) @@ -337,32 +424,32 @@ in order to mimic default behaviour: ;; Internal functions fall into three categories. ;; The first one is about text formatting. The core function is -;; `org-e-ascii--current-text-width', which determines the current +;; `org-ascii--current-text-width', which determines the current ;; text width allowed to a given element. In other words, it helps ;; keeping each line width within maximum text width defined in -;; `org-e-ascii-text-width'. Once this information is known, -;; `org-e-ascii--fill-string', `org-e-ascii--justify-string', -;; `org-e-ascii--box-string' and `org-e-ascii--indent-string' can +;; `org-ascii-text-width'. Once this information is known, +;; `org-ascii--fill-string', `org-ascii--justify-string', +;; `org-ascii--box-string' and `org-ascii--indent-string' can ;; operate on a given output string. ;; The second category contains functions handling elements listings, -;; triggered by "#+TOC:" keyword. As such, `org-e-ascii--build-toc' -;; returns a complete table of contents, `org-e-ascii--list-listings' +;; triggered by "#+TOC:" keyword. As such, `org-ascii--build-toc' +;; returns a complete table of contents, `org-ascii--list-listings' ;; returns a list of referenceable src-block elements, and -;; `org-e-ascii--list-tables' does the same for table elements. +;; `org-ascii--list-tables' does the same for table elements. ;; The third category includes general helper functions. -;; `org-e-ascii--build-title' creates the title for a given headline -;; or inlinetask element. `org-e-ascii--build-caption' returns the +;; `org-ascii--build-title' creates the title for a given headline +;; or inlinetask element. `org-ascii--build-caption' returns the ;; caption string associated to a table or a src-block. -;; `org-e-ascii--describe-links' creates notes about links for +;; `org-ascii--describe-links' creates notes about links for ;; insertion at the end of a section. It uses -;; `org-e-ascii--unique-links' to get the list of links to describe. -;; Eventually, `org-e-ascii--translate' translates a string according +;; `org-ascii--unique-links' to get the list of links to describe. +;; Eventually, `org-ascii--translate' translates a string according ;; to language and charset specification. -(defun org-e-ascii--fill-string (s text-width info &optional justify) +(defun org-ascii--fill-string (s text-width info &optional justify) "Fill a string with specified text-width and return it. S is the string being filled. TEXT-WIDTH is an integer @@ -372,20 +459,22 @@ a communication channel. Optional argument JUSTIFY can specify any type of justification among `left', `center', `right' or `full'. A nil value is equivalent to `left'. For a justification that doesn't also fill -string, see `org-e-ascii--justify-string'. +string, see `org-ascii--justify-string'. Return nil if S isn't a string." ;; Don't fill paragraph when break should be preserved. (cond ((not (stringp s)) nil) ((plist-get info :preserve-breaks) s) - (t (with-temp-buffer - (let ((fill-column text-width) - (use-hard-newlines t)) - (insert s) - (fill-region (point-min) (point-max) justify)) - (buffer-string))))) + (t (let ((double-space-p sentence-end-double-space)) + (with-temp-buffer + (let ((fill-column text-width) + (use-hard-newlines t) + (sentence-end-double-space double-space-p)) + (insert s) + (fill-region (point-min) (point-max) justify)) + (buffer-string)))))) -(defun org-e-ascii--justify-string (s text-width how) +(defun org-ascii--justify-string (s text-width how) "Justify string S. TEXT-WIDTH is an integer specifying maximum length of a line. HOW determines the type of justification: it can be `left', @@ -393,20 +482,23 @@ HOW determines the type of justification: it can be `left', (with-temp-buffer (insert s) (goto-char (point-min)) - (let ((fill-column text-width)) + (let ((fill-column text-width) + ;; Disable `adaptive-fill-mode' so it doesn't prevent + ;; filling lines matching `adaptive-fill-regexp'. + (adaptive-fill-mode nil)) (while (< (point) (point-max)) (justify-current-line how) (forward-line))) (buffer-string))) -(defun org-e-ascii--indent-string (s width) +(defun org-ascii--indent-string (s width) "Indent string S by WIDTH white spaces. Empty lines are not indented." (when (stringp s) (replace-regexp-in-string "\\(^\\)\\(?:.*\\S-\\)" (make-string width ? ) s nil nil 1))) -(defun org-e-ascii--box-string (s info) +(defun org-ascii--box-string (s info) "Return string S with a partial box to its left. INFO is a plist used as a communicaton channel." (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) @@ -416,16 +508,16 @@ INFO is a plist used as a communicaton channel." ;; Remove last newline character. (replace-regexp-in-string "\n[ \t]*\\'" "" s))))) -(defun org-e-ascii--current-text-width (element info) +(defun org-ascii--current-text-width (element info) "Return maximum text width for ELEMENT's contents. INFO is a plist used as a communication channel." (case (org-element-type element) ;; Elements with an absolute width: `headline' and `inlinetask'. - (inlinetask org-e-ascii-inlinetask-width) + (inlinetask org-ascii-inlinetask-width) ('headline - (- org-e-ascii-text-width + (- org-ascii-text-width (let ((low-level-rank (org-export-low-level-p element info))) - (if low-level-rank (* low-level-rank 2) org-e-ascii-global-margin)))) + (if low-level-rank (* low-level-rank 2) org-ascii-global-margin)))) ;; Elements with a relative width: store maximum text width in ;; TOTAL-WIDTH. (otherwise @@ -435,10 +527,10 @@ INFO is a plist used as a communication channel." (total-width (if (loop for parent in genealogy thereis (eq (org-element-type parent) 'inlinetask)) - org-e-ascii-inlinetask-width + org-ascii-inlinetask-width ;; No inlinetask: Remove global margin from text width. - (- org-e-ascii-text-width - org-e-ascii-global-margin + (- org-ascii-text-width + org-ascii-global-margin (let ((parent (org-export-get-parent-headline element))) ;; Inner margin doesn't apply to text before first ;; headline. @@ -449,7 +541,7 @@ INFO is a plist used as a communication channel." ;; low level headlines, since they've got their ;; own indentation mechanism. (if low-level-rank (* low-level-rank 2) - org-e-ascii-inner-margin)))))))) + org-ascii-inner-margin)))))))) (- total-width ;; Each `quote-block', `quote-section' and `verse-block' above ;; narrows text width by twice the standard margin size. @@ -457,7 +549,7 @@ INFO is a plist used as a communication channel." when (memq (org-element-type parent) '(quote-block quote-section verse-block)) count parent) - 2 org-e-ascii-quote-margin) + 2 org-ascii-quote-margin) ;; Text width within a plain-list is restricted by ;; indentation of current item. If that's the case, ;; compute it with the help of `:structure' property from @@ -479,13 +571,13 @@ INFO is a plist used as a communication channel." (+ (- (org-list-get-ind beg-item struct) (org-list-get-ind (org-list-get-top-point struct) struct)) - (length (org-e-ascii--checkbox parent-item info)) + (length (org-ascii--checkbox parent-item info)) (length (or (org-list-get-tag beg-item struct) (org-list-get-bullet beg-item struct))))))))))))) -(defun org-e-ascii--build-title - (element info text-width &optional underline notags) +(defun org-ascii--build-title + (element info text-width &optional underline notags toc) "Format ELEMENT title and return it. ELEMENT is either an `headline' or `inlinetask' element. INFO is @@ -493,11 +585,14 @@ a plist used as a communication channel. TEXT-WIDTH is an integer representing the maximum length of a line. When optional argument UNDERLINE is non-nil, underline title, -without the tags, according to `org-e-ascii-underline' +without the tags, according to `org-ascii-underline' specifications. -if optional argument NOTAGS is nil, no tags will be added to the -title." +If optional argument NOTAGS is non-nil, no tags will be added to +the title. + +When optional argument TOC is non-nil, use optional title if +possible. It doesn't apply to `inlinetask' elements." (let* ((headlinep (eq (org-element-type element) 'headline)) (numbers ;; Numbering is specific to headlines. @@ -508,7 +603,12 @@ title." 'number-to-string (org-export-get-headline-number element info) ".") " "))) - (text (org-export-data (org-element-property :title element) info)) + (text + (org-trim + (org-export-data + (if (and toc headlinep) (org-export-get-alt-title element info) + (org-element-property :title element)) + info))) (todo (and (plist-get info :with-todo-keywords) (let ((todo (org-element-property :todo-keyword element))) @@ -538,18 +638,18 @@ title." (let ((under-char (nth (1- (org-export-get-relative-level element info)) (cdr (assq (plist-get info :ascii-charset) - org-e-ascii-underline))))) + org-ascii-underline))))) (and under-char (concat "\n" (make-string (length first-part) under-char)))))))) -(defun org-e-ascii--has-caption-p (element info) +(defun org-ascii--has-caption-p (element info) "Non-nil when ELEMENT has a caption affiliated keyword. INFO is a plist used as a communication channel. This function is meant to be used as a predicate for `org-export-get-ordinal'." (org-element-property :caption element)) -(defun org-e-ascii--build-caption (element info) +(defun org-ascii--build-caption (element info) "Return caption string for ELEMENT, if applicable. INFO is a plist used as a communication channel. @@ -557,23 +657,23 @@ INFO is a plist used as a communication channel. The caption string contains the sequence number of ELEMENT along with its real caption. Return nil when ELEMENT has no affiliated caption keyword." - (let ((caption (org-element-property :caption element))) + (let ((caption (org-export-get-caption element))) (when caption ;; Get sequence number of current src-block among every ;; src-block with a caption. (let ((reference (org-export-get-ordinal - element info nil 'org-e-ascii--has-caption-p)) - (title-fmt (org-e-ascii--translate + 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")) info))) - (org-e-ascii--fill-string - (format title-fmt reference (org-export-data (car caption) info)) - (org-e-ascii--current-text-width element info) info))))) + (org-ascii--fill-string + (format title-fmt reference (org-export-data caption info)) + (org-ascii--current-text-width element info) info))))) -(defun org-e-ascii--build-toc (info &optional n keyword) +(defun org-ascii--build-toc (info &optional n keyword) "Return a table of contents. INFO is a plist used as a communication channel. @@ -583,40 +683,42 @@ depth of the table. Optional argument KEYWORD specifies the TOC keyword, if any, from which the table of contents generation has been initiated." - (let ((title (org-e-ascii--translate "Table of Contents" info))) + (let ((title (org-ascii--translate "Table of Contents" info))) (concat title "\n" (make-string (length title) (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) "\n\n" (let ((text-width - (if keyword (org-e-ascii--current-text-width keyword info) - (- org-e-ascii-text-width org-e-ascii-global-margin)))) + (if keyword (org-ascii--current-text-width keyword info) + (- org-ascii-text-width org-ascii-global-margin)))) (mapconcat (lambda (headline) (let* ((level (org-export-get-relative-level headline info)) (indent (* (1- level) 3))) (concat (unless (zerop indent) (concat (make-string (1- indent) ?.) " ")) - (org-e-ascii--build-title + (org-ascii--build-title headline info (- text-width indent) nil - (eq (plist-get info :with-tags) 'not-in-toc))))) + (or (not (plist-get info :with-tags)) + (eq (plist-get info :with-tags) 'not-in-toc)) + 'toc)))) (org-export-collect-headlines info n) "\n"))))) -(defun org-e-ascii--list-listings (keyword info) +(defun org-ascii--list-listings (keyword info) "Return a list of listings. KEYWORD is the keyword that initiated the list of listings generation. INFO is a plist used as a communication channel." - (let ((title (org-e-ascii--translate "List of Listings" info))) + (let ((title (org-ascii--translate "List of Listings" info))) (concat title "\n" (make-string (length title) (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) "\n\n" (let ((text-width - (if keyword (org-e-ascii--current-text-width keyword info) - (- org-e-ascii-text-width org-e-ascii-global-margin))) + (if keyword (org-ascii--current-text-width keyword info) + (- org-ascii-text-width org-ascii-global-margin))) ;; Use a counter instead of retreiving ordinal of each ;; src-block. (count 0)) @@ -626,34 +728,35 @@ generation. INFO is a plist used as a communication channel." ;; used to properly align caption right to it in case of ;; filling (like contents of a description list item). (let ((initial-text - (format (org-e-ascii--translate "Listing %d:" info) + (format (org-ascii--translate "Listing %d:" info) (incf count)))) (concat initial-text " " (org-trim - (org-e-ascii--indent-string - (org-e-ascii--fill-string - (let ((caption (org-element-property :caption src-block))) - ;; Use short name in priority, if available. - (org-export-data (or (cdr caption) (car caption)) info)) + (org-ascii--indent-string + (org-ascii--fill-string + ;; Use short name in priority, if available. + (let ((caption (or (org-export-get-caption src-block t) + (org-export-get-caption src-block)))) + (org-export-data caption info)) (- text-width (length initial-text)) info) (length initial-text)))))) (org-export-collect-listings info) "\n"))))) -(defun org-e-ascii--list-tables (keyword info) - "Return a list of listings. +(defun org-ascii--list-tables (keyword info) + "Return a list of tables. -KEYWORD is the keyword that initiated the list of listings +KEYWORD is the keyword that initiated the list of tables generation. INFO is a plist used as a communication channel." - (let ((title (org-e-ascii--translate "List of Tables" info))) + (let ((title (org-ascii--translate "List of Tables" info))) (concat title "\n" (make-string (length title) (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) "\n\n" (let ((text-width - (if keyword (org-e-ascii--current-text-width keyword info) - (- org-e-ascii-text-width org-e-ascii-global-margin))) + (if keyword (org-ascii--current-text-width keyword info) + (- org-ascii-text-width org-ascii-global-margin))) ;; Use a counter instead of retreiving ordinal of each ;; src-block. (count 0)) @@ -663,24 +766,25 @@ generation. INFO is a plist used as a communication channel." ;; used to properly align caption right to it in case of ;; filling (like contents of a description list item). (let ((initial-text - (format (org-e-ascii--translate "Table %d:" info) + (format (org-ascii--translate "Table %d:" info) (incf count)))) (concat initial-text " " (org-trim - (org-e-ascii--indent-string - (org-e-ascii--fill-string - (let ((caption (org-element-property :caption table))) - ;; Use short name in priority, if available. - (org-export-data (or (cdr caption) (car caption)) info)) + (org-ascii--indent-string + (org-ascii--fill-string + ;; Use short name in priority, if available. + (let ((caption (or (org-export-get-caption table t) + (org-export-get-caption table)))) + (org-export-data caption info)) (- text-width (length initial-text)) info) (length initial-text)))))) (org-export-collect-tables info) "\n"))))) -(defun org-e-ascii--unique-links (element info) +(defun org-ascii--unique-links (element info) "Return a list of unique link references in ELEMENT. -ELEMENT is either an headline element or a section element. INFO +ELEMENT is either a headline element or a section element. INFO is a plist used as a communication channel." (let* (seen (unique-link-p @@ -691,7 +795,12 @@ is a plist used as a communication channel." (let ((footprint (cons (org-element-property :raw-link link) (org-element-contents link)))) - (unless (member footprint seen) + ;; Ignore LINK if it hasn't been translated already. + ;; It can happen if it is located in an affiliated + ;; keyword that was ignored. + (when (and (org-string-nw-p + (gethash link (plist-get info :exported-data))) + (not (member footprint seen))) (push footprint seen) link))))) ;; If at a section, find parent headline, if any, in order to ;; count links that might be in the title. @@ -699,22 +808,22 @@ is a plist used as a communication channel." (if (eq (org-element-type element) 'headline) element (or (org-export-get-parent-headline element) element)))) ;; Get all links in HEADLINE. - (org-element-map - headline 'link (lambda (link) (funcall unique-link-p link)) info))) + (org-element-map headline 'link + (lambda (l) (funcall unique-link-p l)) info nil nil t))) -(defun org-e-ascii--describe-links (links width info) +(defun org-ascii--describe-links (links width info) "Return a string describing a list of links. LINKS is a list of link type objects, as returned by -`org-e-ascii--unique-links'. WIDTH is the text width allowed for +`org-ascii--unique-links'. WIDTH is the text width allowed for the output string. INFO is a plist used as a communication channel." (mapconcat (lambda (link) (let ((type (org-element-property :type link)) (anchor (let ((desc (org-element-contents link))) - (if (not desc) (org-element-property :raw-link link) - (org-export-data desc info))))) + (if desc (org-export-data desc info) + (org-element-property :raw-link link))))) (cond ;; Coderefs, radio links and fuzzy links are ignored. ((member type '("coderef" "radio" "fuzzy")) nil) @@ -722,13 +831,13 @@ channel." ((member type '("custom-id" "id")) (let ((dest (org-export-resolve-id-link link info))) (concat - (org-e-ascii--fill-string + (org-ascii--fill-string (format "[%s] %s" anchor - (if (not dest) (org-e-ascii--translate "Unknown reference" info) + (if (not dest) (org-ascii--translate "Unknown reference" info) (format - (org-e-ascii--translate "See section %s" info) + (org-ascii--translate "See section %s" info) (mapconcat 'number-to-string (org-export-get-headline-number dest info) ".")))) width info) "\n\n"))) @@ -738,13 +847,13 @@ channel." ((not (org-element-contents link)) nil) (t (concat - (org-e-ascii--fill-string + (org-ascii--fill-string (format "[%s] %s" anchor (org-element-property :raw-link link)) width info) "\n\n"))))) links "")) -(defun org-e-ascii--checkbox (item info) +(defun org-ascii--checkbox (item info) "Return checkbox string for ITEM or nil. INFO is a plist used as a communication channel." (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) @@ -757,17 +866,21 @@ INFO is a plist used as a communication channel." ;;; Template -(defun org-e-ascii-template--document-title (info) +(defun org-ascii-template--document-title (info) "Return document title, as a string. INFO is a plist used as a communication channel." - (let ((text-width org-e-ascii-text-width) - (title (org-export-data (plist-get info :title) info)) - (author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth (org-export-data auth info))))) - (email (and (plist-get info :with-email) - (org-export-data (plist-get info :email) info))) - (date (org-export-data (plist-get info :date) info))) + (let* ((text-width org-ascii-text-width) + ;; Links in the title will not be resolved later, so we make + ;; sure their path is located right after them. + (org-ascii-links-to-notes nil) + (title (org-export-data (plist-get info :title) info)) + (author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (and (plist-get info :with-email) + (org-export-data (plist-get info :email) info))) + (date (and (plist-get info :with-date) + (org-export-data (org-export-get-date info) info)))) ;; There are two types of title blocks depending on the presence ;; of a title to display. (if (string= title "") @@ -789,7 +902,7 @@ INFO is a plist used as a communication channel." date "\n\n\n")) ((org-string-nw-p date) (concat - (org-e-ascii--justify-string date text-width 'right) + (org-ascii--justify-string date text-width 'right) "\n\n\n")) ((and (org-string-nw-p author) (org-string-nw-p email)) (concat author "\n" email "\n\n\n")) @@ -802,12 +915,12 @@ INFO is a plist used as a communication channel." ;; Format TITLE. It may be filled if it is too wide, ;; that is wider than the two thirds of the total width. (title-len (min (length title) (/ (* 2 text-width) 3))) - (formatted-title (org-e-ascii--fill-string title title-len info)) + (formatted-title (org-ascii--fill-string title title-len info)) (line (make-string (min (+ (max title-len (length author) (length email)) 2) text-width) (if utf8p ?━ ?_)))) - (org-e-ascii--justify-string + (org-ascii--justify-string (concat line "\n" (unless utf8p "\n") (upcase formatted-title) @@ -822,40 +935,32 @@ INFO is a plist used as a communication channel." (when (org-string-nw-p date) (concat "\n\n\n" date)) "\n\n\n") text-width 'center))))) -(defun org-e-ascii-template (contents info) +(defun org-ascii-inner-template (contents info) "Return complete document string after ASCII conversion. CONTENTS is the transcoded contents string. INFO is a plist holding export options." (org-element-normalize-string - (org-e-ascii--indent-string - (let ((text-width (- org-e-ascii-text-width org-e-ascii-global-margin))) - ;; 1. Build title block. - (concat - (org-e-ascii-template--document-title info) - ;; 2. Table of contents. - (let ((depth (plist-get info :with-toc))) - (when depth - (concat - (org-e-ascii--build-toc info (and (wholenump depth) depth)) - "\n\n\n"))) - ;; 3. Document's body. - contents - ;; 4. Footnote definitions. - (let ((definitions (org-export-collect-footnote-definitions - (plist-get info :parse-tree) info)) - ;; Insert full links right inside the footnote definition - ;; as they have no chance to be inserted later. - (org-e-ascii-links-to-notes nil)) - (when definitions - (concat - "\n\n\n" - (let ((title (org-e-ascii--translate "Footnotes" info))) - (concat - title "\n" - (make-string - (length title) - (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)))) - "\n\n" + (org-ascii--indent-string + (concat + ;; 1. Document's body. + contents + ;; 2. Footnote definitions. + (let ((definitions (org-export-collect-footnote-definitions + (plist-get info :parse-tree) info)) + ;; Insert full links right inside the footnote definition + ;; as they have no chance to be inserted later. + (org-ascii-links-to-notes nil)) + (when definitions + (concat + "\n\n\n" + (let ((title (org-ascii--translate "Footnotes" info))) + (concat + title "\n" + (make-string + (length title) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)))) + "\n\n" + (let ((text-width (- org-ascii-text-width org-ascii-global-margin))) (mapconcat (lambda (ref) (let ((id (format "[%s] " (car ref)))) @@ -873,23 +978,45 @@ holding export options." (concat id "\n" (org-export-data def info)) (push id (nthcdr 2 first)) (org-export-data def info))) - ;; Fill paragraph once footnote ID is inserted in - ;; order to have a correct length for first line. - (org-e-ascii--fill-string + ;; Fill paragraph once footnote ID is inserted + ;; in order to have a correct length for first + ;; line. + (org-ascii--fill-string (concat id (org-export-data def info)) text-width info)))))) - definitions "\n\n")))) - ;; 5. Creator. Ignore `comment' value as there are no comments in - ;; ASCII. Justify it to the bottom right. - (let ((creator-info (plist-get info :with-creator))) - (unless (or (not creator-info) (eq creator-info 'comment)) - (concat - "\n\n\n" - (org-e-ascii--fill-string - (plist-get info :creator) text-width info 'right)))))) - org-e-ascii-global-margin))) + definitions "\n\n")))))) + org-ascii-global-margin))) -(defun org-e-ascii--translate (s info) +(defun org-ascii-template (contents info) + "Return complete document string after ASCII conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (concat + ;; 1. Build title block. + (org-ascii--indent-string + (concat (org-ascii-template--document-title info) + ;; 2. Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth + (concat + (org-ascii--build-toc info (and (wholenump depth) depth)) + "\n\n\n")))) + org-ascii-global-margin) + ;; 3. Document's body. + contents + ;; 4. Creator. Ignore `comment' value as there are no comments in + ;; ASCII. Justify it to the bottom right. + (org-ascii--indent-string + (let ((creator-info (plist-get info :with-creator)) + (text-width (- org-ascii-text-width org-ascii-global-margin))) + (unless (or (not creator-info) (eq creator-info 'comment)) + (concat + "\n\n\n" + (org-ascii--fill-string + (plist-get info :creator) text-width info 'right)))) + org-ascii-global-margin))) + +(defun org-ascii--translate (s info) "Translate string S according to specified language and charset. INFO is a plist used as a communication channel." (let ((charset (intern (format ":%s" (plist-get info :ascii-charset))))) @@ -899,14 +1026,9 @@ INFO is a plist used as a communication channel." ;;; Transcode Functions -;;;; Babel Call - -;; Babel Calls are ignored. - - ;;;; Bold -(defun org-e-ascii-bold (bold contents info) +(defun org-ascii-bold (bold contents info) "Transcode BOLD from Org to ASCII. CONTENTS is the text with bold markup. INFO is a plist holding contextual information." @@ -915,23 +1037,25 @@ contextual information." ;;;; Center Block -(defun org-e-ascii-center-block (center-block contents info) +(defun org-ascii-center-block (center-block contents info) "Transcode a CENTER-BLOCK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." - (org-e-ascii--justify-string - contents (org-e-ascii--current-text-width center-block info) 'center)) + (org-ascii--justify-string + contents (org-ascii--current-text-width center-block info) 'center)) ;;;; Clock -(defun org-e-ascii-clock (clock contents info) +(defun org-ascii-clock (clock contents info) "Transcode a CLOCK object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (concat org-clock-string " " - (org-translate-time (org-element-property :value clock)) - (let ((time (org-element-property :time clock))) + (org-translate-time + (org-element-property :raw-value + (org-element-property :value clock))) + (let ((time (org-element-property :duration clock))) (and time (concat " => " (apply 'format @@ -941,33 +1065,23 @@ information." ;;;; Code -(defun org-e-ascii-code (code contents info) +(defun org-ascii-code (code contents info) "Return a CODE object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (format org-e-ascii-verbatim-format (org-element-property :value code))) - - -;;;; Comment - -;; Comments are ignored. - - -;;;; Comment Block - -;; Comment Blocks are ignored. + (format org-ascii-verbatim-format (org-element-property :value code))) ;;;; Drawer -(defun org-e-ascii-drawer (drawer contents info) +(defun org-ascii-drawer (drawer contents info) "Transcode a DRAWER element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let ((name (org-element-property :drawer-name drawer)) - (width (org-e-ascii--current-text-width drawer info))) - (if (functionp org-e-ascii-format-drawer-function) - (funcall org-e-ascii-format-drawer-function name contents width) + (width (org-ascii--current-text-width drawer info))) + (if (functionp org-ascii-format-drawer-function) + (funcall org-ascii-format-drawer-function name contents width) ;; If there's no user defined function: simply ;; display contents of the drawer. contents))) @@ -975,7 +1089,7 @@ holding contextual information." ;;;; Dynamic Block -(defun org-e-ascii-dynamic-block (dynamic-block contents info) +(defun org-ascii-dynamic-block (dynamic-block contents info) "Transcode a DYNAMIC-BLOCK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -984,7 +1098,7 @@ holding contextual information." ;;;; Entity -(defun org-e-ascii-entity (entity contents info) +(defun org-ascii-entity (entity contents info) "Transcode an ENTITY object from Org to ASCII. CONTENTS are the definition itself. INFO is a plist holding contextual information." @@ -995,25 +1109,25 @@ contextual information." ;;;; Example Block -(defun org-e-ascii-example-block (example-block contents info) +(defun org-ascii-example-block (example-block contents info) "Transcode a EXAMPLE-BLOCK element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-ascii--box-string + (org-ascii--box-string (org-export-format-code-default example-block info) info)) ;;;; Export Snippet -(defun org-e-ascii-export-snippet (export-snippet contents info) +(defun org-ascii-export-snippet (export-snippet contents info) "Transcode a EXPORT-SNIPPET object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (when (eq (org-export-snippet-backend export-snippet) 'e-ascii) + (when (eq (org-export-snippet-backend export-snippet) 'ascii) (org-element-property :value export-snippet))) ;;;; Export Block -(defun org-e-ascii-export-block (export-block contents info) +(defun org-ascii-export-block (export-block contents info) "Transcode a EXPORT-BLOCK element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (when (string= (org-element-property :type export-block) "ASCII") @@ -1022,10 +1136,10 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Fixed Width -(defun org-e-ascii-fixed-width (fixed-width contents info) +(defun org-ascii-fixed-width (fixed-width contents info) "Transcode a FIXED-WIDTH element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-ascii--box-string + (org-ascii--box-string (org-remove-indentation (org-element-property :value fixed-width)) info)) @@ -1033,12 +1147,12 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Footnote Definition ;; Footnote Definitions are ignored. They are compiled at the end of -;; the document, by `org-e-ascii-template'. +;; the document, by `org-ascii-template'. ;;;; Footnote Reference -(defun org-e-ascii-footnote-reference (footnote-reference contents info) +(defun org-ascii-footnote-reference (footnote-reference contents info) "Transcode a FOOTNOTE-REFERENCE element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (format "[%s]" (org-export-get-footnote-number footnote-reference info))) @@ -1046,21 +1160,21 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Headline -(defun org-e-ascii-headline (headline contents info) - "Transcode an HEADLINE element from Org to ASCII. +(defun org-ascii-headline (headline contents info) + "Transcode a HEADLINE element from Org to ASCII. CONTENTS holds the contents of the headline. INFO is a plist holding contextual information." ;; Don't export footnote section, which will be handled at the end ;; of the template. (unless (org-element-property :footnote-section-p headline) (let* ((low-level-rank (org-export-low-level-p headline info)) - (width (org-e-ascii--current-text-width headline info)) + (width (org-ascii--current-text-width headline info)) ;; Blank lines between headline and its contents. - ;; `org-e-ascii-headline-spacing', when set, overwrites + ;; `org-ascii-headline-spacing', when set, overwrites ;; original buffer's spacing. (pre-blanks (make-string - (if org-e-ascii-headline-spacing (car org-e-ascii-headline-spacing) + (if org-ascii-headline-spacing (car org-ascii-headline-spacing) (org-element-property :pre-blank headline)) ?\n)) ;; Even if HEADLINE has no section, there might be some ;; links in its title that we shouldn't forget to describe. @@ -1068,73 +1182,70 @@ holding contextual information." (unless (or (eq (caar (org-element-contents headline)) 'section)) (let ((title (org-element-property :title headline))) (when (consp title) - (org-e-ascii--describe-links - (org-e-ascii--unique-links title info) width info)))))) + (org-ascii--describe-links + (org-ascii--unique-links title info) width info)))))) ;; Deep subtree: export it as a list item. (if low-level-rank (concat ;; Bullet. (let ((bullets (cdr (assq (plist-get info :ascii-charset) - org-e-ascii-bullets)))) + org-ascii-bullets)))) (char-to-string (nth (mod (1- low-level-rank) (length bullets)) bullets))) " " ;; Title. - (org-e-ascii--build-title headline info width) "\n" + (org-ascii--build-title headline info width) "\n" ;; Contents, indented by length of bullet. pre-blanks - (org-e-ascii--indent-string + (org-ascii--indent-string (concat contents (when (org-string-nw-p links) (concat "\n\n" links))) 2)) ;; Else: Standard headline. (concat - (org-e-ascii--build-title headline info width 'underline) + (org-ascii--build-title headline info width 'underline) "\n" pre-blanks (concat (when (org-string-nw-p links) links) contents)))))) ;;;; Horizontal Rule -(defun org-e-ascii-horizontal-rule (horizontal-rule contents info) +(defun org-ascii-horizontal-rule (horizontal-rule contents info) "Transcode an HORIZONTAL-RULE object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (let ((text-width (org-e-ascii--current-text-width horizontal-rule info)) + (let ((text-width (org-ascii--current-text-width horizontal-rule info)) (spec-width (org-export-read-attribute :attr_ascii horizontal-rule :width))) - (org-e-ascii--justify-string - (make-string (if (wholenump spec-width) spec-width text-width) + (org-ascii--justify-string + (make-string (if (and spec-width (string-match "^[0-9]+$" spec-width)) + (string-to-number spec-width) + text-width) (if (eq (plist-get info :ascii-charset) 'utf-8) ?― ?-)) text-width 'center))) -;;;; Inline Babel Call - -;; Inline Babel Calls are ignored. - - ;;;; Inline Src Block -(defun org-e-ascii-inline-src-block (inline-src-block contents info) +(defun org-ascii-inline-src-block (inline-src-block contents info) "Transcode an INLINE-SRC-BLOCK element from Org to ASCII. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (format org-e-ascii-verbatim-format + (format org-ascii-verbatim-format (org-element-property :value inline-src-block))) ;;;; Inlinetask -(defun org-e-ascii-inlinetask (inlinetask contents info) +(defun org-ascii-inlinetask (inlinetask contents info) "Transcode an INLINETASK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." - (let ((width (org-e-ascii--current-text-width inlinetask info))) - ;; If `org-e-ascii-format-inlinetask-function' is provided, call it + (let ((width (org-ascii--current-text-width inlinetask info))) + ;; If `org-ascii-format-inlinetask-function' is provided, call it ;; with appropriate arguments. - (if (functionp org-e-ascii-format-inlinetask-function) - (funcall org-e-ascii-format-inlinetask-function + (if (functionp org-ascii-format-inlinetask-function) + (funcall org-ascii-format-inlinetask-function ;; todo. (and (plist-get info :with-todo-keywords) (let ((todo (org-element-property @@ -1154,15 +1265,15 @@ holding contextual information." contents width) ;; Otherwise, use a default template. (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) - (org-e-ascii--indent-string + (org-ascii--indent-string (concat ;; Top line, with an additional blank line if not in UTF-8. (make-string width (if utf8p ?━ ?_)) "\n" (unless utf8p (concat (make-string width ? ) "\n")) ;; Add title. Fill it if wider than inlinetask. - (let ((title (org-e-ascii--build-title inlinetask info width))) + (let ((title (org-ascii--build-title inlinetask info width))) (if (<= (length title) width) title - (org-e-ascii--fill-string title width info))) + (org-ascii--fill-string title width info))) "\n" ;; If CONTENTS is not empty, insert it along with ;; a separator. @@ -1171,14 +1282,15 @@ holding contextual information." ;; Bottom line. (make-string width (if utf8p ?━ ?_))) ;; Flush the inlinetask to the right. - (- org-e-ascii-text-width org-e-ascii-global-margin + (- org-ascii-text-width org-ascii-global-margin (if (not (org-export-get-parent-headline inlinetask)) 0 - org-e-ascii-inner-margin) - (org-e-ascii--current-text-width inlinetask info))))))) + org-ascii-inner-margin) + (org-ascii--current-text-width inlinetask info))))))) + ;;;; Italic -(defun org-e-ascii-italic (italic contents info) +(defun org-ascii-italic (italic contents info) "Transcode italic from Org to ASCII. CONTENTS is the text with italic markup. INFO is a plist holding contextual information." @@ -1187,12 +1299,12 @@ contextual information." ;;;; Item -(defun org-e-ascii-item (item contents info) +(defun org-ascii-item (item contents info) "Transcode an ITEM element from Org to ASCII. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) - (checkbox (org-e-ascii--checkbox item info)) + (checkbox (org-ascii--checkbox item info)) (list-type (org-element-property :type (org-export-get-parent item))) (bullet ;; First parent of ITEM is always the plain-list. Get @@ -1229,7 +1341,7 @@ contextual information." ;; Contents: Pay attention to indentation. Note: check-boxes are ;; already taken care of at the paragraph level so they don't ;; interfere with indentation. - (let ((contents (org-e-ascii--indent-string contents (length bullet)))) + (let ((contents (org-ascii--indent-string contents (length bullet)))) (if (eq (org-element-type (car (org-element-contents item))) 'paragraph) (org-trim contents) (concat "\n" contents)))))) @@ -1237,7 +1349,7 @@ contextual information." ;;;; Keyword -(defun org-e-ascii-keyword (keyword contents info) +(defun org-ascii-keyword (keyword contents info) "Transcode a KEYWORD element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1252,35 +1364,37 @@ information." (let ((depth (or (and (string-match "[0-9]+" value) (string-to-number (match-string 0 value))) (plist-get info :with-toc)))) - (org-e-ascii--build-toc + (org-ascii--build-toc info (and (wholenump depth) depth) keyword))) ((string= "tables" value) - (org-e-ascii--list-tables keyword info)) + (org-ascii--list-tables keyword info)) ((string= "listings" value) - (org-e-ascii--list-listings keyword info)))))))) + (org-ascii--list-listings keyword info)))))))) ;;;; Latex Environment -(defun org-e-ascii-latex-environment (latex-environment contents info) +(defun org-ascii-latex-environment (latex-environment contents info) "Transcode a LATEX-ENVIRONMENT element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (org-remove-indentation (org-element-property :value latex-environment))) + (when (plist-get info :with-latex) + (org-remove-indentation (org-element-property :value latex-environment)))) ;;;; Latex Fragment -(defun org-e-ascii-latex-fragment (latex-fragment contents info) +(defun org-ascii-latex-fragment (latex-fragment contents info) "Transcode a LATEX-FRAGMENT object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (org-element-property :value latex-fragment)) + (when (plist-get info :with-latex) + (org-element-property :value latex-fragment))) ;;;; Line Break -(defun org-e-ascii-line-break (line-break contents info) +(defun org-ascii-line-break (line-break contents info) "Transcode a LINE-BREAK object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." hard-newline) @@ -1288,7 +1402,7 @@ CONTENTS is nil. INFO is a plist holding contextual ;;;; Link -(defun org-e-ascii-link (link desc info) +(defun org-ascii-link (link desc info) "Transcode a LINK object from Org to ASCII. DESC is the description part of the link, or the empty string. @@ -1310,46 +1424,38 @@ INFO is a plist holding contextual information." ;; targets. ((string= type "fuzzy") (let ((destination (org-export-resolve-fuzzy-link link info))) - ;; Ignore invisible "#+TARGET: path". - (unless (eq (org-element-type destination) 'keyword) - (if (org-string-nw-p desc) desc - (when destination - (let ((number - (org-export-get-ordinal - destination info nil 'org-e-ascii--has-caption-p))) - (when number - (if (atom number) (number-to-string number) - (mapconcat 'number-to-string number "."))))))))) + (if (org-string-nw-p desc) desc + (when destination + (let ((number + (org-export-get-ordinal + destination info nil 'org-ascii--has-caption-p))) + (when number + (if (atom number) (number-to-string number) + (mapconcat 'number-to-string number ".")))))))) (t (if (not (org-string-nw-p desc)) (format "[%s]" raw-link) (concat (format "[%s]" desc) - (unless org-e-ascii-links-to-notes (format " (%s)" raw-link)))))))) - - -;;;; Macro - -(defun org-e-ascii-macro (macro contents info) - "Transcode a MACRO element from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual -information." - (org-export-expand-macro macro info)) + (unless org-ascii-links-to-notes (format " (%s)" raw-link)))))))) ;;;; Paragraph -(defun org-e-ascii-paragraph (paragraph contents info) +(defun org-ascii-paragraph (paragraph contents info) "Transcode a PARAGRAPH element from Org to ASCII. CONTENTS is the contents of the paragraph, as a string. INFO is the plist used as a communication channel." - (org-e-ascii--fill-string - contents - (org-e-ascii--current-text-width paragraph info) info)) + (let ((contents (if (not (wholenump org-ascii-indented-line-width)) contents + (concat + (make-string org-ascii-indented-line-width ? ) + (replace-regexp-in-string "\\`[ \t]+" "" contents))))) + (org-ascii--fill-string + contents (org-ascii--current-text-width paragraph info) info))) ;;;; Plain List -(defun org-e-ascii-plain-list (plain-list contents info) +(defun org-ascii-plain-list (plain-list contents info) "Transcode a PLAIN-LIST element from Org to ASCII. CONTENTS is the contents of the list. INFO is a plist holding contextual information." @@ -1358,23 +1464,26 @@ contextual information." ;;;; Plain Text -(defun org-e-ascii-plain-text (text info) +(defun org-ascii-plain-text (text info) "Transcode a TEXT string from Org to ASCII. INFO is a plist used as a communication channel." - (if (not (and (eq (plist-get info :ascii-charset) 'utf-8) - (plist-get info :with-special-strings))) - text - ;; Usual replacements in utf-8 with proper option set. - (replace-regexp-in-string - "\\.\\.\\." "…" - (replace-regexp-in-string - "--" "–" - (replace-regexp-in-string "---" "—" text))))) + (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) + (when (and utf8p (plist-get info :with-smart-quotes)) + (setq text (org-export-activate-smart-quotes text :utf-8 info))) + (if (not (plist-get info :with-special-strings)) text + (setq text (replace-regexp-in-string "\\\\-" "" text)) + (if (not utf8p) text + ;; Usual replacements in utf-8 with proper option set. + (replace-regexp-in-string + "\\.\\.\\." "…" + (replace-regexp-in-string + "--" "–" + (replace-regexp-in-string "---" "—" text))))))) ;;;; Planning -(defun org-e-ascii-planning (planning contents info) +(defun org-ascii-planning (planning contents info) "Transcode a PLANNING element from Org to ASCII. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -1382,87 +1491,85 @@ channel." 'identity (delq nil (list (let ((closed (org-element-property :closed planning))) - (when closed (concat org-closed-string " " - (org-translate-time closed)))) + (when closed + (concat org-closed-string " " + (org-translate-time + (org-element-property :raw-value closed))))) (let ((deadline (org-element-property :deadline planning))) - (when deadline (concat org-deadline-string " " - (org-translate-time deadline)))) + (when deadline + (concat org-deadline-string " " + (org-translate-time + (org-element-property :raw-value deadline))))) (let ((scheduled (org-element-property :scheduled planning))) - (when scheduled (concat org-scheduled-string " " - (org-translate-time scheduled)))))) + (when scheduled + (concat org-scheduled-string " " + (org-translate-time + (org-element-property :raw-value scheduled))))))) " ")) -;;;; Property Drawer -;; -;; Property drawers are ignored. - - ;;;; Quote Block -(defun org-e-ascii-quote-block (quote-block contents info) +(defun org-ascii-quote-block (quote-block contents info) "Transcode a QUOTE-BLOCK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." - (let ((width (org-e-ascii--current-text-width quote-block info))) - (org-e-ascii--indent-string - (org-remove-indentation - (org-e-ascii--fill-string contents width info)) - org-e-ascii-quote-margin))) + (org-ascii--indent-string contents org-ascii-quote-margin)) ;;;; Quote Section -(defun org-e-ascii-quote-section (quote-section contents info) +(defun org-ascii-quote-section (quote-section contents info) "Transcode a QUOTE-SECTION element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (let ((width (org-e-ascii--current-text-width quote-section info)) + (let ((width (org-ascii--current-text-width quote-section info)) (value (org-export-data (org-remove-indentation (org-element-property :value quote-section)) info))) - (org-e-ascii--indent-string + (org-ascii--indent-string value - (+ org-e-ascii-quote-margin + (+ org-ascii-quote-margin ;; Don't apply inner margin if parent headline is low level. (let ((headline (org-export-get-parent-headline quote-section))) (if (org-export-low-level-p headline info) 0 - org-e-ascii-inner-margin)))))) + org-ascii-inner-margin)))))) ;;;; Radio Target -(defun org-e-ascii-radio-target (radio-target contents info) +(defun org-ascii-radio-target (radio-target contents info) "Transcode a RADIO-TARGET object from Org to ASCII. CONTENTS is the contents of the target. INFO is a plist holding contextual information." contents) + ;;;; Section -(defun org-e-ascii-section (section contents info) +(defun org-ascii-section (section contents info) "Transcode a SECTION element from Org to ASCII. CONTENTS is the contents of the section. INFO is a plist holding contextual information." - (org-e-ascii--indent-string + (org-ascii--indent-string (concat contents - (when org-e-ascii-links-to-notes + (when org-ascii-links-to-notes ;; Add list of links at the end of SECTION. - (let ((links (org-e-ascii--describe-links - (org-e-ascii--unique-links section info) - (org-e-ascii--current-text-width section info) info))) + (let ((links (org-ascii--describe-links + (org-ascii--unique-links section info) + (org-ascii--current-text-width section info) info))) ;; Separate list of links and section contents. (when (org-string-nw-p links) (concat "\n\n" links))))) ;; Do not apply inner margin if parent headline is low level. (let ((headline (org-export-get-parent-headline section))) (if (or (not headline) (org-export-low-level-p headline info)) 0 - org-e-ascii-inner-margin)))) + org-ascii-inner-margin)))) ;;;; Special Block -(defun org-e-ascii-special-block (special-block contents info) +(defun org-ascii-special-block (special-block contents info) "Transcode a SPECIAL-BLOCK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -1471,21 +1578,23 @@ holding contextual information." ;;;; Src Block -(defun org-e-ascii-src-block (src-block contents info) +(defun org-ascii-src-block (src-block contents info) "Transcode a SRC-BLOCK element from Org to ASCII. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let ((caption (org-e-ascii--build-caption src-block info))) - (concat - (when (and caption org-e-ascii-caption-above) (concat caption "\n")) - (org-e-ascii--box-string - (org-export-format-code-default src-block info) info) - (when (and caption (not org-e-ascii-caption-above)) - (concat "\n" caption))))) + (let ((caption (org-ascii--build-caption src-block info)) + (code (org-export-format-code-default src-block info))) + (if (equal code "") "" + (concat + (when (and caption org-ascii-caption-above) (concat caption "\n")) + (org-ascii--box-string code info) + (when (and caption (not org-ascii-caption-above)) + (concat "\n" caption)))))) + ;;;; Statistics Cookie -(defun org-e-ascii-statistics-cookie (statistics-cookie contents info) +(defun org-ascii-statistics-cookie (statistics-cookie contents info) "Transcode a STATISTICS-COOKIE object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (org-element-property :value statistics-cookie)) @@ -1493,7 +1602,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Subscript -(defun org-e-ascii-subscript (subscript contents info) +(defun org-ascii-subscript (subscript contents info) "Transcode a SUBSCRIPT object from Org to ASCII. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -1504,7 +1613,7 @@ contextual information." ;;;; Superscript -(defun org-e-ascii-superscript (superscript contents info) +(defun org-ascii-superscript (superscript contents info) "Transcode a SUPERSCRIPT object from Org to ASCII. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -1515,7 +1624,7 @@ contextual information." ;;;; Strike-through -(defun org-e-ascii-strike-through (strike-through contents info) +(defun org-ascii-strike-through (strike-through contents info) "Transcode STRIKE-THROUGH from Org to ASCII. CONTENTS is text with strike-through markup. INFO is a plist holding contextual information." @@ -1524,17 +1633,17 @@ holding contextual information." ;;;; Table -(defun org-e-ascii-table (table contents info) +(defun org-ascii-table (table contents info) "Transcode a TABLE element from Org to ASCII. CONTENTS is the contents of the table. INFO is a plist holding contextual information." - (let ((caption (org-e-ascii--build-caption table info))) + (let ((caption (org-ascii--build-caption table info))) (concat ;; Possibly add a caption string above. - (when (and caption org-e-ascii-caption-above) (concat caption "\n")) + (when (and caption org-ascii-caption-above) (concat caption "\n")) ;; Insert table. Note: "table.el" tables are left unmodified. (cond ((eq (org-element-property :type table) 'org) contents) - ((and org-e-ascii-table-use-ascii-art + ((and org-ascii-table-use-ascii-art (eq (plist-get info :ascii-charset) 'utf-8) (require 'ascii-art-to-unicode nil t)) (with-temp-buffer @@ -1547,13 +1656,13 @@ contextual information." (buffer-substring (point-min) (point)))) (t (org-remove-indentation (org-element-property :value table)))) ;; Possible add a caption string below. - (when (and caption (not org-e-ascii-caption-above)) + (when (and caption (not org-ascii-caption-above)) (concat "\n" caption))))) ;;;; Table Cell -(defun org-e-ascii--table-cell-width (table-cell info) +(defun org-ascii--table-cell-width (table-cell info) "Return width of TABLE-CELL. INFO is a plist used as a communication channel. @@ -1562,46 +1671,45 @@ Width of a cell is determined either by a width cookie in the same column as the cell, or by the maximum cell's length in that column. -When `org-e-ascii-table-widen-columns' is non-nil, width cookies +When `org-ascii-table-widen-columns' is non-nil, width cookies are ignored." - (or (and (not org-e-ascii-table-widen-columns) + (or (and (not org-ascii-table-widen-columns) (org-export-table-cell-width table-cell info)) (let* ((max-width 0) (table (org-export-get-parent-table table-cell)) (specialp (org-export-table-has-special-column-p table)) (col (cdr (org-export-table-cell-address table-cell info)))) - (org-element-map - table 'table-row - (lambda (row) - (setq max-width - (max (length - (org-export-data - (org-element-contents - (elt (if specialp (cdr (org-element-contents row)) - (org-element-contents row)) - col)) - info)) - max-width))) - info) + (org-element-map table 'table-row + (lambda (row) + (setq max-width + (max (length + (org-export-data + (org-element-contents + (elt (if specialp (cdr (org-element-contents row)) + (org-element-contents row)) + col)) + info)) + max-width))) + info) max-width))) -(defun org-e-ascii-table-cell (table-cell contents info) +(defun org-ascii-table-cell (table-cell contents info) "Transcode a TABLE-CELL object from Org to ASCII. CONTENTS is the cell contents. INFO is a plist used as a communication channel." - ;; Determine column width. When `org-e-ascii-table-widen-columns' + ;; Determine column width. When `org-ascii-table-widen-columns' ;; is nil and some width cookie has set it, use that value. ;; Otherwise, compute the maximum width among transcoded data of ;; each cell in the column. - (let ((width (org-e-ascii--table-cell-width table-cell info))) + (let ((width (org-ascii--table-cell-width table-cell info))) ;; When contents are too large, truncate them. - (unless (or org-e-ascii-table-widen-columns (<= (length contents) width)) + (unless (or org-ascii-table-widen-columns (<= (length contents) width)) (setq contents (concat (substring contents 0 (- width 2)) "=>"))) ;; Align contents correctly within the cell. (let* ((indent-tabs-mode nil) (data (when contents - (org-e-ascii--justify-string + (org-ascii--justify-string contents width (org-export-table-cell-alignment table-cell info))))) (setq contents (concat data (make-string (- width (length data)) ? )))) @@ -1613,7 +1721,7 @@ a communication channel." ;;;; Table Row -(defun org-e-ascii-table-row (table-row contents info) +(defun org-ascii-table-row (table-row contents info) "Transcode a TABLE-ROW element from Org to ASCII. CONTENTS is the row contents. INFO is a plist used as a communication channel." @@ -1624,29 +1732,28 @@ a communication channel." (concat (apply 'concat - (org-element-map - table-row 'table-cell - (lambda (cell) - (let ((width (org-e-ascii--table-cell-width cell info)) - (borders (org-export-table-cell-borders cell info))) - (concat - ;; In order to know if CELL starts the row, do - ;; not compare it with the first cell in the row - ;; as there might be a special column. Instead, - ;; compare it with the first exportable cell, - ;; obtained with `org-element-map'. - (when (and (memq 'left borders) - (eq (org-element-map - table-row 'table-cell 'identity info t) - cell)) - lcorner) - (make-string (+ 2 width) (string-to-char horiz)) - (cond - ((not (memq 'right borders)) nil) - ((eq (car (last (org-element-contents table-row))) cell) - rcorner) - (t vert))))) - info)) "\n")))) + (org-element-map table-row 'table-cell + (lambda (cell) + (let ((width (org-ascii--table-cell-width cell info)) + (borders (org-export-table-cell-borders cell info))) + (concat + ;; In order to know if CELL starts the row, do + ;; not compare it with the first cell in the + ;; row as there might be a special column. + ;; Instead, compare it with first exportable + ;; cell, obtained with `org-element-map'. + (when (and (memq 'left borders) + (eq (org-element-map table-row 'table-cell + 'identity info t) + cell)) + lcorner) + (make-string (+ 2 width) (string-to-char horiz)) + (cond + ((not (memq 'right borders)) nil) + ((eq (car (last (org-element-contents table-row))) cell) + rcorner) + (t vert))))) + info)) "\n")))) (utf8p (eq (plist-get info :ascii-charset) 'utf-8)) (borders (org-export-table-cell-borders (org-element-map table-row 'table-cell 'identity info t) @@ -1665,27 +1772,17 @@ a communication channel." (funcall build-hline "+" "-" "+" "+"))))))) -;;;; Target - -;; Targets are invisible. - - ;;;; Timestamp -(defun org-e-ascii-timestamp (timestamp contents info) +(defun org-ascii-timestamp (timestamp contents info) "Transcode a TIMESTAMP object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (let ((value (org-translate-time (org-element-property :value timestamp))) - (range-end - (org-translate-time (org-element-property :range-end timestamp))) - (utf8p (eq (plist-get info :ascii-charset) 'utf-8))) - (concat value - (when range-end (concat (if utf8p "–" "--") range-end))))) + (org-ascii-plain-text (org-timestamp-translate timestamp) info)) ;;;; Underline -(defun org-e-ascii-underline (underline contents info) +(defun org-ascii-underline (underline contents info) "Transcode UNDERLINE from Org to ASCII. CONTENTS is the text with underline markup. INFO is a plist holding contextual information." @@ -1694,49 +1791,77 @@ holding contextual information." ;;;; Verbatim -(defun org-e-ascii-verbatim (verbatim contents info) +(defun org-ascii-verbatim (verbatim contents info) "Return a VERBATIM object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (format org-e-ascii-verbatim-format + (format org-ascii-verbatim-format (org-element-property :value verbatim))) ;;;; Verse Block -(defun org-e-ascii-verse-block (verse-block contents info) +(defun org-ascii-verse-block (verse-block contents info) "Transcode a VERSE-BLOCK element from Org to ASCII. CONTENTS is verse block contents. INFO is a plist holding contextual information." - (let ((verse-width (org-e-ascii--current-text-width verse-block info))) - (org-e-ascii--indent-string - (org-e-ascii--justify-string contents verse-width 'left) - org-e-ascii-quote-margin))) + (let ((verse-width (org-ascii--current-text-width verse-block info))) + (org-ascii--indent-string + (org-ascii--justify-string contents verse-width 'left) + org-ascii-quote-margin))) + -;;; Filter +;;; Filters -(defun org-e-ascii-filter-headline-blank-lines (headline back-end info) - "Filter controlling number of blank lines after an headline. +(defun org-ascii-filter-headline-blank-lines (headline back-end info) + "Filter controlling number of blank lines after a headline. HEADLINE is a string representing a transcoded headline. BACK-END is symbol specifying back-end used for export. INFO is plist containing the communication channel. -This function only applies to `e-ascii' back-end. See -`org-e-ascii-headline-spacing' for information. - -For any other back-end, HEADLINE is returned as-is." - (if (not org-e-ascii-headline-spacing) headline - (let ((blanks (make-string (1+ (cdr org-e-ascii-headline-spacing)) ?\n))) +This function only applies to `ascii' back-end. See +`org-ascii-headline-spacing' for information." + (if (not org-ascii-headline-spacing) headline + (let ((blanks (make-string (1+ (cdr org-ascii-headline-spacing)) ?\n))) (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline)))) +(defun org-ascii-filter-paragraph-spacing (tree back-end info) + "Filter controlling number of blank lines between paragraphs. + +TREE is the parse tree. BACK-END is the symbol specifying +back-end used for export. INFO is a plist used as +a communication channel. + +See `org-ascii-paragraph-spacing' for information." + (when (wholenump org-ascii-paragraph-spacing) + (org-element-map tree 'paragraph + (lambda (p) + (when (eq (org-element-type (org-export-get-next-element p info)) + 'paragraph) + (org-element-put-property + p :post-blank org-ascii-paragraph-spacing))))) + tree) + +(defun org-ascii-filter-comment-spacing (tree backend info) + "Filter removing blank lines between comments. +TREE is the parse tree. BACK-END is the symbol specifying +back-end used for export. INFO is a plist used as +a communication channel." + (org-element-map tree '(comment comment-block) + (lambda (c) + (when (memq (org-element-type (org-export-get-next-element c info)) + '(comment comment-block)) + (org-element-put-property c :post-blank 0)))) + tree) + -;;; Interactive function +;;; End-user functions ;;;###autoload -(defun org-e-ascii-export-as-ascii - (&optional subtreep visible-only body-only ext-plist) +(defun org-ascii-export-as-ascii + (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to a text buffer. If narrowing is active in the current buffer, only export its @@ -1744,6 +1869,10 @@ narrowed part. If a region is active, export that region. +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + When optional argument SUBTREEP is non-nil, export the sub-tree at point, extracting information from the headline properties first. @@ -1751,27 +1880,38 @@ first. When optional argument VISIBLE-ONLY is non-nil, don't export contents of hidden elements. -When optional argument BODY-ONLY is non-nil, strip title, table -of contents and footnote definitions from output. +When optional argument BODY-ONLY is non-nil, strip title and +table of contents from output. EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to file-local settings. -Export is done in a buffer named \"*Org E-ASCII Export*\", which +Export is done in a buffer named \"*Org ASCII Export*\", which will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) - (let ((outbuf (org-export-to-buffer - 'e-ascii "*Org E-ASCII Export*" - subtreep visible-only body-only ext-plist))) - (with-current-buffer outbuf (text-mode)) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window outbuf)))) + (if async + (org-export-async-start + (lambda (output) + (with-current-buffer (get-buffer-create "*Org ASCII Export*") + (erase-buffer) + (insert output) + (goto-char (point-min)) + (text-mode) + (org-export-add-to-stack (current-buffer) 'ascii))) + `(org-export-as 'ascii ,subtreep ,visible-only ,body-only + ',ext-plist)) + (let ((outbuf (org-export-to-buffer + 'ascii "*Org ASCII Export*" + subtreep visible-only body-only ext-plist))) + (with-current-buffer outbuf (text-mode)) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window outbuf))))) ;;;###autoload -(defun org-e-ascii-export-to-ascii - (&optional subtreep visible-only body-only ext-plist pub-dir) +(defun org-ascii-export-to-ascii + (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to a text file. If narrowing is active in the current buffer, only export its @@ -1779,6 +1919,10 @@ narrowed part. If a region is active, export that region. +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + When optional argument SUBTREEP is non-nil, export the sub-tree at point, extracting information from the headline properties first. @@ -1786,22 +1930,67 @@ first. When optional argument VISIBLE-ONLY is non-nil, don't export contents of hidden elements. -When optional argument BODY-ONLY is non-nil, strip title, table -of contents and footnote definitions from output. +When optional argument BODY-ONLY is non-nil, strip title and +table of contents from output. EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to file-local settings. -When optional argument PUB-DIR is set, use it as the publishing -directory. - Return output file's name." (interactive) - (let ((outfile (org-export-output-file-name ".txt" subtreep pub-dir))) - (org-export-to-file - 'e-ascii outfile subtreep visible-only body-only ext-plist))) + (let ((outfile (org-export-output-file-name ".txt" subtreep))) + (if async + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'ascii)) + `(expand-file-name + (org-export-to-file + 'ascii ,outfile ,subtreep ,visible-only ,body-only ',ext-plist))) + (org-export-to-file + 'ascii outfile subtreep visible-only body-only ext-plist)))) + +;;;###autoload +(defun org-ascii-publish-to-ascii (plist filename pub-dir) + "Publish an Org file to ASCII. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to + 'ascii filename ".txt" `(:ascii-charset ascii ,@plist) pub-dir)) + +;;;###autoload +(defun org-ascii-publish-to-latin1 (plist filename pub-dir) + "Publish an Org file to Latin-1. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to + 'ascii filename ".txt" `(:ascii-charset latin1 ,@plist) pub-dir)) + +;;;###autoload +(defun org-ascii-publish-to-utf8 (plist filename pub-dir) + "Publish an org file to UTF-8. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to + 'ascii filename ".txt" `(:ascii-charset utf-8 ,@plist) pub-dir)) -(provide 'org-e-ascii) -;;; org-e-ascii.el ends here +(provide 'ox-ascii) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; coding: utf-8-emacs +;; End: + +;;; ox-ascii.el ends here diff --git a/contrib/lisp/org-e-beamer.el b/lisp/ox-beamer.el similarity index 50% rename from contrib/lisp/org-e-beamer.el rename to lisp/ox-beamer.el index 31e13c614..2e2cfa9a3 100644 --- a/contrib/lisp/org-e-beamer.el +++ b/lisp/ox-beamer.el @@ -1,4 +1,4 @@ -;;; org-e-beamer.el --- Beamer Back-End for Org Export Engine +;;; ox-beamer.el --- Beamer Back-End for Org Export Engine ;; Copyright (C) 2007-2013 Free Software Foundation, Inc. @@ -26,86 +26,126 @@ ;; document. ;; ;; Depending on the desired output format, three commands are provided -;; for export: `org-e-beamer-export-as-latex' (temporary buffer), -;; `org-e-beamer-export-to-latex' ("tex" file) and -;; `org-e-beamer-export-to-pdf' ("pdf" file). +;; for export: `org-beamer-export-as-latex' (temporary buffer), +;; `org-beamer-export-to-latex' ("tex" file) and +;; `org-beamer-export-to-pdf' ("pdf" file). ;; -;; On top of buffer keywords supported by `e-latex' back-end (see -;; `org-e-latex-options-alist'), this back-end introduces the -;; following keywords: "BEAMER_THEME", "BEAMER_COLOR_THEME", -;; "BEAMER_FONT_THEME", "BEAMER_INNER_THEME" and "BEAMER_OUTER_THEME". -;; All accept options in square brackets. +;; This back-end supports every buffer keyword, attribute and options +;; items (see `org-latex-options-alist') already supported by `latex' +;; back-end. As such, it is suggested to add an entry in +;; `org-latex-classes' variable which is appropriate for Beamer +;; export. +;; +;; On top of this, the `beamer' back-end also introduces the following +;; keywords: "BEAMER_THEME", "BEAMER_COLOR_THEME", +;; "BEAMER_FONT_THEME", "BEAMER_INNER_THEME", "BEAMER_OUTER_THEME" and +;; "BEAMER_HEADER". All but the latter accept options in square +;; brackets. ;; ;; Moreover, headlines now fall into three categories: sectioning ;; elements, frames and blocks. ;; -;; - Like `e-latex' back-end sectioning elements are still set through -;; `org-e-latex-classes' variable. -;; ;; - Headlines become frames when their level is equal to -;; `org-e-beamer-frame-level' (or "H" value in the OPTIONS line). -;; Though, if an headline in the current tree has a "BEAMER_env" -;; (see below) property set to "frame", its level overrides the -;; variable. +;; `org-beamer-frame-level' (or "H" value in the OPTIONS line). +;; Though, if a headline in the current tree has a "BEAMER_env" +;; (see below) property set to either "frame" or "fullframe", its +;; level overrides the variable. A "fullframe" is a frame with an +;; empty (ignored) title. ;; ;; - All frames' children become block environments. Special block ;; types can be enforced by setting headline's "BEAMER_env" property -;; to an appropriate value (see `org-e-beamer-environments-default' -;; for supported value and `org-e-beamer-environments-extra' for +;; to an appropriate value (see `org-beamer-environments-default' +;; for supported value and `org-beamer-environments-extra' for ;; adding more). ;; ;; - As a special case, if the "BEAMER_env" property is set to either -;; "appendix", "note" or "noteNH", the headline will become, -;; respectively, an appendix, a note (within frame or between frame, -;; depending on its level) and a note with its title ignored. +;; "appendix", "note", "noteNH" or "againframe", the headline will +;; become, respectively, an appendix, a note (within frame or +;; between frame, depending on its level), a note with its title +;; ignored or an againframe command. In the latter case, +;; a "BEAMER_ref" property is mandatory in order to refer to the +;; frame being resumed, and contents are ignored. ;; -;; Also, an headline with an "ignoreheading" value will have its -;; contents only inserted in the output. This special value is +;; Also, a headline with an "ignoreheading" environment will have +;; its contents only inserted in the output. This special value is ;; useful to have data between frames, or to properly close ;; a "column" environment. ;; -;; Along with "BEAMER_env", headlines also support "BEAMER_act" and -;; "BEAMER_opt" properties. The former is translated as an +;; Along with "BEAMER_env", headlines also support the "BEAMER_act" +;; and "BEAMER_opt" properties. The former is translated as an ;; overlay/action specification (or a default overlay specification ;; when enclosed within square brackets) whereas the latter specifies ;; options for the current frame ("fragile" option is added ;; automatically, though). ;; -;; Every plain list has support for `:overlay' attribute (through -;; ATTR_BEAMER affiliated keyword). Also, ordered (resp. description) -;; lists make use of `:template' (resp. `:long-text') attribute. +;; Moreover, headlines handle the "BEAMER_col" property. Its value +;; should be a decimal number representing the width of the column as +;; a fraction of the total text width. If the headline has no +;; specific environment, its title will be ignored and its contents +;; will fill the column created. Otherwise, the block will fill the +;; whole column and the title will be preserved. Two contiguous +;; headlines with a non-nil "BEAMER_col" value share the same +;; "columns" LaTeX environment. It will end before the next headline +;; without such a property. This environment is generated +;; automatically. Although, it can also be explicitly created, with +;; a special "columns" value for "BEAMER_env" property (if it needs to +;; be set up with some specific options, for example). +;; +;; Every plain list has support for `:environment', `:overlay' and +;; `:options' attributes (through ATTR_BEAMER affiliated keyword). +;; The first one allows to use a different environment, the second +;; sets overlay specifications and the last one inserts optional +;; arguments in current list environment. +;; +;; Table of contents generated from "toc:t" option item are wrapped +;; within a "frame" environment. Those generated from a TOC keyword +;; aren't. TOC keywords accept options enclosed within square +;; brackets (e.g. #+TOC: headlines [currentsection]). ;; ;; Eventually, an export snippet with a value enclosed within angular ;; brackets put at the beginning of an element or object whose type is ;; among `bold', `item', `link', `radio-target' and `target' will ;; control its overlay specifications. ;; -;; On the minor mode side, `org-e-beamer-select-environment' (bound by -;; default to "C-c C-b") and `org-e-beamer-insert-options-template' -;; are the two entry points. +;; On the minor mode side, `org-beamer-select-environment' (bound by +;; default to "C-c C-b") and `org-beamer-insert-options-template' are +;; the two entry points. ;;; Code: -(require 'org-e-latex) +(eval-when-compile (require 'cl)) +(require 'ox-latex) + +;; Install a default set-up for Beamer export. +(unless (assoc "beamer" org-latex-classes) + (add-to-list 'org-latex-classes + '("beamer" + "\\documentclass[presentation]{beamer} + \[DEFAULT-PACKAGES] + \[PACKAGES] + \[EXTRA]" + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}")))) ;;; User-Configurable Variables -(defgroup org-export-e-beamer nil +(defgroup org-export-beamer nil "Options specific for using the beamer class in LaTeX export." :tag "Org Beamer" :group 'org-export :version "24.2") -(defcustom org-e-beamer-frame-level 1 +(defcustom org-beamer-frame-level 1 "The level at which headlines become frames. Headlines at a lower level will be translated into a sectioning structure. At a higher level, they will be translated into blocks. -If an headline with a \"BEAMER_env\" property set to \"frame\" is +If a headline with a \"BEAMER_env\" property set to \"frame\" is found within a tree, its level locally overrides this number. This variable has no effect on headlines with the \"BEAMER_env\" @@ -113,38 +153,42 @@ property set to either \"ignoreheading\", \"appendix\", or \"note\", which will respectively, be invisible, become an appendix or a note. -This integer is relative to the minimal level of an headline +This integer is relative to the minimal level of a headline within the parse tree, defined as 1." - :group 'org-export-e-beamer + :group 'org-export-beamer :type 'integer) -(defcustom org-e-beamer-frame-default-options "" +(defcustom org-beamer-frame-default-options "" "Default options string to use for frames. For example, it could be set to \"allowframebreaks\"." - :group 'org-export-e-beamer + :group 'org-export-beamer :type '(string :tag "[options]")) -(defcustom org-e-beamer-column-view-format +(defcustom org-beamer-column-view-format "%45ITEM %10BEAMER_env(Env) %10BEAMER_act(Act) %4BEAMER_col(Col) %8BEAMER_opt(Opt)" "Column view format that should be used to fill the template." - :group 'org-export-e-beamer + :group 'org-export-beamer + :version "24.4" + :package-version '(Org . "8.0") :type '(choice (const :tag "Do not insert Beamer column view format" nil) (string :tag "Beamer column view format"))) -(defcustom org-e-beamer-theme "default" +(defcustom org-beamer-theme "default" "Default theme used in Beamer presentations." - :group 'org-export-e-beamer + :group 'org-export-beamer + :version "24.4" + :package-version '(Org . "8.0") :type '(choice (const :tag "Do not insert a Beamer theme" nil) (string :tag "Beamer theme"))) -(defcustom org-e-beamer-environments-extra nil +(defcustom org-beamer-environments-extra nil "Environments triggered by tags in Beamer export. Each entry has 4 elements: name Name of the environment -key Selection key for `org-e-beamer-select-environment' +key Selection key for `org-beamer-select-environment' open The opening template for the environment, with the following escapes %a the action/overlay specification %A the default action/overlay specification @@ -153,7 +197,9 @@ open The opening template for the environment, with the following escapes %H if there is headline text, that text in {} braces %U if there is headline text, that text in [] brackets close The closing string of the environment." - :group 'org-export-e-beamer + :group 'org-export-beamer + :version "24.4" + :package-version '(Org . "8.0") :type '(repeat (list (string :tag "Environment") @@ -161,39 +207,42 @@ close The closing string of the environment." (string :tag "Begin") (string :tag "End")))) -(defcustom org-e-beamer-outline-frame-title "Outline" +(defcustom org-beamer-outline-frame-title "Outline" "Default title of a frame containing an outline." - :group 'org-export-e-beamer + :group 'org-export-beamer :type '(string :tag "Outline frame title")) -(defcustom org-e-beamer-outline-frame-options "" +(defcustom org-beamer-outline-frame-options "" "Outline frame options appended after \\begin{frame}. You might want to put e.g. \"allowframebreaks=0.9\" here." - :group 'org-export-e-beamer + :group 'org-export-beamer :type '(string :tag "Outline frame options")) ;;; Internal Variables -(defconst org-e-beamer-column-widths +(defconst org-beamer-column-widths "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC" "The column widths that should be installed as allowed property values.") -(defconst org-e-beamer-environments-special - '(("appendix" "x") +(defconst org-beamer-environments-special + '(("againframe" "A") + ("appendix" "x") ("column" "c") + ("columns" "C") ("frame" "f") + ("fullframe" "F") ("ignoreheading" "i") ("note" "n") ("noteNH" "N")) "Alist of environments treated in a special way by the back-end. Keys are environment names, as strings, values are bindings used -in `org-e-beamer-select-environment'. Environments listed here, +in `org-beamer-select-environment'. Environments listed here, along with their binding, are hard coded and cannot be modified -through `org-e-beamer-environments-extra' variable.") +through `org-beamer-environments-extra' variable.") -(defconst org-e-beamer-environments-default +(defconst org-beamer-environments-default '(("block" "b" "\\begin{block}%a{%h}" "\\end{block}") ("alertblock" "a" "\\begin{alertblock}%a{%h}" "\\end{alertblock}") ("verse" "v" "\\begin{verse}%a %% %h" "\\end{verse}") @@ -208,9 +257,9 @@ through `org-e-beamer-environments-extra' variable.") ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}" "\\end{beamercolorbox}")) "Environments triggered by properties in Beamer export. These are the defaults - for user definitions, see -`org-e-beamer-environments-extra'.") +`org-beamer-environments-extra'.") -(defconst org-e-beamer-verbatim-elements +(defconst org-beamer-verbatim-elements '(code example-block fixed-width inline-src-block src-block verbatim) "List of element or object types producing verbatim text. This is used internally to determine when a frame should have the @@ -220,7 +269,7 @@ This is used internally to determine when a frame should have the ;;; Internal functions -(defun org-e-beamer--normalize-argument (argument type) +(defun org-beamer--normalize-argument (argument type) "Return ARGUMENT string with proper boundaries. TYPE is a symbol among the following: @@ -242,11 +291,11 @@ TYPE is a symbol among the following: (format "[%s]" argument))) (otherwise argument)))) -(defun org-e-beamer--element-has-overlay-p (element) +(defun org-beamer--element-has-overlay-p (element) "Non-nil when ELEMENT has an overlay specified. An element has an overlay specification when it starts with an -`e-beamer' export-snippet whose value is between angular -brackets. Return overlay specification, as a string, or nil." +`beamer' export-snippet whose value is between angular brackets. +Return overlay specification, as a string, or nil." (let ((first-object (car (org-element-contents element)))) (when (eq (org-element-type first-object) 'export-snippet) (let ((value (org-element-property :value first-object))) @@ -256,26 +305,38 @@ brackets. Return overlay specification, as a string, or nil." ;;; Define Back-End -(org-export-define-derived-backend e-beamer e-latex +(org-export-define-derived-backend 'beamer 'latex :export-block "BEAMER" + :menu-entry + '(?l 1 + ((?B "As LaTeX buffer (Beamer)" org-beamer-export-as-latex) + (?b "As LaTeX file (Beamer)" org-beamer-export-to-latex) + (?P "As PDF file (Beamer)" org-beamer-export-to-pdf) + (?O "As PDF file and open (Beamer)" + (lambda (a s v b) + (if a (org-beamer-export-to-pdf t s v b) + (org-open-file (org-beamer-export-to-pdf nil s v b))))))) :options-alist - ((:beamer-theme "BEAMER_THEME" nil org-e-beamer-theme) - (:beamer-color-theme "BEAMER_COLOR_THEME" nil nil t) - (:beamer-font-theme "BEAMER_FONT_THEME" nil nil t) - (:beamer-inner-theme "BEAMER_INNER_THEME" nil nil t) - (:beamer-outer-theme "BEAMER_OUTER_THEME" nil nil t) - (:headline-levels nil "H" org-e-beamer-frame-level)) - :translate-alist ((bold . org-e-beamer-bold) - (export-block . org-e-beamer-export-block) - (export-snippet . org-e-beamer-export-snippet) - (headline . org-e-beamer-headline) - (item . org-e-beamer-item) - (keyword . org-e-beamer-keyword) - (link . org-e-beamer-link) - (plain-list . org-e-beamer-plain-list) - (radio-target . org-e-beamer-radio-target) - (target . org-e-beamer-target) - (template . org-e-beamer-template))) + '((:beamer-theme "BEAMER_THEME" nil org-beamer-theme) + (:beamer-color-theme "BEAMER_COLOR_THEME" nil nil t) + (:beamer-font-theme "BEAMER_FONT_THEME" nil nil t) + (:beamer-inner-theme "BEAMER_INNER_THEME" nil nil t) + (:beamer-outer-theme "BEAMER_OUTER_THEME" nil nil t) + (:beamer-header-extra "BEAMER_HEADER" nil nil newline) + ;; Modify existing properties. + (:headline-levels nil "H" org-beamer-frame-level) + (:latex-class "LATEX_CLASS" nil "beamer" t)) + :translate-alist '((bold . org-beamer-bold) + (export-block . org-beamer-export-block) + (export-snippet . org-beamer-export-snippet) + (headline . org-beamer-headline) + (item . org-beamer-item) + (keyword . org-beamer-keyword) + (link . org-beamer-link) + (plain-list . org-beamer-plain-list) + (radio-target . org-beamer-radio-target) + (target . org-beamer-target) + (template . org-beamer-template))) @@ -283,18 +344,18 @@ brackets. Return overlay specification, as a string, or nil." ;;;; Bold -(defun org-e-beamer-bold (bold contents info) +(defun org-beamer-bold (bold contents info) "Transcode BLOCK object into Beamer code. CONTENTS is the text being bold. INFO is a plist used as a communication channel." (format "\\alert%s{%s}" - (or (org-e-beamer--element-has-overlay-p bold) "") + (or (org-beamer--element-has-overlay-p bold) "") contents)) ;;;; Export Block -(defun org-e-beamer-export-block (export-block contents info) +(defun org-beamer-export-block (export-block contents info) "Transcode an EXPORT-BLOCK element into Beamer code. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -304,16 +365,16 @@ channel." ;;;; Export Snippet -(defun org-e-beamer-export-snippet (export-snippet contents info) +(defun org-beamer-export-snippet (export-snippet contents info) "Transcode an EXPORT-SNIPPET object into Beamer code. CONTENTS is nil. INFO is a plist used as a communication channel." (let ((backend (org-export-snippet-backend export-snippet)) (value (org-element-property :value export-snippet))) - ;; Only "e-latex" and "e-beamer" snippets are retained. - (cond ((eq backend 'e-latex) value) - ;; Ignore "e-beamer" snippets specifying overlays. - ((and (eq backend 'e-beamer) + ;; Only "latex" and "beamer" snippets are retained. + (cond ((eq backend 'latex) value) + ;; Ignore "beamer" snippets specifying overlays. + ((and (eq backend 'beamer) (or (org-export-get-previous-element export-snippet info) (not (string-match "\\`<.*>\\'" value)))) value)))) @@ -321,19 +382,37 @@ channel." ;;;; Headline ;; -;; The main function to translate an headline is -;; `org-e-beamer-headline'. +;; The main function to translate a headline is +;; `org-beamer-headline'. ;; -;; Depending on the level at which an headline is considered as -;; a frame (given by `org-e-beamer--frame-level'), the headline is -;; either a section (`org-e-beamer--format-section'), a frame -;; (`org-e-beamer--format-frame') or a block -;; (`org-e-beamer--format-block'). +;; Depending on the level at which a headline is considered as +;; a frame (given by `org-beamer--frame-level'), the headline is +;; either a section (`org-beamer--format-section'), a frame +;; (`org-beamer--format-frame') or a block +;; (`org-beamer--format-block'). ;; -;; `org-e-beamer-headline' also takes care of special environments -;; like "ignoreheading", "note", "noteNH" and "appendix". +;; `org-beamer-headline' also takes care of special environments +;; like "ignoreheading", "note", "noteNH", "appendix" and +;; "againframe". -(defun org-e-beamer--frame-level (headline info) +(defun org-beamer--get-label (headline info) + "Return label for HEADLINE, as a string. + +INFO is a plist used as a communication channel. + +The value is either the label specified in \"BEAMER_opt\" +property, or a fallback value built from headline's number. This +function assumes HEADLINE will be treated as a frame." + (let ((opt (org-element-property :BEAMER_OPT headline))) + (if (and (org-string-nw-p opt) + (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt)) + (match-string 1 opt) + (format "sec-%s" + (mapconcat 'number-to-string + (org-export-get-headline-number headline info) + "-"))))) + +(defun org-beamer--frame-level (headline info) "Return frame level in subtree containing HEADLINE. INFO is a plist used as a communication channel." (or @@ -341,33 +420,33 @@ INFO is a plist used as a communication channel." ;; farthest. (catch 'exit (mapc (lambda (parent) - (when (equal (org-element-property :beamer-env parent) "frame") - (throw 'exit (org-export-get-relative-level parent info)))) - (reverse (org-export-get-genealogy headline))) + (let ((env (org-element-property :BEAMER_ENV parent))) + (when (and env (member (downcase env) '("frame" "fullframe"))) + (throw 'exit (org-export-get-relative-level parent info))))) + (nreverse (org-export-get-genealogy headline))) nil) ;; 2. Look for "frame" environment in HEADLINE. - (and (equal (org-element-property :beamer-env headline) "frame") - (org-export-get-relative-level headline info)) + (let ((env (org-element-property :BEAMER_ENV headline))) + (and env (member (downcase env) '("frame" "fullframe")) + (org-export-get-relative-level headline info))) ;; 3. Look for "frame" environment in sub-tree. - (org-element-map - headline 'headline - (lambda (hl) - (when (equal (org-element-property :beamer-env hl) "frame") - (org-export-get-relative-level hl info))) - info 'first-match) + (org-element-map headline 'headline + (lambda (hl) + (let ((env (org-element-property :BEAMER_ENV hl))) + (when (and env (member (downcase env) '("frame" "fullframe"))) + (org-export-get-relative-level hl info)))) + info 'first-match) ;; 4. No "frame" environment in tree: use default value. (plist-get info :headline-levels))) -(defun org-e-beamer--format-section (headline contents info) +(defun org-beamer--format-section (headline contents info) "Format HEADLINE as a sectioning part. CONTENTS holds the contents of the headline. INFO is a plist used as a communication channel." - ;; Use `e-latex' back-end output, inserting overlay specifications + ;; Use `latex' back-end output, inserting overlay specifications ;; if possible. - (let ((latex-headline - (funcall (cdr (assq 'headline org-e-latex-translate-alist)) - headline contents info)) - (mode-specs (org-element-property :beamer-act headline))) + (let ((latex-headline (org-export-with-backend 'latex headline contents info)) + (mode-specs (org-element-property :BEAMER_ACT headline))) (if (and mode-specs (string-match "\\`\\\\\\(.*?\\)\\(?:\\*\\|\\[.*\\]\\)?{" latex-headline)) @@ -376,46 +455,48 @@ used as a communication channel." nil nil latex-headline 1) latex-headline))) -(defun org-e-beamer--format-frame (headline contents info) +(defun org-beamer--format-frame (headline contents info) "Format HEADLINE as a frame. CONTENTS holds the contents of the headline. INFO is a plist used as a communication channel." (let ((fragilep ;; FRAGILEP is non-nil when HEADLINE contains an element - ;; among `org-e-beamer-verbatim-elements'. - (org-element-map headline org-e-beamer-verbatim-elements 'identity + ;; among `org-beamer-verbatim-elements'. + (org-element-map headline org-beamer-verbatim-elements 'identity info 'first-match))) (concat "\\begin{frame}" - ;; Overlay specification, if any. If is surrounded by square - ;; brackets, consider it as a default specification. - (let ((action (org-element-property :beamer-act headline))) + ;; Overlay specification, if any. When surrounded by + ;; square brackets, consider it as a default + ;; specification. + (let ((action (org-element-property :BEAMER_ACT headline))) (cond ((not action) "") ((string-match "\\`\\[.*\\]\\'" action ) - (org-e-beamer--normalize-argument action 'defaction)) - (t (org-e-beamer--normalize-argument action 'action)))) + (org-beamer--normalize-argument action 'defaction)) + (t (org-beamer--normalize-argument action 'action)))) ;; Options, if any. - (let ((options - ;; Collect options from default value and headline's - ;; properties. Also add a label for links. - (append - (org-split-string org-e-beamer-frame-default-options - ",") - (let ((opt (org-element-property :beamer-opt headline))) - (and opt (org-split-string - ;; Remove square brackets if user - ;; provided them. - (and (string-match "^\\[?\\(.*\\)\\]?$" opt) - (match-string 1 opt)) - ","))) - (list - (format "label=sec-%s" - (mapconcat - 'number-to-string - (org-export-get-headline-number headline info) - "-")))))) + (let* ((beamer-opt (org-element-property :BEAMER_OPT headline)) + (options + ;; Collect options from default value and headline's + ;; properties. Also add a label for links. + (append + (org-split-string org-beamer-frame-default-options ",") + (and beamer-opt + (org-split-string + ;; Remove square brackets if user provided + ;; them. + (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt) + (match-string 1 beamer-opt)) + ",")) + ;; Provide an automatic label for the frame + ;; unless the user specified one. + (unless (and beamer-opt + (string-match "\\(^\\|,\\)label=" beamer-opt)) + (list + (format "label=%s" + (org-beamer--get-label headline info))))))) ;; Change options list into a string. - (org-e-beamer--normalize-argument + (org-beamer--normalize-argument (mapconcat 'identity (if (or (not fragilep) (member "fragile" options)) options @@ -423,9 +504,11 @@ used as a communication channel." ",") 'option)) ;; Title. - (format "{%s}" - (org-export-data (org-element-property :title headline) - info)) + (let ((env (org-element-property :BEAMER_ENV headline))) + (format "{%s}" + (if (and env (equal (downcase env) "fullframe")) "" + (org-export-data + (org-element-property :title headline) info)))) "\n" ;; The following workaround is required in fragile frames ;; as Beamer will append "\par" to the beginning of the @@ -435,59 +518,73 @@ used as a communication channel." ;; remove the first word from the contents in the PDF ;; output. (if (not fragilep) contents - (replace-regexp-in-string "\\`\n*" "\\& " contents)) + (replace-regexp-in-string "\\`\n*" "\\& " (or contents ""))) "\\end{frame}"))) -(defun org-e-beamer--format-block (headline contents info) +(defun org-beamer--format-block (headline contents info) "Format HEADLINE as a block. CONTENTS holds the contents of the headline. INFO is a plist used as a communication channel." - (let* ((column-width (org-element-property :beamer-col headline)) - ;; Environment defaults to "block" if none is specified and + (let* ((column-width (org-element-property :BEAMER_COL headline)) + ;; ENVIRONMENT defaults to "block" if none is specified and ;; there is no column specification. If there is a column ;; specified but still no explicit environment, ENVIRONMENT - ;; is nil. - (environment (let ((env (org-element-property :beamer-env headline))) + ;; is "column". + (environment (let ((env (org-element-property :BEAMER_ENV headline))) (cond ;; "block" is the fallback environment. ((and (not env) (not column-width)) "block") ;; "column" only. - ((not env) nil) + ((not env) "column") ;; Use specified environment. (t (downcase env))))) - (env-format (when environment + (env-format (unless (member environment '("column" "columns")) (assoc environment - (append org-e-beamer-environments-special - org-e-beamer-environments-extra - org-e-beamer-environments-default)))) + (append org-beamer-environments-special + org-beamer-environments-extra + org-beamer-environments-default)))) (title (org-export-data (org-element-property :title headline) info)) - ;; Start a columns environment when there is no previous - ;; headline or the previous headline do not have - ;; a BEAMER_column property. + (options (let ((options (org-element-property :BEAMER_OPT headline))) + (if (not options) "" + (org-beamer--normalize-argument options 'option)))) + ;; Start a "columns" environment when explicitly requested or + ;; when there is no previous headline or the previous + ;; headline do not have a BEAMER_column property. + (parent-env (org-element-property + :BEAMER_ENV (org-export-get-parent-headline headline))) (start-columns-p - (and column-width - (or (org-export-first-sibling-p headline info) - (not (org-element-property - :beamer-col - (org-export-get-previous-element headline info)))))) - ;; Ends a columns environment when there is no next headline - ;; or the next headline do not have a BEAMER_column property. + (or (equal environment "columns") + (and column-width + (not (and parent-env + (equal (downcase parent-env) "columns"))) + (or (org-export-first-sibling-p headline info) + (not (org-element-property + :BEAMER_COL + (org-export-get-previous-element + headline info))))))) + ;; End the "columns" environment when explicitly requested or + ;; when there is no next headline or the next headline do not + ;; have a BEAMER_column property. (end-columns-p - (and column-width - (or (org-export-last-sibling-p headline info) - (not (org-element-property - :beamer-col - (org-export-get-next-element headline info))))))) + (or (equal environment "columns") + (and column-width + (not (and parent-env + (equal (downcase parent-env) "columns"))) + (or (org-export-last-sibling-p headline info) + (not (org-element-property + :BEAMER_COL + (org-export-get-next-element headline info)))))))) (concat - (when start-columns-p "\\begin{columns}\n") + (when start-columns-p + ;; Column can accept options only when the environment is + ;; explicitly defined. + (if (not (equal environment "columns")) "\\begin{columns}\n" + (format "\\begin{columns}%s\n" options))) (when column-width (format "\\begin{column}%s{%s}\n" ;; One can specify placement for column only when ;; HEADLINE stands for a column on its own. - (if (not environment) "" - (let ((options (org-element-property :beamer-opt headline))) - (if (not options) "" - (org-e-beamer--normalize-argument options 'option)))) + (if (equal environment "column") options "") (format "%s\\textwidth" column-width))) ;; Block's opening string. (when env-format @@ -499,24 +596,17 @@ used as a communication channel." ;; brackets, it is a default overlay specification and ;; overlay specification is empty. Otherwise, it is an ;; overlay specification and the default one is nil. - (let ((action (org-element-property :beamer-act headline))) + (let ((action (org-element-property :BEAMER_ACT headline))) (cond ((not action) (list (cons "a" "") (cons "A" ""))) ((string-match "\\`\\[.*\\]\\'" action) (list - (cons "A" - (org-e-beamer--normalize-argument action 'defaction)) + (cons "A" (org-beamer--normalize-argument action 'defaction)) (cons "a" ""))) (t - (list - (cons "a" - (org-e-beamer--normalize-argument action 'action)) - (cons "A" ""))))) - (list (cons "o" - (let ((options - (org-element-property :beamer-opt headline))) - (if (not options) "" - (org-e-beamer--normalize-argument options 'option)))) + (list (cons "a" (org-beamer--normalize-argument action 'action)) + (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)))))) @@ -527,27 +617,65 @@ used as a communication channel." (when column-width "\\end{column}\n") (when end-columns-p "\\end{columns}")))) -(defun org-e-beamer-headline (headline contents info) +(defun org-beamer-headline (headline contents info) "Transcode HEADLINE element into Beamer code. CONTENTS is the contents of the headline. INFO is a plist used as a communication channel." (unless (org-element-property :footnote-section-p headline) (let ((level (org-export-get-relative-level headline info)) - (frame-level (org-e-beamer--frame-level headline info)) - (environment (let ((env (org-element-property :beamer-env headline))) + (frame-level (org-beamer--frame-level headline info)) + (environment (let ((env (org-element-property :BEAMER_ENV headline))) (if (stringp env) (downcase env) "block")))) (cond - ;; Creation of an appendix is requested. + ;; Case 1: Resume frame specified by "BEAMER_ref" property. + ((equal environment "againframe") + (let ((ref (org-element-property :BEAMER_REF headline))) + ;; Reference to frame being resumed is mandatory. Ignore + ;; the whole headline if it isn't provided. + (when (org-string-nw-p ref) + (concat "\\againframe" + ;; Overlay specification. + (let ((overlay (org-element-property :BEAMER_ACT headline))) + (when overlay + (org-beamer--normalize-argument + overlay + (if (string-match "^\\[.*\\]$" overlay) 'defaction + 'action)))) + ;; Options. + (let ((options (org-element-property :BEAMER_OPT headline))) + (when options + (org-beamer--normalize-argument options 'option))) + ;; Resolve reference provided by "BEAMER_ref" + ;; property. This is done by building a minimal fake + ;; link and calling the appropriate resolve function, + ;; depending on the reference syntax. + (let* ((type + (progn + (string-match "^\\(id:\\|#\\|\\*\\)?\\(.*\\)" ref) + (cond + ((or (not (match-string 1 ref)) + (equal (match-string 1 ref) "*")) 'fuzzy) + ((equal (match-string 1 ref) "id:") 'id) + (t 'custom-id)))) + (link (list 'link (list :path (match-string 2 ref)))) + (target (if (eq type 'fuzzy) + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + ;; Now use user-defined label provided in TARGET + ;; headline, or fallback to standard one. + (format "{%s}" (org-beamer--get-label target info))))))) + ;; Case 2: Creation of an appendix is requested. ((equal environment "appendix") (concat "\\appendix" - (org-element-property :beamer-act headline) + (org-element-property :BEAMER_ACT headline) "\n" (make-string (org-element-property :pre-blank headline) ?\n) contents)) + ;; Case 3: Ignore heading. ((equal environment "ignoreheading") (concat (make-string (org-element-property :pre-blank headline) ?\n) contents)) - ;; HEADLINE is a note. + ;; Case 4: HEADLINE is a note. ((member environment '("note" "noteNH")) (format "\\note{%s}" (concat (and (equal environment "note") @@ -556,27 +684,27 @@ as a communication channel." (org-element-property :title headline) info) "\n")) (org-trim contents)))) - ;; HEADLINE is a frame. - ((or (equal environment "frame") (= level frame-level)) - (org-e-beamer--format-frame headline contents info)) - ;; Regular section, extracted from `org-e-latex-classes'. + ;; Case 5: HEADLINE is a frame. + ((= level frame-level) + (org-beamer--format-frame headline contents info)) + ;; Case 6: Regular section, extracted from + ;; `org-latex-classes'. ((< level frame-level) - (org-e-beamer--format-section headline contents info)) - ;; Otherwise, HEADLINE is a block. - (t (org-e-beamer--format-block headline contents info)))))) + (org-beamer--format-section headline contents info)) + ;; Case 7: Otherwise, HEADLINE is a block. + (t (org-beamer--format-block headline contents info)))))) ;;;; Item -(defun org-e-beamer-item (item contents info) +(defun org-beamer-item (item contents info) "Transcode an ITEM element into Beamer code. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let ((action (let ((first-element (car (org-element-contents item)))) (and (eq (org-element-type first-element) 'paragraph) - (org-e-beamer--element-has-overlay-p first-element)))) - (output (funcall (cdr (assq 'item org-e-latex-translate-alist)) - item contents info))) + (org-beamer--element-has-overlay-p first-element)))) + (output (org-export-with-backend 'latex item contents info))) (if (not action) output ;; If the item starts with a paragraph and that paragraph starts ;; with an export snippet specifying an overlay, insert it after @@ -586,14 +714,14 @@ contextual information." ;;;; Keyword -(defun org-e-beamer-keyword (keyword contents info) +(defun org-beamer-keyword (keyword contents info) "Transcode a KEYWORD element into Beamer code. CONTENTS is nil. INFO is a plist used as a communication channel." (let ((key (org-element-property :key keyword)) (value (org-element-property :value keyword))) ;; Handle specifically BEAMER and TOC (headlines only) keywords. - ;; Otherwise, fallback to `e-latex' back-end. + ;; Otherwise, fallback to `latex' back-end. (cond ((equal key "BEAMER") value) ((and (equal key "TOC") (string-match "\\" value)) @@ -603,17 +731,14 @@ channel." (options (and (string-match "\\[.*?\\]" value) (match-string 0 value)))) (concat - "\\begin{frame}" (when (wholenump depth) (format "\\setcounter{tocdepth}{%s}\n" depth)) - "\\tableofcontents" options "\n" - "\\end{frame}"))) - (t (funcall (cdr (assq 'keyword org-e-latex-translate-alist)) - keyword contents info))))) + "\\tableofcontents" options))) + (t (org-export-with-backend 'latex keyword contents info))))) ;;;; Link -(defun org-e-beamer-link (link contents info) +(defun org-beamer-link (link contents info) "Transcode a LINK object into Beamer code. CONTENTS is the description part of the link. INFO is a plist used as a communication channel." @@ -625,7 +750,7 @@ used as a communication channel." (let ((destination (org-export-resolve-radio-link link info))) (when destination (format "\\hyperlink%s{%s}{%s}" - (or (org-e-beamer--element-has-overlay-p link) "") + (or (org-beamer--element-has-overlay-p link) "") (org-export-solidify-link-text path) (org-export-data (org-element-contents destination) info))))) ((and (member type '("custom-id" "fuzzy" "id")) @@ -644,56 +769,50 @@ used as a communication channel." (if (and (plist-get info :section-numbers) (not contents)) (format "\\ref{%s}" label) (format "\\hyperlink%s{%s}{%s}" - (or (org-e-beamer--element-has-overlay-p link) "") + (or (org-beamer--element-has-overlay-p link) "") label contents)))) (target (let ((path (org-export-solidify-link-text path))) (if (not contents) (format "\\ref{%s}" path) (format "\\hyperlink%s{%s}{%s}" - (or (org-e-beamer--element-has-overlay-p link) "") + (or (org-beamer--element-has-overlay-p link) "") path contents)))))))) - ;; Otherwise, use `e-latex' back-end. - (t (funcall (cdr (assq 'link org-e-latex-translate-alist)) - link contents info))))) + ;; Otherwise, use `latex' back-end. + (t (org-export-with-backend 'latex link contents info))))) ;;;; Plain List ;; -;; Plain lists support `:overlay' (for any type), `:template' (for -;; ordered lists only) and `:long-text' (for description lists only) +;; Plain lists support `:environment', `:overlay' and `:options' ;; attributes. -(defun org-e-beamer-plain-list (plain-list contents info) +(defun org-beamer-plain-list (plain-list contents info) "Transcode a PLAIN-LIST element into Beamer code. CONTENTS is the contents of the list. INFO is a plist holding contextual information." (let* ((type (org-element-property :type plain-list)) - (attributes (org-export-read-attribute :attr_beamer plain-list)) - (latex-type (cond ((eq type 'ordered) "enumerate") - ((eq type 'descriptive) "description") - (t "itemize")))) - (org-e-latex--wrap-label + (attributes (org-combine-plists + (org-export-read-attribute :attr_latex plain-list) + (org-export-read-attribute :attr_beamer plain-list))) + (latex-type (let ((env (plist-get attributes :environment))) + (cond (env) + ((eq type 'ordered) "enumerate") + ((eq type 'descriptive) "description") + (t "itemize"))))) + (org-latex--wrap-label plain-list (format "\\begin{%s}%s%s\n%s\\end{%s}" latex-type ;; Default overlay specification, if any. - (let ((overlay (plist-get attributes :overlay))) - (if (not overlay) "" - (org-e-beamer--normalize-argument overlay 'defaction))) + (org-beamer--normalize-argument + (or (plist-get attributes :overlay) "") + 'defaction) ;; Second optional argument depends on the list type. - (case type - (ordered - (let ((template (plist-get attributes :template))) - (if (not template) "" - (org-e-beamer--normalize-argument template 'option)))) - (descriptive - (let ((long-text (plist-get attributes :long-text))) - (if (not long-text) "" - (org-e-beamer--normalize-argument long-text 'option)))) - ;; There's no second argument for un-ordered lists. - (otherwise "")) + (org-beamer--normalize-argument + (or (plist-get attributes :options) "") + 'option) ;; Eventually insert contents and close environment. contents latex-type)))) @@ -701,12 +820,12 @@ contextual information." ;;;; Radio Target -(defun org-e-beamer-radio-target (radio-target text info) +(defun org-beamer-radio-target (radio-target text info) "Transcode a RADIO-TARGET object into Beamer code. TEXT is the text of the target. INFO is a plist holding contextual information." (format "\\hypertarget%s{%s}{%s}" - (or (org-e-beamer--element-has-overlay-p radio-target) "") + (or (org-beamer--element-has-overlay-p radio-target) "") (org-export-solidify-link-text (org-element-property :value radio-target)) text)) @@ -714,7 +833,7 @@ contextual information." ;;;; Target -(defun org-e-beamer-target (target contents info) +(defun org-beamer-target (target contents info) "Transcode a TARGET object into Beamer code. CONTENTS is nil. INFO is a plist holding contextual information." @@ -724,10 +843,10 @@ information." ;;;; Template ;; -;; Template used is similar to the one used in `e-latex' back-end, +;; Template used is similar to the one used in `latex' back-end, ;; excepted for the table of contents and Beamer themes. -(defun org-e-beamer-template (contents info) +(defun org-beamer-template (contents info) "Return complete document string after Beamer conversion. CONTENTS is the transcoded contents string. INFO is a plist holding export options." @@ -740,22 +859,24 @@ holding export options." (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-e-latex-classes))) + (let* ((header (nth 1 (assoc class org-latex-classes))) (document-class-string (and (stringp header) - (if class-options - (replace-regexp-in-string - "^[ \t]*\\\\documentclass\\(\\[.*?\\]\\)" - class-options header t nil 1) - header)))) - (when document-class-string - (org-e-latex--guess-babel-language - (org-e-latex--guess-inputenc + (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-export-latex-default-packages-alist ; defined in org.el - org-export-latex-packages-alist nil ; defined in org.el - (plist-get info :latex-header-extra))) + 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))))) ;; 3. Insert themes. (let ((format-theme @@ -792,33 +913,35 @@ holding export options." (author (format "\\author{%s}\n" author)) (t "\\author{}\n"))) ;; 6. Date. - (format "\\date{%s}\n" (org-export-data (plist-get info :date) info)) + (let ((date (and (plist-get info :with-date) (org-export-get-date info)))) + (format "\\date{%s}\n" (org-export-data date info))) ;; 7. Title (format "\\title{%s}\n" title) ;; 8. Hyperref options. - (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" - (or (plist-get info :keywords) "") - (or (plist-get info :description) "") - (if (not (plist-get info :with-creator)) "" - (plist-get info :creator))) + (when (plist-get info :latex-hyperref-p) + (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" + (or (plist-get info :keywords) "") + (or (plist-get info :description) "") + (if (not (plist-get info :with-creator)) "" + (plist-get info :creator)))) ;; 9. Document start. "\\begin{document}\n\n" ;; 10. Title command. (org-element-normalize-string (cond ((string= "" title) nil) - ((not (stringp org-e-latex-title-command)) nil) + ((not (stringp org-latex-title-command)) nil) ((string-match "\\(?:[^%]\\|^\\)%s" - org-e-latex-title-command) - (format org-e-latex-title-command title)) - (t org-e-latex-title-command))) + org-latex-title-command) + (format org-latex-title-command title)) + (t org-latex-title-command))) ;; 11. Table of contents. (let ((depth (plist-get info :with-toc))) (when depth (concat (format "\\begin{frame}%s{%s}\n" - (org-e-beamer--normalize-argument - org-e-beamer-outline-frame-options 'option) - org-e-beamer-outline-frame-title) + (org-beamer--normalize-argument + org-beamer-outline-frame-options 'option) + org-beamer-outline-frame-title) (when (wholenump depth) (format "\\setcounter{tocdepth}{%d}\n" depth)) "\\tableofcontents\n" @@ -840,26 +963,26 @@ holding export options." ;;; Minor Mode -(defvar org-e-beamer-mode-map (make-sparse-keymap) - "The keymap for `org-e-beamer-mode'.") -(define-key org-e-beamer-mode-map "\C-c\C-b" 'org-e-beamer-select-environment) +(defvar org-beamer-mode-map (make-sparse-keymap) + "The keymap for `org-beamer-mode'.") +(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment) ;;;###autoload -(define-minor-mode org-e-beamer-mode +(define-minor-mode org-beamer-mode "Support for editing Beamer oriented Org mode files." - nil " Bm" 'org-e-beamer-mode-map) + nil " Bm" 'org-beamer-mode-map) (when (fboundp 'font-lock-add-keywords) (font-lock-add-keywords 'org-mode - '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-e-beamer-tag prepend)) + '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-beamer-tag prepend)) 'prepend)) -(defface org-e-beamer-tag '((t (:box (:line-width 1 :color grey40)))) +(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40)))) "The special face for beamer tags." - :group 'org-export-e-beamer) + :group 'org-export-beamer) -(defun org-e-beamer-property-changed (property value) +(defun org-beamer-property-changed (property value) "Track the BEAMER_env property with tags. PROPERTY is the name of the modified property. VALUE is its new value." @@ -867,43 +990,43 @@ value." ((equal property "BEAMER_env") (save-excursion (org-back-to-heading t) - (let ((tags (org-get-tags))) - (setq tags (delq nil (mapcar (lambda (x) - (if (string-match "^B_" x) nil x)) - tags))) - (org-set-tags-to tags)) - (when (org-string-nw-p value) (org-toggle-tag (concat "B_" value) 'on)))) + ;; Filter out Beamer-related tags and install environment tag. + (let ((tags (org-remove-if (lambda (x) (string-match "^B_" x)) + (org-get-tags))) + (env-tag (and (org-string-nw-p value) (concat "B_" value)))) + (org-set-tags-to (if env-tag (cons env-tag tags) tags)) + (when env-tag (org-toggle-tag env-tag 'on))))) ((equal property "BEAMER_col") (org-toggle-tag "BMCOL" (if (org-string-nw-p value) 'on 'off))))) -(add-hook 'org-property-changed-functions 'org-e-beamer-property-changed) +(add-hook 'org-property-changed-functions 'org-beamer-property-changed) -(defun org-e-beamer-allowed-property-values (property) +(defun org-beamer-allowed-property-values (property) "Supply allowed values for PROPERTY." (cond ((and (equal property "BEAMER_env") (not (org-entry-get nil (concat property "_ALL") 'inherit))) ;; If no allowed values for BEAMER_env have been defined, ;; supply all defined environments - (mapcar 'car (append org-e-beamer-environments-special - org-e-beamer-environments-extra - org-e-beamer-environments-default))) + (mapcar 'car (append org-beamer-environments-special + org-beamer-environments-extra + org-beamer-environments-default))) ((and (equal property "BEAMER_col") (not (org-entry-get nil (concat property "_ALL") 'inherit))) ;; If no allowed values for BEAMER_col have been defined, ;; supply some - (org-split-string org-e-beamer-column-widths " ")))) + (org-split-string org-beamer-column-widths " ")))) (add-hook 'org-property-allowed-value-functions - 'org-e-beamer-allowed-property-values) + 'org-beamer-allowed-property-values) ;;; Commands ;;;###autoload -(defun org-e-beamer-export-as-latex - (&optional subtreep visible-only body-only ext-plist) +(defun org-beamer-export-as-latex + (&optional async subtreep visible-only body-only ext-plist) "Export current buffer as a Beamer buffer. If narrowing is active in the current buffer, only export its @@ -911,6 +1034,10 @@ narrowed part. If a region is active, export that region. +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + When optional argument SUBTREEP is non-nil, export the sub-tree at point, extracting information from the headline properties first. @@ -925,20 +1052,31 @@ EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to file-local settings. -Export is done in a buffer named \"*Org E-BEAMER Export*\", which +Export is done in a buffer named \"*Org BEAMER Export*\", which will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) - (let ((outbuf (org-export-to-buffer - 'e-beamer "*Org E-BEAMER Export*" - subtreep visible-only body-only ext-plist))) - (with-current-buffer outbuf (LaTeX-mode)) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window outbuf)))) + (if async + (org-export-async-start + (lambda (output) + (with-current-buffer (get-buffer-create "*Org BEAMER Export*") + (erase-buffer) + (insert output) + (goto-char (point-min)) + (LaTeX-mode) + (org-export-add-to-stack (current-buffer) 'beamer))) + `(org-export-as 'beamer ,subtreep ,visible-only ,body-only + ',ext-plist)) + (let ((outbuf (org-export-to-buffer + 'beamer "*Org BEAMER Export*" + subtreep visible-only body-only ext-plist))) + (with-current-buffer outbuf (LaTeX-mode)) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window outbuf))))) ;;;###autoload -(defun org-e-beamer-export-to-latex - (&optional subtreep visible-only body-only ext-plist pub-dir) +(defun org-beamer-export-to-latex + (&optional async subtreep visible-only body-only ext-plist) "Export current buffer as a Beamer presentation (tex). If narrowing is active in the current buffer, only export its @@ -946,6 +1084,10 @@ narrowed part. If a region is active, export that region. +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + When optional argument SUBTREEP is non-nil, export the sub-tree at point, extracting information from the headline properties first. @@ -960,18 +1102,22 @@ EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to file-local settings. -When optional argument PUB-DIR is set, use it as the publishing -directory. - Return output file's name." (interactive) - (let ((outfile (org-export-output-file-name ".tex" subtreep pub-dir))) - (org-export-to-file - 'e-beamer outfile subtreep visible-only body-only ext-plist))) + (let ((outfile (org-export-output-file-name ".tex" subtreep))) + (if async + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'beamer)) + `(expand-file-name + (org-export-to-file + 'beamer ,outfile ,subtreep ,visible-only ,body-only + ',ext-plist))) + (org-export-to-file + 'beamer outfile subtreep visible-only body-only ext-plist)))) ;;;###autoload -(defun org-e-beamer-export-to-pdf - (&optional subtreep visible-only body-only ext-plist pub-dir) +(defun org-beamer-export-to-pdf + (&optional async subtreep visible-only body-only ext-plist) "Export current buffer as a Beamer presentation (PDF). If narrowing is active in the current buffer, only export its @@ -979,6 +1125,10 @@ narrowed part. If a region is active, export that region. +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + When optional argument SUBTREEP is non-nil, export the sub-tree at point, extracting information from the headline properties first. @@ -993,17 +1143,23 @@ EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to file-local settings. -When optional argument PUB-DIR is set, use it as the publishing -directory. - Return PDF file's name." (interactive) - (org-e-latex-compile - (org-e-beamer-export-to-latex - subtreep visible-only body-only ext-plist pub-dir))) + (if async + (let ((outfile (org-export-output-file-name ".tex" subtreep))) + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'beamer)) + `(expand-file-name + (org-latex-compile + (org-export-to-file + 'beamer ,outfile ,subtreep ,visible-only ,body-only + ',ext-plist))))) + (org-latex-compile + (org-beamer-export-to-latex + nil subtreep visible-only body-only ext-plist)))) ;;;###autoload -(defun org-e-beamer-select-environment () +(defun org-beamer-select-environment () "Select the environment to be used by beamer for this entry. While this uses (for convenience) a tag selection interface, the result of this command will be that the BEAMER_env *property* of @@ -1012,11 +1168,11 @@ the entry is set. In addition to this, the command will also set a tag as a visual aid, but the tag does not have any semantic meaning." (interactive) - ;; Make sure `org-e-beamer-environments-special' has a higher - ;; priority than `org-e-beamer-environments-extra'. - (let* ((envs (append org-e-beamer-environments-special - org-e-beamer-environments-extra - org-e-beamer-environments-default)) + ;; Make sure `org-beamer-environments-special' has a higher + ;; priority than `org-beamer-environments-extra'. + (let* ((envs (append org-beamer-environments-special + org-beamer-environments-extra + org-beamer-environments-default)) (org-tag-alist (append '((:startgroup)) (mapcar (lambda (e) (cons (concat "B_" (car e)) @@ -1028,19 +1184,30 @@ aid, but the tag does not have any semantic meaning." (org-set-tags) (let ((tags (or (ignore-errors (org-get-tags-string)) ""))) (cond + ;; For a column, automatically ask for its width. ((eq org-last-tag-selection-key ?|) (if (string-match ":BMCOL:" tags) (org-set-property "BEAMER_col" (read-string "Column width: ")) (org-delete-property "BEAMER_col"))) - ((string-match (concat ":B_\\(" - (mapconcat 'car envs "\\|") - "\\):") - tags) + ;; For an "againframe" section, automatically ask for reference + ;; to resumed frame and overlay specifications. + ((eq org-last-tag-selection-key ?A) + (if (equal (org-entry-get nil "BEAMER_env") "againframe") + (progn (org-entry-delete nil "BEAMER_env") + (org-entry-delete nil "BEAMER_ref") + (org-entry-delete nil "BEAMER_act")) + (org-entry-put nil "BEAMER_env" "againframe") + (org-set-property + "BEAMER_ref" + (read-string "Frame reference (*Title, #custom-id, id:...): ")) + (org-set-property "BEAMER_act" + (read-string "Overlay specification: ")))) + ((string-match (concat ":B_\\(" (mapconcat 'car envs "\\|") "\\):") tags) (org-entry-put nil "BEAMER_env" (match-string 1 tags))) (t (org-entry-delete nil "BEAMER_env")))))) ;;;###autoload -(defun org-e-beamer-insert-options-template (&optional kind) +(defun org-beamer-insert-options-template (&optional kind) "Insert a settings template, to make sure users do this right." (interactive (progn (message "Current [s]ubtree or [g]lobal?") @@ -1053,17 +1220,48 @@ aid, but the tag does not have any semantic meaning." (org-entry-put nil "EXPORT_LaTeX_CLASS" "beamer") (org-entry-put nil "EXPORT_LaTeX_CLASS_OPTIONS" "[presentation]") (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf") - (when org-e-beamer-column-view-format - (org-entry-put nil "COLUMNS" org-e-beamer-column-view-format)) - (org-entry-put nil "BEAMER_col_ALL" org-e-beamer-column-widths)) + (when org-beamer-column-view-format + (org-entry-put nil "COLUMNS" org-beamer-column-view-format)) + (org-entry-put nil "BEAMER_col_ALL" org-beamer-column-widths)) (insert "#+LaTeX_CLASS: beamer\n") (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n") - (when org-e-beamer-theme - (insert "#+BEAMER_THEME: " org-e-beamer-theme "\n")) - (when org-e-beamer-column-view-format - (insert "#+COLUMNS: " org-e-beamer-column-view-format "\n")) - (insert "#+PROPERTY: BEAMER_col_ALL " org-e-beamer-column-widths "\n"))) + (when org-beamer-theme (insert "#+BEAMER_THEME: " org-beamer-theme "\n")) + (when org-beamer-column-view-format + (insert "#+COLUMNS: " org-beamer-column-view-format "\n")) + (insert "#+PROPERTY: BEAMER_col_ALL " org-beamer-column-widths "\n"))) + +;;;###autoload +(defun org-beamer-publish-to-latex (plist filename pub-dir) + "Publish an Org file to a Beamer presentation (LaTeX). + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'beamer filename ".tex" plist pub-dir)) + +;;;###autoload +(defun org-beamer-publish-to-pdf (plist filename pub-dir) + "Publish an Org file to a Beamer presentation (PDF, via LaTeX). + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + ;; Unlike to `org-beamer-publish-to-latex', PDF file is generated in + ;; working directory and then moved to publishing directory. + (org-publish-attachment + plist + (org-latex-compile (org-publish-org-to 'beamer filename ".tex" plist)) + pub-dir)) -(provide 'org-e-beamer) -;;; org-e-beamer.el ends here +(provide 'ox-beamer) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-beamer.el ends here diff --git a/lisp/ox-html.el b/lisp/ox-html.el new file mode 100644 index 000000000..cfb83abf9 --- /dev/null +++ b/lisp/ox-html.el @@ -0,0 +1,3303 @@ +;;; ox-html.el --- HTML Back-End for Org Export Engine + +;; Copyright (C) 2011-2013 Free Software Foundation, Inc. + +;; Author: Jambunathan K +;; Keywords: outlines, hypermedia, calendar, wp + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This library implements a HTML back-end for Org generic exporter. + +;; To test it, run: +;; +;; M-x org-export-as-html +;; +;; in an Org mode buffer. See ox.el for more details on how this +;; exporter works. + +;;; Code: + +;;; Dependencies + +(require 'ox) +(require 'ox-publish) +(require 'format-spec) +(eval-when-compile (require 'cl) (require 'table)) + + +;;; Function Declarations + +(declare-function org-id-find-id-file "org-id" (id)) +(declare-function htmlize-region "ext:htmlize" (beg end)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) +(declare-function mm-url-decode-entities "mm-url" ()) + +;;; Define Back-End + +(org-export-define-backend 'html + '((bold . org-html-bold) + (center-block . org-html-center-block) + (clock . org-html-clock) + (code . org-html-code) + (drawer . org-html-drawer) + (dynamic-block . org-html-dynamic-block) + (entity . org-html-entity) + (example-block . org-html-example-block) + (export-block . org-html-export-block) + (export-snippet . org-html-export-snippet) + (fixed-width . org-html-fixed-width) + (footnote-definition . org-html-footnote-definition) + (footnote-reference . org-html-footnote-reference) + (headline . org-html-headline) + (horizontal-rule . org-html-horizontal-rule) + (inline-src-block . org-html-inline-src-block) + (inlinetask . org-html-inlinetask) + (inner-template . org-html-inner-template) + (italic . org-html-italic) + (item . org-html-item) + (keyword . org-html-keyword) + (latex-environment . org-html-latex-environment) + (latex-fragment . org-html-latex-fragment) + (line-break . org-html-line-break) + (link . org-html-link) + (paragraph . org-html-paragraph) + (plain-list . org-html-plain-list) + (plain-text . org-html-plain-text) + (planning . org-html-planning) + (property-drawer . org-html-property-drawer) + (quote-block . org-html-quote-block) + (quote-section . org-html-quote-section) + (radio-target . org-html-radio-target) + (section . org-html-section) + (special-block . org-html-special-block) + (src-block . org-html-src-block) + (statistics-cookie . org-html-statistics-cookie) + (strike-through . org-html-strike-through) + (subscript . org-html-subscript) + (superscript . org-html-superscript) + (table . org-html-table) + (table-cell . org-html-table-cell) + (table-row . org-html-table-row) + (target . org-html-target) + (template . org-html-template) + (timestamp . org-html-timestamp) + (underline . org-html-underline) + (verbatim . org-html-verbatim) + (verse-block . org-html-verse-block)) + :export-block "HTML" + :filters-alist '((:filter-options . org-html-infojs-install-script) + (:filter-final-output . org-html-final-function)) + :menu-entry + '(?h "Export to HTML" + ((?H "As HTML buffer" org-html-export-as-html) + (?h "As HTML file" org-html-export-to-html) + (?o "As HTML file and open" + (lambda (a s v b) + (if a (org-html-export-to-html t s v b) + (org-open-file (org-html-export-to-html nil s v b))))))) + :options-alist + '((:html-extension nil nil org-html-extension) + (:html-link-org-as-html nil nil org-html-link-org-files-as-html) + (:html-doctype "HTML_DOCTYPE" nil org-html-doctype) + (:html-container "HTML_CONTAINER" nil org-html-container-element) + (:html-link-home "HTML_LINK_HOME" nil org-html-link-home) + (:html-link-up "HTML_LINK_UP" nil org-html-link-up) + (:html-mathjax "HTML_MATHJAX" nil "" space) + (:html-postamble nil "html-postamble" org-html-postamble) + (:html-preamble nil "html-preamble" org-html-preamble) + (:html-head "HTML_HEAD" nil org-html-head newline) + (:html-head-extra "HTML_HEAD_EXTRA" nil org-html-head-extra newline) + (:html-head-include-default-style "HTML_INCLUDE_STYLE" nil org-html-head-include-default-style newline) + (:html-head-include-scripts "HTML_INCLUDE_SCRIPTS" nil org-html-head-include-scripts newline) + (:html-table-attributes nil nil org-html-table-default-attributes) + (:html-table-row-tags nil nil org-html-table-row-tags) + (:html-xml-declaration nil nil org-html-xml-declaration) + (:html-inline-images nil nil org-html-inline-images) + (:infojs-opt "INFOJS_OPT" nil nil) + ;; Redefine regular options. + (:creator "CREATOR" nil org-html-creator-string) + (:with-latex nil "tex" org-html-with-latex))) + + +;;; Internal Variables + +(defvar org-html-format-table-no-css) +(defvar htmlize-buffer-places) ; from htmlize.el + +(defvar org-html--pre/postamble-class "status" + "CSS class used for pre/postamble") + +(defconst org-html-special-string-regexps + '(("\\\\-" . "­") ; shy + ("---\\([^-]\\)" . "—\\1") ; mdash + ("--\\([^-]\\)" . "–\\1") ; ndash + ("\\.\\.\\." . "…")) ; hellip + "Regular expressions for special string conversion.") + +(defconst org-html-scripts + "" + "Basic JavaScript that is needed by HTML files produced by Org mode.") + +(defconst org-html-style-default + "" + "The default style specification for exported HTML files. +You can use `org-html-head' and `org-html-head-extra' to add to +this style. If you don't want to include this default style, +customize `org-html-head-include-default-style'.") + + +;;; User Configuration Variables + +(defgroup org-export-html nil + "Options for exporting Org mode files to HTML." + :tag "Org Export HTML" + :group 'org-export) + +;;;; Handle infojs + +(defvar org-html-infojs-opts-table + '((path PATH "http://orgmode.org/org-info.js") + (view VIEW "info") + (toc TOC :with-toc) + (ftoc FIXED_TOC "0") + (tdepth TOC_DEPTH "max") + (sdepth SECTION_DEPTH "max") + (mouse MOUSE_HINT "underline") + (buttons VIEW_BUTTONS "0") + (ltoc LOCAL_TOC "1") + (up LINK_UP :html-link-up) + (home LINK_HOME :html-link-home)) + "JavaScript options, long form for script, default values.") + +(defcustom org-html-use-infojs 'when-configured + "Non-nil when Sebastian Rose's Java Script org-info.js should be active. +This option can be nil or t to never or always use the script. +It can also be the symbol `when-configured', meaning that the +script will be linked into the export file if and only if there +is a \"#+INFOJS_OPT:\" line in the buffer. See also the variable +`org-html-infojs-options'." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Never" nil) + (const :tag "When configured in buffer" when-configured) + (const :tag "Always" t))) + +(defcustom org-html-infojs-options + (mapcar (lambda (x) (cons (car x) (nth 2 x))) org-html-infojs-opts-table) + "Options settings for the INFOJS JavaScript. +Each of the options must have an entry in `org-html-infojs-opts-table'. +The value can either be a string that will be passed to the script, or +a property. This property is then assumed to be a property that is defined +by the Export/Publishing setup of Org. +The `sdepth' and `tdepth' parameters can also be set to \"max\", which +means to use the maximum value consistent with other options." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type + `(set :greedy t :inline t + ,@(mapcar + (lambda (x) + (list 'cons (list 'const (car x)) + '(choice + (symbol :tag "Publishing/Export property") + (string :tag "Value")))) + org-html-infojs-opts-table))) + +(defcustom org-html-infojs-template + " + +" + "The template for the export style additions when org-info.js is used. +Option settings will replace the %MANAGER-OPTIONS cookie." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defun org-html-infojs-install-script (exp-plist backend) + "Install script in export options when appropriate. +EXP-PLIST is a plist containing export options. BACKEND is the +export back-end currently used." + (unless (or (memq 'body-only (plist-get exp-plist :export-options)) + (not org-html-use-infojs) + (and (eq org-html-use-infojs 'when-configured) + (or (not (plist-get exp-plist :infojs-opt)) + (string-match "\\" + (plist-get exp-plist :infojs-opt))))) + (let* ((template org-html-infojs-template) + (ptoc (plist-get exp-plist :with-toc)) + (hlevels (plist-get exp-plist :headline-levels)) + (sdepth hlevels) + (tdepth (if (integerp ptoc) (min ptoc hlevels) hlevels)) + (options (plist-get exp-plist :infojs-opt)) + (table org-html-infojs-opts-table) + style) + (dolist (entry table) + (let* ((opt (car entry)) + (var (nth 1 entry)) + ;; Compute default values for script option OPT from + ;; `org-html-infojs-options' variable. + (default + (let ((default (cdr (assq opt org-html-infojs-options)))) + (if (and (symbolp default) (not (memq default '(t nil)))) + (plist-get exp-plist default) + default))) + ;; Value set through INFOJS_OPT keyword has precedence + ;; over the default one. + (val (if (and options + (string-match (format "\\<%s:\\(\\S-+\\)" opt) + options)) + (match-string 1 options) + default))) + (case opt + (path (setq template + (replace-regexp-in-string + "%SCRIPT_PATH" val template t t))) + (sdepth (when (integerp (read val)) + (setq sdepth (min (read val) sdepth)))) + (tdepth (when (integerp (read val)) + (setq tdepth (min (read val) tdepth)))) + (otherwise (setq val + (cond + ((or (eq val t) (equal val "t")) "1") + ((or (eq val nil) (equal val "nil")) "0") + ((stringp val) val) + (t (format "%s" val)))) + (push (cons var val) style))))) + ;; Now we set the depth of the *generated* TOC to SDEPTH, + ;; because the toc will actually determine the splitting. How + ;; much of the toc will actually be displayed is governed by the + ;; TDEPTH option. + (setq exp-plist (plist-put exp-plist :with-toc sdepth)) + ;; The table of contents should not show more sections than we + ;; generate. + (setq tdepth (min tdepth sdepth)) + (push (cons "TOC_DEPTH" tdepth) style) + ;; Build style string. + (setq style (mapconcat + (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");" + (car x) + (cdr x))) + style "\n")) + (when (and style (> (length style) 0)) + (and (string-match "%MANAGER_OPTIONS" template) + (setq style (replace-match style t t template)) + (setq exp-plist + (plist-put + exp-plist :html-head-extra + (concat (or (plist-get exp-plist :html-head-extra) "") + "\n" + style))))) + ;; This script absolutely needs the table of contents, so we + ;; change that setting. + (unless (plist-get exp-plist :with-toc) + (setq exp-plist (plist-put exp-plist :with-toc t))) + ;; Return the modified property list. + exp-plist))) + +;;;; Bold, etc. + +(defcustom org-html-text-markup-alist + '((bold . "%s") + (code . "%s") + (italic . "%s") + (strike-through . "%s") + (underline . "%s") + (verbatim . "%s")) + "Alist of HTML expressions to convert text markup. + +The key must be a symbol among `bold', `code', `italic', +`strike-through', `underline' and `verbatim'. The value is +a formatting string to wrap fontified text with. + +If no association can be found for a given markup, text will be +returned as-is." + :group 'org-export-html + :type '(alist :key-type (symbol :tag "Markup type") + :value-type (string :tag "Format string")) + :options '(bold code italic strike-through underline verbatim)) + +(defcustom org-html-indent nil + "Non-nil means to indent the generated HTML. +Warning: non-nil may break indentation of source code blocks." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-html-use-unicode-chars nil + "Non-nil means to use unicode characters instead of HTML entities." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +;;;; Drawers + +(defcustom org-html-format-drawer-function nil + "Function called to format a drawer in HTML code. + +The function must accept two parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + +The function should return the string to be exported. + +For example, the variable could be set to the following function +in order to mimic default behaviour: + +\(defun org-html-format-drawer-default \(name contents\) + \"Format a drawer element for HTML export.\" + contents\)" + :group 'org-export-html + :type 'function) + +;;;; Footnotes + +(defcustom org-html-footnotes-section "
    +

    %s:

    +
    +%s +
    +
    " + "Format for the footnotes section. +Should contain a two instances of %s. The first will be replaced with the +language-specific word for \"Footnotes\", the second one will be replaced +by the footnotes themselves." + :group 'org-export-html + :type 'string) + +(defcustom org-html-footnote-format "%s" + "The format for the footnote reference. +%s will be replaced by the footnote reference itself." + :group 'org-export-html + :type 'string) + +(defcustom org-html-footnote-separator ", " + "Text used to separate footnotes." + :group 'org-export-html + :type 'string) + +;;;; Headline + +(defcustom org-html-toplevel-hlevel 2 + "The level for level 1 headings in HTML export. +This is also important for the classes that will be wrapped around headlines +and outline structure. If this variable is 1, the top-level headlines will +be

    , and the corresponding classes will be outline-1, section-number-1, +and outline-text-1. If this is 2, all of these will get a 2 instead. +The default for this variable is 2, because we use

    for formatting the +document title." + :group 'org-export-html + :type 'integer) + +(defcustom org-html-format-headline-function nil + "Function to format headline text. + +This function will be called with 5 arguments: +TODO the todo keyword (string or nil). +TODO-TYPE the type of todo (symbol: `todo', `done', nil) +PRIORITY the priority of the headline (integer or nil) +TEXT the main headline text (string). +TAGS the tags (string or nil). + +The function result will be used in the section format string." + :group 'org-export-html + :type 'function) + +;;;; HTML-specific + +(defcustom org-html-allow-name-attribute-in-anchors t + "When nil, do not set \"name\" attribute in anchors. +By default, anchors are formatted with both \"id\" and \"name\" +attributes, when appropriate." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +;;;; Inlinetasks + +(defcustom org-html-format-inlinetask-function nil + "Function called to format an inlinetask in HTML code. + +The function must accept six parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a list of strings. + CONTENTS the contents of the inlinetask, as a string. + +The function should return the string to be exported." + :group 'org-export-html + :type 'function) + +;;;; LaTeX + +(defcustom org-html-with-latex org-export-with-latex + "Non-nil means process LaTeX math snippets. + +When set, the exporter will process LaTeX environments and +fragments. + +This option can also be set with the +OPTIONS line, +e.g. \"tex:mathjax\". Allowed values are: + +nil Ignore math snippets. +`verbatim' Keep everything in verbatim +`dvipng' Process the LaTeX fragments to images. This will also + include processing of non-math environments. +`imagemagick' Convert the LaTeX fragments to pdf files and use + imagemagick to convert pdf files to png files. +`mathjax' Do MathJax preprocessing and arrange for MathJax.js to + be loaded. +t Synonym for `mathjax'." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not process math in any way" nil) + (const :tag "Use dvipng to make images" dvipng) + (const :tag "Use imagemagick to make images" imagemagick) + (const :tag "Use MathJax to display math" mathjax) + (const :tag "Leave math verbatim" verbatim))) + +;;;; Links :: Generic + +(defcustom org-html-link-org-files-as-html t + "Non-nil means make file links to `file.org' point to `file.html'. +When `org-mode' is exporting an `org-mode' file to HTML, links to +non-html files are directly put into a href tag in HTML. +However, links to other Org-mode files (recognized by the +extension `.org.) should become links to the corresponding html +file, assuming that the linked `org-mode' file will also be +converted to HTML. +When nil, the links still point to the plain `.org' file." + :group 'org-export-html + :type 'boolean) + +;;;; Links :: Inline images + +(defcustom org-html-inline-images 'maybe + "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." + :group 'org-export-html + :type '(choice (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "When there is no description" maybe))) + +(defcustom org-html-inline-image-rules + '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") + ("http" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") + ("https" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")) + "Rules characterizing image files that can be inlined into HTML. +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +;;;; Plain Text + +(defcustom org-html-protect-char-alist + '(("&" . "&") + ("<" . "<") + (">" . ">")) + "Alist of characters to be converted by `org-html-protect'." + :group 'org-export-html + :type '(repeat (cons (string :tag "Character") + (string :tag "HTML equivalent")))) + +;;;; Src Block + +(defcustom org-html-htmlize-output-type 'inline-css + "Output type to be used by htmlize when formatting code snippets. +Choices are `css', to export the CSS selectors only, or `inline-css', to +export the CSS attribute values inline in the HTML. We use as default +`inline-css', in order to make the resulting HTML self-containing. + +However, this will fail when using Emacs in batch mode for export, because +then no rich font definitions are in place. It will also not be good if +people with different Emacs setup contribute HTML files to a website, +because the fonts will represent the individual setups. In these cases, +it is much better to let Org/Htmlize assign classes only, and to use +a style file to define the look of these classes. +To get a start for your css file, start Emacs session and make sure that +all the faces you are interested in are defined, for example by loading files +in all modes you want. Then, use the command +\\[org-html-htmlize-generate-css] to extract class definitions." + :group 'org-export-html + :type '(choice (const css) (const inline-css))) + +(defcustom org-html-htmlize-font-prefix "org-" + "The prefix for CSS class names for htmlize font specifications." + :group 'org-export-html + :type 'string) + +;;;; Table + +(defcustom org-html-table-default-attributes + '(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups" :frame "hsides") + "Default attributes and values which will be used in table tags. +This is a plist where attributes are symbols, starting with +colons, and values are strings." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(plist :key-type (symbol :tag "Property") + :value-type (string :tag "Value"))) + +(defcustom org-html-table-header-tags '("" . "") + "The opening tag for table header fields. +This is customizable so that alignment options can be specified. +The first %s will be filled with the scope of the field, either row or col. +The second %s will be replaced by a style entry to align the field. +See also the variable `org-html-table-use-header-tags-for-first-column'. +See also the variable `org-html-table-align-individual-fields'." + :group 'org-export-html + :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) + +(defcustom org-html-table-data-tags '("" . "") + "The opening tag for table data fields. +This is customizable so that alignment options can be specified. +The first %s will be filled with the scope of the field, either row or col. +The second %s will be replaced by a style entry to align the field. +See also the variable `org-html-table-align-individual-fields'." + :group 'org-export-html + :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) + +(defcustom org-html-table-row-tags '("" . "") + "The opening and ending tags for table rows. +This is customizable so that alignment options can be specified. +Instead of strings, these can be Lisp forms that will be +evaluated for each row in order to construct the table row tags. + +During evaluation, these variables will be dynamically bound so that +you can reuse them: + + `row-number': row number (0 is the first row) + `rowgroup-number': group number of current row + `start-rowgroup-p': non-nil means the row starts a group + `end-rowgroup-p': non-nil means the row ends a group + `top-row-p': non-nil means this is the top row + `bottom-row-p': non-nil means this is the bottom row + +For example: + +\(setq org-html-table-row-tags + (cons '(cond (top-row-p \"\") + (bottom-row-p \"\") + (t (if (= (mod row-number 2) 1) + \"\" + \"\"))) + \"\")) + +will use the \"tr-top\" and \"tr-bottom\" classes for the top row +and the bottom row, and otherwise alternate between \"tr-odd\" and +\"tr-even\" for odd and even rows." + :group 'org-export-html + :type '(cons + (choice :tag "Opening tag" + (string :tag "Specify") + (sexp)) + (choice :tag "Closing tag" + (string :tag "Specify") + (sexp)))) + +(defcustom org-html-table-align-individual-fields t + "Non-nil means attach style attributes for alignment to each table field. +When nil, alignment will only be specified in the column tags, but this +is ignored by some browsers (like Firefox, Safari). Opera does it right +though." + :group 'org-export-html + :type 'boolean) + +(defcustom org-html-table-use-header-tags-for-first-column nil + "Non-nil means format column one in tables with header tags. +When nil, also column one will use data tags." + :group 'org-export-html + :type 'boolean) + +(defcustom org-html-table-caption-above t + "When non-nil, place caption string at the beginning of the table. +Otherwise, place it near the end." + :group 'org-export-html + :type 'boolean) + +;;;; Tags + +(defcustom org-html-tag-class-prefix "" + "Prefix to class names for TODO keywords. +Each tag gets a class given by the tag itself, with this prefix. +The default prefix is empty because it is nice to just use the keyword +as a class name. But if you get into conflicts with other, existing +CSS classes, then this prefix can be very useful." + :group 'org-export-html + :type 'string) + +;;;; Template :: Generic + +(defcustom org-html-extension "html" + "The extension for exported HTML files." + :group 'org-export-html + :type 'string) + +(defcustom org-html-xml-declaration + '(("html" . "") + ("php" . "\"; ?>")) + "The extension for exported HTML files. +%s will be replaced with the charset of the exported file. +This may be a string, or an alist with export extensions +and corresponding declarations." + :group 'org-export-html + :type '(choice + (string :tag "Single declaration") + (repeat :tag "Dependent on extension" + (cons (string :tag "Extension") + (string :tag "Declaration"))))) + +(defcustom org-html-coding-system 'utf-8 + "Coding system for HTML export. +Use utf-8 as the default value." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'coding-system) + +(defcustom org-html-doctype + "" + "Document type definition to use for exported HTML files. +Can be set with the in-buffer HTML_DOCTYPE property or for +publishing, with :html-doctype." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-html-container-element "div" + "HTML element to use for wrapping top level sections. +Can be set with the in-buffer HTML_CONTAINER property or for +publishing, with :html-container. + +Note that changing the default will prevent you from using +org-info.js for your website." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-html-divs + '((preamble "div" "preamble") + (content "div" "content") + (postamble "div" "postamble")) + "Alist of the three section elements for HTML export. +The car of each entry is one of 'preamble, 'content or 'postamble. +The cdrs of each entry are the ELEMENT_TYPE and ID for each +section of the exported document. + +Note that changing the default will prevent you from using +org-info.js for your website." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(list :greedy t + (list :tag "Preamble" + (const :format "" preamble) + (string :tag "element") (string :tag " id")) + (list :tag "Content" + (const :format "" content) + (string :tag "element") (string :tag " id")) + (list :tag "Postamble" (const :format "" postamble) + (string :tag " id") (string :tag "element")))) + +(defcustom org-html-metadata-timestamp-format "%Y-%m-%d %a %H:%M" + "Format used for timestamps in preamble, postamble and metadata. +See `format-time-string' for more information on its components." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +;;;; Template :: Mathjax + +(defcustom org-html-mathjax-options + '((path "http://orgmode.org/mathjax/MathJax.js") + (scale "100") + (align "center") + (indent "2em") + (mathml nil)) + "Options for MathJax setup. + +path The path where to find MathJax +scale Scaling for the HTML-CSS backend, usually between 100 and 133 +align How to align display math: left, center, or right +indent If align is not center, how far from the left/right side? +mathml Should a MathML player be used if available? + This is faster and reduces bandwidth use, but currently + sometimes has lower spacing quality. Therefore, the default is + nil. When browsers get better, this switch can be flipped. + +You can also customize this for each buffer, using something like + +#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\"" + :group 'org-export-html + :type '(list :greedy t + (list :tag "path (the path from where to load MathJax.js)" + (const :format " " path) (string)) + (list :tag "scale (scaling for the displayed math)" + (const :format " " scale) (string)) + (list :tag "align (alignment of displayed equations)" + (const :format " " align) (string)) + (list :tag "indent (indentation with left or right alignment)" + (const :format " " indent) (string)) + (list :tag "mathml (should MathML display be used is possible)" + (const :format " " mathml) (boolean)))) + +(defcustom org-html-mathjax-template + "" + "The MathJax setup for XHTML files." + :group 'org-export-html + :type 'string) + +;;;; Template :: Postamble + +(defcustom org-html-postamble 'auto + "Non-nil means insert a postamble in HTML export. + +When set to 'auto, check against the +`org-export-with-author/email/creator/date' variables to set the +content of the postamble. When set to a string, use this string +as the postamble. When t, insert a string as defined by the +formatting string in `org-html-postamble-format'. + +When set to a function, apply this function and insert the +returned string. The function takes the property list of export +options as its only argument. + +Setting :html-postamble in publishing projects will take +precedence over this variable." + :group 'org-export-html + :type '(choice (const :tag "No postamble" nil) + (const :tag "Auto postamble" 'auto) + (const :tag "Default formatting string" t) + (string :tag "Custom formatting string") + (function :tag "Function (must return a string)"))) + +(defcustom org-html-postamble-format + '(("en" "

    Author: %a (%e)

    +

    Date: %d

    +

    %c

    +

    %v

    ")) + "Alist of languages and format strings for the HTML postamble. + +The first element of each list is the language code, as used for +the LANGUAGE keyword. See `org-export-default-language'. + +The second element of each list is a format string to format the +postamble itself. This format string can contain these elements: + + %t stands for the title. + %a stands for the author's name. + %e stands for the author's email. + %d stands for the date. + %c will be replaced by `org-html-creator-string'. + %v will be replaced by `org-html-validation-link'. + %T will be replaced by the export time. + %C will be replaced by the last modification time. + +If you need to use a \"%\" character, you need to escape it +like that: \"%%\"." + :group 'org-export-html + :type '(alist :key-type (string :tag "Language") + :value-type (string :tag "Format string"))) + +(defcustom org-html-validation-link + "Validate XHTML 1.0" + "Link to HTML validation service." + :group 'org-export-html + :type 'string) + +(defcustom org-html-creator-string + (format "Emacs %s (Org mode %s)" + emacs-version + (if (fboundp 'org-version) (org-version) "unknown version")) + "Information about the creator of the HTML document. +This option can also be set on with the CREATOR keyword." + :group 'org-export-html + :type '(string :tag "Creator string")) + +;;;; Template :: Preamble + +(defcustom org-html-preamble t + "Non-nil means insert a preamble in HTML export. + +When t, insert a string as defined by the formatting string in +`org-html-preamble-format'. When set to a string, use this +formatting string instead (see `org-html-postamble-format' for an +example of such a formatting string). + +When set to a function, apply this function and insert the +returned string. The function takes the property list of export +options as its only argument. + +Setting :html-preamble in publishing projects will take +precedence over this variable." + :group 'org-export-html + :type '(choice (const :tag "No preamble" nil) + (const :tag "Default preamble" t) + (string :tag "Custom formatting string") + (function :tag "Function (must return a string)"))) + +(defcustom org-html-preamble-format '(("en" "")) + "Alist of languages and format strings for the HTML preamble. + +The first element of each list is the language code, as used for +the LANGUAGE keyword. See `org-export-default-language'. + +The second element of each list is a format string to format the +preamble itself. This format string can contain these elements: + + %t stands for the title. + %a stands for the author's name. + %e stands for the author's email. + %d stands for the date. + %c will be replaced by `org-html-creator-string'. + %v will be replaced by `org-html-validation-link'. + %T will be replaced by the export time. + %C will be replaced by the last modification time. + +If you need to use a \"%\" character, you need to escape it +like that: \"%%\". + +See the default value of `org-html-postamble-format' for an +example." + :group 'org-export-html + :type '(alist :key-type (string :tag "Language") + :value-type (string :tag "Format string"))) + +(defcustom org-html-link-up "" + "Where should the \"UP\" link of exported HTML pages lead?" + :group 'org-export-html + :type '(string :tag "File or URL")) + +(defcustom org-html-link-home "" + "Where should the \"HOME\" link of exported HTML pages lead?" + :group 'org-export-html + :type '(string :tag "File or URL")) + +(defcustom org-html-home/up-format + "
    + UP + | + HOME +
    " + "Snippet used to insert the HOME and UP links. +This is a format string, the first %s will receive the UP link, +the second the HOME link. If both `org-html-link-up' and +`org-html-link-home' are empty, the entire snippet will be +ignored." + :group 'org-export-html + :type 'string) + +;;;; Template :: Scripts + +(define-obsolete-variable-alias + 'org-html-style-include-scripts 'org-html-head-include-scripts "24.4") +(defcustom org-html-head-include-scripts t + "Non-nil means include the JavaScript snippets in exported HTML files. +The actual script is defined in `org-html-scripts' and should +not be modified." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +;;;; Template :: Styles + +(define-obsolete-variable-alias + 'org-html-style-include-default 'org-html-head-include-default-style "24.4") +(defcustom org-html-head-include-default-style t + "Non-nil means include the default style in exported HTML files. +The actual style is defined in `org-html-style-default' and +should not be modified. Use `org-html-head' to use your own +style information." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) +;;;###autoload +(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp) + +(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") +(defcustom org-html-head "" + "Org-wide head definitions for exported HTML files. + +This variable can contain the full HTML structure to provide a +style, including the surrounding HTML tags. You can consider +including definitions for the following classes: title, todo, +done, timestamp, timestamp-kwd, tag, target. + +For example, a valid value would be: + + + +If you want to refer to an external style, use something like + + + +As the value of this option simply gets inserted into the HTML + header, you can use it to add any arbitrary text to the +header. + +You can set this on a per-file basis using #+HTML_HEAD:, +or for publication projects using the :html-head property." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) +;;;###autoload +(put 'org-html-head 'safe-local-variable 'stringp) + +(defcustom org-html-head-extra "" + "More head information to add in the HTML output. + +You can set this on a per-file basis using #+HTML_HEAD_EXTRA:, +or for publication projects using the :html-head-extra property." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) +;;;###autoload +(put 'org-html-head-extra 'safe-local-variable 'stringp) + +;;;; Todos + +(defcustom org-html-todo-kwd-class-prefix "" + "Prefix to class names for TODO keywords. +Each TODO keyword gets a class given by the keyword itself, with this prefix. +The default prefix is empty because it is nice to just use the keyword +as a class name. But if you get into conflicts with other, existing +CSS classes, then this prefix can be very useful." + :group 'org-export-html + :type 'string) + + +;;; Internal Functions + +(defun org-html--make-attribute-string (attributes) + "Return a list of attributes, as a string. +ATTRIBUTES is a plist where values are either strings or nil. An +attributes with a nil value will be omitted from the result." + (let (output) + (dolist (item attributes (mapconcat 'identity (nreverse output) " ")) + (cond ((null item) (pop output)) + ((symbolp item) (push (substring (symbol-name item) 1) output)) + (t (let ((key (car output)) + (value (replace-regexp-in-string + "\"" """ (org-html-encode-plain-text item)))) + (setcar output (format "%s=\"%s\"" key value)))))))) + +(defun org-html-format-inline-image (src &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 + (cond + ((string-match "\\" src attr))) + (format "\n%s%s\n

    " + id (format "\n

    %s

    " img) + (if (and caption (not (string= caption ""))) + (format "\n

    %s

    " caption) "")))) + (t (format "" src (concat attr id)))))) + +(defun org-html--textarea-block (element) + "Transcode ELEMENT into a textarea block. +ELEMENT is either a src block or an example block." + (let* ((code (car (org-export-unravel-code element))) + (attr (org-export-read-attribute :attr_html element))) + (format "

    \n\n

    " + (or (plist-get attr :width) 80) + (or (plist-get attr :height) (org-count-lines code)) + code))) + +;;;; Bibliography + +(defun org-html-bibliography () + "Find bibliography, cut it out and return it." + (catch 'exit + (let (beg end (cnt 1) bib) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward + "^[ \t]*
    " nil t) + (setq cnt (+ cnt (if (string= (match-string 0) "") (forward-char 1)) + (setq bib (buffer-substring beg (point))) + (delete-region beg (point)) + (throw 'exit bib)))) + nil)))) + +;;;; Table + +(defun org-html-htmlize-region-for-paste (beg end) + "Convert the region between BEG and END to HTML, using htmlize.el. +This is much like `htmlize-region-for-paste', only that it uses +the settings define in the org-... variables." + (let* ((htmlize-output-type org-html-htmlize-output-type) + (htmlize-css-name-prefix org-html-htmlize-font-prefix) + (htmlbuf (htmlize-region beg end))) + (unwind-protect + (with-current-buffer htmlbuf + (buffer-substring (plist-get htmlize-buffer-places 'content-start) + (plist-get htmlize-buffer-places 'content-end))) + (kill-buffer htmlbuf)))) + +;;;###autoload +(defun org-html-htmlize-generate-css () + "Create the CSS for all font definitions in the current Emacs session. +Use this to create face definitions in your CSS style file that can then +be used by code snippets transformed by htmlize. +This command just produces a buffer that contains class definitions for all +faces used in the current Emacs session. You can copy and paste the ones you +need into your CSS file. + +If you then set `org-html-htmlize-output-type' to `css', calls +to the function `org-html-htmlize-region-for-paste' will +produce code that uses these same face definitions." + (interactive) + (require 'htmlize) + (and (get-buffer "*html*") (kill-buffer "*html*")) + (with-temp-buffer + (let ((fl (face-list)) + (htmlize-css-name-prefix "org-") + (htmlize-output-type 'css) + f i) + (while (setq f (pop fl) + i (and f (face-attribute f :inherit))) + (when (and (symbolp f) (or (not i) (not (listp i)))) + (insert (org-add-props (copy-sequence "1") nil 'face f)))) + (htmlize-region (point-min) (point-max)))) + (org-pop-to-buffer-same-window "*html*") + (goto-char (point-min)) + (if (re-search-forward "" nil t) + (delete-region (1+ (match-end 0)) (point-max))) + (beginning-of-line 1) + (if (looking-at " +") (replace-match "")) + (goto-char (point-min))) + +(defun org-html--make-string (n string) + "Build a string by concatenating N times STRING." + (let (out) (dotimes (i n out) (setq out (concat string out))))) + +(defun org-html-fix-class-name (kwd) ; audit callers of this function + "Turn todo keyword KWD into a valid class name. +Replaces invalid characters with \"_\"." + (save-match-data + (while (string-match "[^a-zA-Z0-9_]" kwd) + (setq kwd (replace-match "_" t t kwd)))) + kwd) + +(defun org-html-format-footnote-reference (n def refcnt) + "Format footnote reference N with definition DEF into HTML." + (let ((extra (if (= refcnt 1) "" (format ".%d" refcnt)))) + (format org-html-footnote-format + (let* ((id (format "fnr.%s%s" n extra)) + (href (format " href=\"#fn.%s\"" n)) + (attributes (concat " class=\"footref\"" href))) + (org-html--anchor id n attributes))))) + +(defun org-html-format-footnotes-section (section-name definitions) + "Format footnotes section SECTION-NAME." + (if (not definitions) "" + (format org-html-footnotes-section section-name definitions))) + +(defun org-html-format-footnote-definition (fn) + "Format the footnote definition FN." + (let ((n (car fn)) (def (cdr fn))) + (format + "
    %s %s
    \n" + (format org-html-footnote-format + (let* ((id (format "fn.%s" n)) + (href (format " href=\"#fnr.%s\"" n)) + (attributes (concat " class=\"footnum\"" href))) + (org-html--anchor id n attributes))) + def))) + +(defun org-html-footnote-section (info) + "Format the footnote section. +INFO is a plist used as a communication channel." + (let* ((fn-alist (org-export-collect-footnote-definitions + (plist-get info :parse-tree) info)) + (fn-alist + (loop for (n type raw) in fn-alist collect + (cons n (if (eq (org-element-type raw) 'org-data) + (org-trim (org-export-data raw info)) + (format "

    %s

    " + (org-trim (org-export-data raw info)))))))) + (when fn-alist + (org-html-format-footnotes-section + (org-html--translate "Footnotes" info) + (format + "\n%s\n" + (mapconcat 'org-html-format-footnote-definition fn-alist "\n")))))) + + +;;; Template + +(defun org-html--build-meta-info (info) + "Return meta tags for exported document. +INFO is a plist used as a communication channel." + (let ((protect-string + (lambda (str) + (replace-regexp-in-string + "\"" """ (org-html-encode-plain-text str)))) + (title (org-export-data (plist-get info :title) info)) + (author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth + ;; Return raw Org syntax, skipping non + ;; exportable objects. + (org-element-interpret-data + (org-element-map auth + (cons 'plain-text org-element-all-objects) + 'identity info)))))) + (description (plist-get info :description)) + (keywords (plist-get info :keywords))) + (concat + (format "%s\n" title) + (format + (when :time-stamp-file + (format-time-string + (concat "\n")))) + (format + "\n" + (or (and org-html-coding-system + (fboundp 'coding-system-get) + (coding-system-get org-html-coding-system 'mime-charset)) + "iso-8859-1")) + (format "\n") + (and (org-string-nw-p author) + (format "\n" + (funcall protect-string author))) + (and (org-string-nw-p description) + (format "\n" + (funcall protect-string description))) + (and (org-string-nw-p keywords) + (format "\n" + (funcall protect-string keywords)))))) + +(defun org-html--build-head (info) + "Return information for the .. of the HTML output. +INFO is a plist used as a communication channel." + (org-element-normalize-string + (concat + (when (plist-get info :html-head-include-default-style) + (org-element-normalize-string org-html-style-default)) + (org-element-normalize-string (plist-get info :html-head)) + (org-element-normalize-string (plist-get info :html-head-extra)) + (when (and (plist-get info :html-htmlized-css-url) + (eq org-html-htmlize-output-type 'css)) + (format "\n" + (plist-get info :html-htmlized-css-url))) + (when (plist-get info :html-head-include-scripts) org-html-scripts)))) + +(defun org-html--build-mathjax-config (info) + "Insert the user setup into the mathjax template. +INFO is a plist used as a communication channel." + (when (and (memq (plist-get info :with-latex) '(mathjax t)) + (org-element-map (plist-get info :parse-tree) + '(latex-fragment latex-environment) 'identity info t)) + (let ((template org-html-mathjax-template) + (options org-html-mathjax-options) + (in-buffer (or (plist-get info :html-mathjax) "")) + name val (yes " ") (no "// ") x) + (mapc + (lambda (e) + (setq name (car e) val (nth 1 e)) + (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer) + (setq val (car (read-from-string + (substring in-buffer (match-end 0)))))) + (if (not (stringp val)) (setq val (format "%s" val))) + (if (string-match (concat "%" (upcase (symbol-name name))) template) + (setq template (replace-match val t t template)))) + options) + (setq val (nth 1 (assq 'mathml options))) + (if (string-match (concat "\\%s" e e)) + (split-string (plist-get info :email) ",+ *") + ", ")) + (?c . ,(plist-get info :creator)) + (?C . ,(let ((file (plist-get info :input-file))) + (format-time-string org-html-metadata-timestamp-format + (if file (nth 5 (file-attributes file)) + (current-time))))) + (?v . ,(or org-html-validation-link "")))) + +(defun org-html--build-pre/postamble (type info) + "Return document preamble or postamble as a string, or nil. +TYPE is either 'preamble or 'postamble, INFO is a plist used as a +communication channel." + (let ((section (plist-get info (intern (format ":html-%s" type)))) + (spec (org-html-format-spec info))) + (when section + (let ((section-contents + (if (functionp section) (funcall section info) + (cond + ((stringp section) (format-spec section spec)) + ((eq section 'auto) + (let ((date (cdr (assq ?d spec))) + (author (cdr (assq ?a spec))) + (email (cdr (assq ?e spec))) + (creator (cdr (assq ?c spec))) + (timestamp (cdr (assq ?T spec))) + (validation-link (cdr (assq ?v spec)))) + (concat + (when (and (plist-get info :with-date) + (org-string-nw-p date)) + (format "

    %s: %s

    \n" + (org-html--translate "Date" info) + date)) + (when (and (plist-get info :with-author) + (org-string-nw-p author)) + (format "

    %s: %s

    \n" + (org-html--translate "Author" info) + author)) + (when (and (plist-get info :with-email) + (org-string-nw-p email)) + (format "

    %s: %s

    \n" + (org-html--translate "Email" info) + email)) + (when (plist-get info :time-stamp-file) + (format + "

    %s: %s

    \n" + (org-html--translate "Created" info) + (format-time-string org-html-metadata-timestamp-format))) + (when (plist-get info :with-creator) + (format "

    %s

    \n" creator)) + (format "

    %s

    \n" + validation-link)))) + (t (format-spec + (or (cadr (assoc + (plist-get info :language) + (eval (intern + (format "org-html-%s-format" type))))) + (cadr + (assoc + "en" + (eval + (intern (format "org-html-%s-format" type)))))) + spec)))))) + (when (org-string-nw-p section-contents) + (concat + (format "<%s id=\"%s\" class=\"%s\">\n" + (nth 1 (assq type org-html-divs)) + (nth 2 (assq type org-html-divs)) + org-html--pre/postamble-class) + (org-element-normalize-string section-contents) + (format "\n" (nth 1 (assq type org-html-divs))))))))) + +(defun org-html-inner-template (contents info) + "Return body of document string after HTML conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (concat + ;; Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth (org-html-toc depth info))) + ;; Document contents. + contents + ;; Footnotes section. + (org-html-footnote-section info) + ;; Bibliography. + (org-html-bibliography))) + +(defun org-html-template (contents info) + "Return complete document string after HTML conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (concat + (format + (or (and (stringp org-html-xml-declaration) + org-html-xml-declaration) + (cdr (assoc (plist-get info :html-extension) + org-html-xml-declaration)) + (cdr (assoc "html" org-html-xml-declaration)) + + "") + (or (and org-html-coding-system + (fboundp 'coding-system-get) + (coding-system-get org-html-coding-system 'mime-charset)) + "iso-8859-1")) + "\n" + (plist-get info :html-doctype) + "\n" + (format "\n" + (plist-get info :language) (plist-get info :language)) + "\n" + (org-html--build-meta-info info) + (org-html--build-head info) + (org-html--build-mathjax-config info) + "\n" + "\n" + (let ((link-up (org-trim (plist-get info :html-link-up))) + (link-home (org-trim (plist-get info :html-link-home)))) + (unless (and (string= link-up "") (string= link-up "")) + (format org-html-home/up-format + (or link-up link-home) + (or link-home link-up)))) + ;; Preamble. + (org-html--build-pre/postamble 'preamble info) + ;; Document contents. + (format "<%s id=\"%s\">\n" + (nth 1 (assq 'content org-html-divs)) + (nth 2 (assq 'content org-html-divs))) + ;; Document title. + (let ((title (plist-get info :title))) + (format "

    %s

    \n" (org-export-data (or title "") info))) + contents + (format "\n" + (nth 1 (assq 'content org-html-divs))) + ;; Postamble. + (org-html--build-pre/postamble 'postamble info) + ;; Closing document. + "\n")) + +(defun org-html--translate (s info) + "Translate string S according to specified language. +INFO is a plist used as a communication channel." + (org-export-translate s :html info)) + +;;;; Anchor + +(defun org-html--anchor (&optional id desc attributes) + "Format a HTML anchor." + (let* ((name (and org-html-allow-name-attribute-in-anchors id)) + (attributes (concat (and id (format " id=\"%s\"" id)) + (and name (format " name=\"%s\"" name)) + attributes))) + (format "%s" attributes (or desc "")))) + +;;;; Todo + +(defun org-html--todo (todo) + "Format TODO keywords into HTML." + (when todo + (format "%s" + (if (member todo org-done-keywords) "done" "todo") + org-html-todo-kwd-class-prefix (org-html-fix-class-name todo) + todo))) + +;;;; Tags + +(defun org-html--tags (tags) + "Format TAGS into HTML." + (when tags + (format "%s" + (mapconcat + (lambda (tag) + (format "%s" + (concat org-html-tag-class-prefix + (org-html-fix-class-name tag)) + tag)) + tags " ")))) + +;;;; Headline + +(defun* org-html-format-headline + (todo todo-type priority text tags + &key level section-number headline-label &allow-other-keys) + "Format a headline in HTML." + (let ((section-number + (when section-number + (format "%s " + level section-number))) + (todo (org-html--todo todo)) + (tags (org-html--tags tags))) + (concat section-number todo (and todo " ") text + (and tags "   ") tags))) + +;;;; Src Code + +(defun org-html-fontify-code (code lang) + "Color CODE with htmlize library. +CODE is a string representing the source code to colorize. LANG +is the language used for CODE, as a string, or nil." + (when code + (cond + ;; Case 1: No lang. Possibly an example block. + ((not lang) + ;; Simple transcoding. + (org-html-encode-plain-text code)) + ;; Case 2: No htmlize or an inferior version of htmlize + ((not (and (require 'htmlize nil t) (fboundp 'htmlize-region-for-paste))) + ;; Emit a warning. + (message "Cannot fontify src block (htmlize.el >= 1.34 required)") + ;; Simple transcoding. + (org-html-encode-plain-text code)) + (t + ;; Map language + (setq lang (or (assoc-default lang org-src-lang-modes) lang)) + (let* ((lang-mode (and lang (intern (format "%s-mode" lang))))) + (cond + ;; Case 1: Language is not associated with any Emacs mode + ((not (functionp lang-mode)) + ;; Simple transcoding. + (org-html-encode-plain-text code)) + ;; Case 2: Default. Fontify code. + (t + ;; htmlize + (setq code (with-temp-buffer + ;; Switch to language-specific mode. + (funcall lang-mode) + (insert code) + ;; Fontify buffer. + (font-lock-fontify-buffer) + ;; Remove formatting on newline characters. + (save-excursion + (let ((beg (point-min)) + (end (point-max))) + (goto-char beg) + (while (progn (end-of-line) (< (point) end)) + (put-text-property (point) (1+ (point)) 'face nil) + (forward-char 1)))) + (org-src-mode) + (set-buffer-modified-p nil) + ;; Htmlize region. + (org-html-htmlize-region-for-paste + (point-min) (point-max)))) + ;; Strip any enclosing
     tags.
    +	  (let* ((beg (and (string-match "\\`]*>\n*" code) (match-end 0)))
    +		 (end (and beg (string-match "
  • \\'" code)))) + (if (and beg end) (substring code beg end) code))))))))) + +(defun org-html-do-format-code + (code &optional lang refs retain-labels num-start) + "Format CODE string as source code. +Optional arguments LANG, REFS, RETAIN-LABELS and NUM-START are, +respectively, the language of the source code, as a string, an +alist between line numbers and references (as returned by +`org-export-unravel-code'), a boolean specifying if labels should +appear in the source code, and the number associated to the first +line of code." + (let* ((code-lines (org-split-string code "\n")) + (code-length (length code-lines)) + (num-fmt + (and num-start + (format "%%%ds: " + (length (number-to-string (+ code-length num-start)))))) + (code (org-html-fontify-code code lang))) + (org-export-format-code + code + (lambda (loc line-num ref) + (setq loc + (concat + ;; Add line number, if needed. + (when num-start + (format "%s" + (format num-fmt line-num))) + ;; Transcoded src line. + loc + ;; Add label, if needed. + (when (and ref retain-labels) (format " (%s)" ref)))) + ;; Mark transcoded line as an anchor, if needed. + (if (not ref) loc + (format "%s" + ref loc))) + num-start refs))) + +(defun org-html-format-code (element info) + "Format contents of ELEMENT as source code. +ELEMENT is either an example block or a src block. INFO is +a plist used as a communication channel." + (let* ((lang (org-element-property :language element)) + ;; Extract code and references. + (code-info (org-export-unravel-code element)) + (code (car code-info)) + (refs (cdr code-info)) + ;; Does the src block contain labels? + (retain-labels (org-element-property :retain-labels element)) + ;; Does it have line numbers? + (num-start (case (org-element-property :number-lines element) + (continued (org-export-get-loc element info)) + (new 0)))) + (org-html-do-format-code code lang refs retain-labels num-start))) + + +;;; Tables of Contents + +(defun org-html-toc (depth info) + "Build a table of contents. +DEPTH is an integer specifying the depth of the table. INFO is a +plist used as a communication channel. Return the table of +contents as a string, or nil if it is empty." + (let ((toc-entries + (mapcar (lambda (headline) + (cons (org-html--format-toc-headline headline info) + (org-export-get-relative-level headline info))) + (org-export-collect-headlines info depth)))) + (when toc-entries + (concat "
    \n" + (format "%s\n" + org-html-toplevel-hlevel + (org-html--translate "Table of Contents" info) + org-html-toplevel-hlevel) + "
    " + (org-html--toc-text toc-entries) + "
    \n" + "
    \n")))) + +(defun org-html--toc-text (toc-entries) + "Return innards of a table of contents, as a string. +TOC-ENTRIES is an alist where key is an entry title, as a string, +and value is its relative level, as an integer." + (let* ((prev-level (1- (cdar toc-entries))) + (start-level prev-level)) + (concat + (mapconcat + (lambda (entry) + (let ((headline (car entry)) + (level (cdr entry))) + (concat + (let* ((cnt (- level prev-level)) + (times (if (> cnt 0) (1- cnt) (- cnt))) + rtn) + (setq prev-level level) + (concat + (org-html--make-string + times (cond ((> cnt 0) "\n
      \n
    • ") + ((< cnt 0) "
    • \n
    \n"))) + (if (> cnt 0) "\n
      \n
    • " "
    • \n
    • "))) + headline))) + toc-entries "") + (org-html--make-string (- prev-level start-level) "
    • \n
    \n")))) + +(defun org-html--format-toc-headline (headline info) + "Return an appropriate table of contents entry for HEADLINE. +INFO is a plist used as a communication channel." + (let* ((headline-number (org-export-get-headline-number headline info)) + (section-number + (and (not (org-export-low-level-p headline info)) + (org-export-numbered-headline-p headline info) + (concat (mapconcat 'number-to-string headline-number ".") ". "))) + (tags (and (eq (plist-get info :with-tags) t) + (org-export-get-tags headline info)))) + (format "%s" + ;; Label. + (org-export-solidify-link-text + (or (org-element-property :CUSTOM_ID headline) + (concat "sec-" (mapconcat 'number-to-string + headline-number "-")))) + ;; Body. + (concat section-number + (org-export-data-with-translations + (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)) + info) + (and tags "   ") (org-html--tags tags))))) + +(defun org-html-list-of-listings (info) + "Build a list of listings. +INFO is a plist used as a communication channel. Return the list +of listings as a string, or nil if it is empty." + (let ((lol-entries (org-export-collect-listings info))) + (when lol-entries + (concat "
    \n" + (format "%s\n" + org-html-toplevel-hlevel + (org-html--translate "List of Listings" info) + org-html-toplevel-hlevel) + "
    \n
      \n" + (let ((count 0) + (initial-fmt (org-html--translate "Listing %d:" info))) + (mapconcat + (lambda (entry) + (let ((label (org-element-property :name entry)) + (title (org-trim + (org-export-data + (or (org-export-get-caption entry t) + (org-export-get-caption entry)) + info)))) + (concat + "
    • " + (if (not label) + (concat (format initial-fmt (incf count)) " " title) + (format "%s %s" + (org-export-solidify-link-text label) + (format initial-fmt (incf count)) + title)) + "
    • "))) + lol-entries "\n")) + "\n
    \n
    \n
    ")))) + +(defun org-html-list-of-tables (info) + "Build a list of tables. +INFO is a plist used as a communication channel. Return the list +of tables as a string, or nil if it is empty." + (let ((lol-entries (org-export-collect-tables info))) + (when lol-entries + (concat "
    \n" + (format "%s\n" + org-html-toplevel-hlevel + (org-html--translate "List of Tables" info) + org-html-toplevel-hlevel) + "
    \n
      \n" + (let ((count 0) + (initial-fmt (org-html--translate "Table %d:" info))) + (mapconcat + (lambda (entry) + (let ((label (org-element-property :name entry)) + (title (org-trim + (org-export-data + (or (org-export-get-caption entry t) + (org-export-get-caption entry)) + info)))) + (concat + "
    • " + (if (not label) + (concat (format initial-fmt (incf count)) " " title) + (format "%s %s" + (org-export-solidify-link-text label) + (format initial-fmt (incf count)) + title)) + "
    • "))) + lol-entries "\n")) + "\n
    \n
    \n
    ")))) + + +;;; Transcode Functions + +;;;; Bold + +(defun org-html-bold (bold contents info) + "Transcode BOLD from Org to HTML. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (format (or (cdr (assq 'bold org-html-text-markup-alist)) "%s") + contents)) + +;;;; Center Block + +(defun org-html-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (format "
    \n%s
    " contents)) + +;;;; Clock + +(defun org-html-clock (clock contents info) + "Transcode a CLOCK element from Org to HTML. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "

    + +%s %s%s + +

    " + org-clock-string + (org-translate-time + (org-element-property :raw-value + (org-element-property :value clock))) + (let ((time (org-element-property :duration clock))) + (and time (format " (%s)" time))))) + +;;;; Code + +(defun org-html-code (code contents info) + "Transcode CODE from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format (or (cdr (assq 'code org-html-text-markup-alist)) "%s") + (org-html-plain-text (org-element-property :value code) info))) + +;;;; Drawer + +(defun org-html-drawer (drawer contents info) + "Transcode a DRAWER element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (if (functionp org-html-format-drawer-function) + (funcall org-html-format-drawer-function + (org-element-property :drawer-name drawer) + contents) + ;; If there's no user defined function: simply + ;; display contents of the drawer. + contents)) + +;;;; Dynamic Block + +(defun org-html-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + contents) + +;;;; Entity + +(defun org-html-entity (entity contents info) + "Transcode an ENTITY object from Org to HTML. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (org-element-property :html entity)) + +;;;; Example Block + +(defun org-html-example-block (example-block contents info) + "Transcode a EXAMPLE-BLOCK element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (if (org-export-read-attribute :attr_html example-block :textarea) + (org-html--textarea-block example-block) + (format "
    \n%s
    " + (org-html-format-code example-block info)))) + +;;;; Export Snippet + +(defun org-html-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (when (eq (org-export-snippet-backend export-snippet) 'html) + (org-element-property :value export-snippet))) + +;;;; Export Block + +(defun org-html-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "HTML") + (org-remove-indentation (org-element-property :value export-block)))) + +;;;; Fixed Width + +(defun org-html-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (format "
    \n%s
    " + (org-html-do-format-code + (org-remove-indentation + (org-element-property :value fixed-width))))) + +;;;; Footnote Reference + +(defun org-html-footnote-reference (footnote-reference contents info) + "Transcode a FOOTNOTE-REFERENCE element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (concat + ;; Insert separator between two footnotes in a row. + (let ((prev (org-export-get-previous-element footnote-reference info))) + (when (eq (org-element-type prev) 'footnote-reference) + org-html-footnote-separator)) + (cond + ((not (org-export-footnote-first-reference-p footnote-reference info)) + (org-html-format-footnote-reference + (org-export-get-footnote-number footnote-reference info) + "IGNORED" 100)) + ;; Inline definitions are secondary strings. + ((eq (org-element-property :type footnote-reference) 'inline) + (org-html-format-footnote-reference + (org-export-get-footnote-number footnote-reference info) + "IGNORED" 1)) + ;; Non-inline footnotes definitions are full Org data. + (t (org-html-format-footnote-reference + (org-export-get-footnote-number footnote-reference info) + "IGNORED" 1))))) + +;;;; Headline + +(defun org-html-format-headline--wrap + (headline info &optional format-function &rest extra-keys) + "Transcode a HEADLINE element from Org to HTML. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (let* ((level (+ (org-export-get-relative-level headline info) + (1- org-html-toplevel-hlevel))) + (headline-number (org-export-get-headline-number headline info)) + (section-number (and (not (org-export-low-level-p headline info)) + (org-export-numbered-headline-p headline info) + (mapconcat 'number-to-string + headline-number "."))) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (text (org-export-data (org-element-property :title headline) info)) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (headline-label (or (org-element-property :CUSTOM_ID headline) + (concat "sec-" (mapconcat 'number-to-string + headline-number "-")))) + (format-function (cond + ((functionp format-function) format-function) + ((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)))) + (apply format-function + todo todo-type priority text tags + :headline-label headline-label :level level + :section-number section-number extra-keys))) + +(defun org-html-headline (headline contents info) + "Transcode a HEADLINE element from Org to HTML. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + ;; Empty contents? + (setq contents (or contents "")) + (let* ((numberedp (org-export-numbered-headline-p headline info)) + (level (org-export-get-relative-level headline info)) + (text (org-export-data (org-element-property :title headline) info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (section-number (and (org-export-numbered-headline-p headline info) + (mapconcat 'number-to-string + (org-export-get-headline-number + headline info) "."))) + ;; Create the headline text. + (full-text (org-html-format-headline--wrap headline info))) + (cond + ;; Case 1: This is a footnote section: ignore it. + ((org-element-property :footnote-section-p headline) nil) + ;; Case 2. This is a deep sub-tree: export it as a list item. + ;; Also export as items headlines for which no section + ;; format has been found. + ((org-export-low-level-p headline info) + ;; Build the real contents of the sub-tree. + (let* ((type (if numberedp 'ordered 'unordered)) + (itemized-body (org-html-format-list-item + contents type nil nil full-text))) + (concat + (and (org-export-first-sibling-p headline info) + (org-html-begin-plain-list type)) + itemized-body + (and (org-export-last-sibling-p headline info) + (org-html-end-plain-list type))))) + ;; Case 3. Standard headline. Export it as a section. + (t + (let* ((section-number (mapconcat 'number-to-string + (org-export-get-headline-number + headline info) "-")) + (ids (remove 'nil + (list (org-element-property :CUSTOM_ID headline) + (concat "sec-" section-number) + (org-element-property :ID headline)))) + (preferred-id (car ids)) + (extra-ids (cdr ids)) + (extra-class (org-element-property :HTML_CONTAINER_CLASS headline)) + (level1 (+ level (1- org-html-toplevel-hlevel))) + (first-content (car (org-element-contents headline)))) + (format "<%s id=\"%s\" class=\"%s\">%s%s\n" + (org-html--container headline info) + (format "outline-container-%s" + (or (org-element-property :CUSTOM_ID headline) + (concat "sec-" section-number))) + (concat (format "outline-%d" level1) (and extra-class " ") + extra-class) + (format "\n%s%s\n" + level1 + preferred-id + (mapconcat + (lambda (x) + (let ((id (org-export-solidify-link-text + (if (org-uuidgen-p x) (concat "ID-" x) + x)))) + (org-html--anchor id))) + extra-ids "") + full-text + level1) + ;; When there is no section, pretend there is an empty + ;; one to get the correct
    ") + +;;;; Inline Src Block + +(defun org-html-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to HTML. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((org-lang (org-element-property :language inline-src-block)) + (code (org-element-property :value inline-src-block))) + (error "Cannot export inline src block"))) + +;;;; Inlinetask + +(defun org-html-format-section (text class &optional id) + "Format a section with TEXT into a HTML div with CLASS and ID." + (let ((extra (concat (when id (format " id=\"%s\"" id))))) + (concat (format "
    \n" class extra) text "
    \n"))) + +(defun org-html-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (cond + ;; If `org-html-format-inlinetask-function' is provided, call it + ;; with appropriate arguments. + ((functionp org-html-format-inlinetask-function) + (let ((format-function + (function* + (lambda (todo todo-type priority text tags + &key contents &allow-other-keys) + (funcall org-html-format-inlinetask-function + todo todo-type priority text tags contents))))) + (org-html-format-headline--wrap + inlinetask info format-function :contents contents))) + ;; Otherwise, use a default template. + (t (format "
    \n%s
    \n%s
    " + (org-html-format-headline--wrap inlinetask info) + contents)))) + +;;;; Italic + +(defun org-html-italic (italic contents info) + "Transcode ITALIC from Org to HTML. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (format (or (cdr (assq 'italic org-html-text-markup-alist)) "%s") contents)) + +;;;; Item + +(defun org-html-checkbox (checkbox) + "Format CHECKBOX into HTML." + (case checkbox (on "[X]") + (off "[ ]") + (trans "[-]") + (t ""))) + +(defun org-html-format-list-item (contents type checkbox + &optional term-counter-id + headline) + "Format a list item into HTML." + (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " ")))) + (concat + (case type + (ordered + (let* ((counter term-counter-id) + (extra (if counter (format " value=\"%s\"" counter) ""))) + (concat + (format "" extra) + (when headline (concat headline "
    "))))) + (unordered + (let* ((id term-counter-id) + (extra (if id (format " id=\"%s\"" id) ""))) + (concat + (format "" extra) + (when headline (concat headline "
    "))))) + (descriptive + (let* ((term term-counter-id)) + (setq term (or term "(no term)")) + ;; Check-boxes in descriptive lists are associated to tag. + (concat (format "
    %s
    " + (concat checkbox term)) + "
    ")))) + (unless (eq type 'descriptive) checkbox) + contents + (case type + (ordered "") + (unordered "") + (descriptive "
    "))))) + +(defun org-html-item (item contents info) + "Transcode an ITEM element from Org to HTML. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((plain-list (org-export-get-parent item)) + (type (org-element-property :type plain-list)) + (counter (org-element-property :counter item)) + (checkbox (org-element-property :checkbox item)) + (tag (let ((tag (org-element-property :tag item))) + (and tag (org-export-data tag info))))) + (org-html-format-list-item + contents type checkbox (or tag counter)))) + +;;;; Keyword + +(defun org-html-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "HTML") value) + ((string= key "TOC") + (let ((value (downcase value))) + (cond + ((string-match "\\" value) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc)))) + (org-html-toc depth info))) + ((string= "listings" value) (org-html-list-of-listings info)) + ((string= "tables" value) (org-html-list-of-tables info)))))))) + +;;;; Latex Environment + +(defun org-html-format-latex (latex-frag processing-type) + "Format the LaTeX fragment LATEX-FRAG into HTML." + (let ((cache-relpath "") (cache-dir "") bfn) + (unless (eq processing-type 'mathjax) + (setq bfn (buffer-file-name) + cache-relpath + (concat "ltxpng/" + (file-name-sans-extension + (file-name-nondirectory bfn))) + cache-dir (file-name-directory bfn))) + (with-temp-buffer + (insert latex-frag) + (org-format-latex cache-relpath cache-dir nil "Creating LaTeX Image..." + nil nil processing-type) + (buffer-string)))) + +(defun org-html-latex-environment (latex-environment contents info) + "Transcode a LATEX-ENVIRONMENT element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((processing-type (plist-get info :with-latex)) + (latex-frag (org-remove-indentation + (org-element-property :value latex-environment))) + (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) caption label attr t)))) + (t latex-frag)))) + +;;;; Latex Fragment + +(defun org-html-latex-fragment (latex-fragment contents info) + "Transcode a LATEX-FRAGMENT object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((latex-frag (org-element-property :value latex-fragment)) + (processing-type (plist-get info :with-latex))) + (case processing-type + ((t mathjax) + (org-html-format-latex latex-frag 'mathjax)) + (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))))) + (t latex-frag)))) + +;;;; Line Break + +(defun org-html-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + "
    \n") + +;;;; 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 caption label + (org-html--make-attribute-string + (org-export-read-attribute :attr_html parent)) + (org-html-standalone-image-p link info)))) + +(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. +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 +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 nil, otherwise. + +Bind `org-html-standalone-image-predicate' to constrain +paragraph further. For example, to check for only captioned +standalone images, do the following. + + \(setq org-html-standalone-image-predicate + \(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)))))))) + +(defun org-html-link (link desc info) + "Transcode a LINK object from Org to HTML. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((link-org-files-as-html-maybe + (function + (lambda (raw-path info) + "Treat links to `file.org' as links to `file.html', if needed. + See `org-html-link-org-files-as-html'." + (cond + ((and org-html-link-org-files-as-html + (string= ".org" + (downcase (file-name-extension raw-path ".")))) + (concat (file-name-sans-extension raw-path) "." + (plist-get info :html-extension))) + (t raw-path))))) + (type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (and (not (string= desc "")) desc)) + (path + (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((string= type "file") + ;; Treat links to ".org" files as ".html", if needed. + (setq raw-path + (funcall link-org-files-as-html-maybe raw-path info)) + ;; If file path is absolute, prepend it with protocol + ;; component - "file://". + (when (file-name-absolute-p raw-path) + (setq raw-path + (concat "file://" (expand-file-name 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. + (let ((option (org-element-property :search-option link))) + (cond ((not option) raw-path) + ((eq (aref option 0) ?#) (concat raw-path option)) + ;; External fuzzy link: try to resolve it if path + ;; belongs to current project, if any. + ((eq (aref option 0) ?*) + (concat + raw-path + (let ((numbers + (org-publish-resolve-external-fuzzy-link + (org-element-property :path link) option))) + (and numbers (concat "#sec-" + (mapconcat 'number-to-string + numbers "-")))))) + (t raw-path)))) + (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. + (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))))))) + protocol) + (cond + ;; Image file. + ((and (or (eq t org-html-inline-images) + (and org-html-inline-images (not desc))) + (org-export-inline-image-p link org-html-inline-image-rules)) + (org-html-link--inline-image link desc info)) + ;; Radio target: Transcode target's contents and use them as + ;; link's description. + ((string= type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (when destination + (format "%s" + (org-export-solidify-link-text path) + attributes + (org-export-data (org-element-contents destination) info))))) + ;; 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)))) + (case (org-element-type destination) + ;; ID link points to an external file. + (plain-text + (let ((fragment (concat "ID-" path)) + ;; Treat links to ".org" files as ".html", if needed. + (path (funcall link-org-files-as-html-maybe + destination info))) + (format "%s" + path fragment attributes (or desc destination)))) + ;; Fuzzy link points nowhere. + ((nil) + (format "%s" + (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 + ;; What href to use? + (cond + ;; Case 1: Headline is linked via it's CUSTOM_ID + ;; property. Use CUSTOM_ID. + ((string= type "custom-id") + (org-element-property :CUSTOM_ID destination)) + ;; Case 2: Headline is linked via it's ID property + ;; or through other means. Use the default href. + ((member type '("id" "fuzzy")) + (format "sec-%s" + (mapconcat 'number-to-string + (org-export-get-headline-number + destination info) "-"))) + (t (error "Shouldn't reach here")))) + ;; What description to use? + (desc + ;; Case 1: Headline is numbered and LINK has no + ;; description or LINK's description matches + ;; headline's title. Display section number. + (if (and (org-export-numbered-headline-p destination info) + (or (not desc) + (string= desc (org-element-property + :raw-value destination)))) + (mapconcat 'number-to-string + (org-export-get-headline-number + destination info) ".") + ;; Case 2: Either the headline is un-numbered or + ;; LINK has a custom description. Display LINK's + ;; description or headline's title. + (or desc (org-export-data (org-element-property + :title destination) info))))) + (format "%s" + (org-export-solidify-link-text href) attributes desc))) + ;; Fuzzy link points to a target. Do as above. + (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"))))))) + ;; Coderef: replace link with the reference name or the + ;; equivalent line number. + ((string= type "coderef") + (let ((fragment (concat "coderef-" path))) + (format "%s" + fragment + (org-trim + (format (concat "class=\"coderef\"" + " onmouseover=\"CodeHighlightOn(this, '%s');\"" + " onmouseout=\"CodeHighlightOff(this, '%s');\"") + fragment fragment)) + attributes + (format (org-export-get-coderef-format path desc) + (org-export-resolve-coderef path info))))) + ;; Link type is handled by a special function. + ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) + (funcall protocol (org-link-unescape path) desc 'html)) + ;; External link with a description part. + ((and path desc) (format "%s" path attributes desc)) + ;; External link without a description part. + (path (format "%s" path attributes path)) + ;; No path, only description. Try to do something useful. + (t (format "%s" desc))))) + +;;;; Paragraph + +(defun org-html-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to HTML. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + (let* ((parent (org-export-get-parent paragraph)) + (parent-type (org-element-type parent)) + (style '((footnote-definition " class=\"footpara\""))) + (extra (or (cadr (assoc parent-type style)) ""))) + (cond + ((and (eq (org-element-type parent) 'item) + (= (org-element-property :begin paragraph) + (org-element-property :contents-begin parent))) + ;; leading paragraph in a list item have no tags + contents) + ((org-html-standalone-image-p paragraph info) + ;; standalone image + contents) + (t (format "\n%s

    " extra contents))))) + +;;;; Plain List + +;; FIXME Maybe arg1 is not needed because
  • already sets +;; the correct value for the item counter +(defun org-html-begin-plain-list (type &optional arg1) + "Insert the beginning of the HTML list depending on TYPE. +When ARG1 is a string, use it as the start parameter for ordered +lists." + (case type + (ordered + (format "
      " + (if arg1 (format " start=\"%d\"" arg1) ""))) + (unordered "
        ") + (descriptive "
        "))) + +(defun org-html-end-plain-list (type) + "Insert the end of the HTML list depending on TYPE." + (case type + (ordered "
    ") + (unordered "") + (descriptive ""))) + +(defun org-html-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to HTML. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (let* (arg1 ;; (assoc :counter (org-element-map plain-list 'item + (type (org-element-property :type plain-list))) + (format "%s\n%s%s" + (org-html-begin-plain-list type) + contents (org-html-end-plain-list type)))) + +;;;; Plain Text + +(defun org-html-convert-special-strings (string) + "Convert special characters in STRING to HTML." + (let ((all org-html-special-string-regexps) + e a re rpl start) + (while (setq a (pop all)) + (setq re (car a) rpl (cdr a) start 0) + (while (string-match re string start) + (setq string (replace-match rpl t nil string)))) + string)) + +(defun org-html-encode-plain-text (text) + "Convert plain text characters from TEXT to HTML equivalent. +Possible conversions are set in `org-html-protect-char-alist'." + (mapc + (lambda (pair) + (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))) + org-html-protect-char-alist) + text) + +(defun org-html-plain-text (text info) + "Transcode a TEXT string from Org to HTML. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (let ((output text)) + ;; Protect following characters: <, >, &. + (setq output (org-html-encode-plain-text output)) + ;; Handle smart quotes. Be sure to provide original string since + ;; OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :html info text))) + ;; Handle special strings. + (when (plist-get info :with-special-strings) + (setq output (org-html-convert-special-strings output))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output + (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" "
    \n" output))) + ;; Return value. + output)) + + +;; Planning + +(defun org-html-planning (planning contents info) + "Transcode a PLANNING element from Org to HTML. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((span-fmt "%s %s")) + (format + "

    %s

    " + (mapconcat + 'identity + (delq nil + (list + (let ((closed (org-element-property :closed planning))) + (when closed + (format span-fmt org-closed-string + (org-translate-time + (org-element-property :raw-value closed))))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (format span-fmt org-deadline-string + (org-translate-time + (org-element-property :raw-value deadline))))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (format span-fmt org-scheduled-string + (org-translate-time + (org-element-property :raw-value scheduled))))))) + " ")))) + +;;;; Property Drawer + +(defun org-html-property-drawer (property-drawer contents info) + "Transcode a PROPERTY-DRAWER element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + ;; The property drawer isn't exported but we want separating blank + ;; lines nonetheless. + "") + +;;;; Quote Block + +(defun org-html-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (format "
    \n%s
    " contents)) + +;;;; Quote Section + +(defun org-html-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (format "
    \n%s
    " value)))) + +;;;; Section + +(defun org-html-section (section contents info) + "Transcode a SECTION element from Org to HTML. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + (let ((parent (org-export-get-parent-headline section))) + ;; Before first headline: no container, just return CONTENTS. + (if (not parent) contents + ;; Get div's class and id references. + (let* ((class-num (+ (org-export-get-relative-level parent info) + (1- org-html-toplevel-hlevel))) + (section-number + (mapconcat + 'number-to-string + (org-export-get-headline-number parent info) "-"))) + ;; Build return value. + (format "
    \n%s
    " + class-num + (or (org-element-property :CUSTOM_ID parent) section-number) + contents))))) + +;;;; Radio Target + +(defun org-html-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to HTML. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (let ((id (org-export-solidify-link-text + (org-element-property :value radio-target)))) + (org-html--anchor id text))) + +;;;; Special Block + +(defun org-html-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (format "
    \n%s\n
    " + (downcase (org-element-property :type special-block)) + contents)) + +;;;; Src Block + +(defun org-html-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to HTML. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (if (org-export-read-attribute :attr_html src-block :textarea) + (org-html--textarea-block src-block) + (let ((lang (org-element-property :language src-block)) + (caption (org-export-get-caption src-block)) + (code (org-html-format-code src-block info)) + (label (let ((lbl (org-element-property :name src-block))) + (if (not lbl) "" + (format " id=\"%s\"" + (org-export-solidify-link-text lbl)))))) + (if (not lang) (format "
    \n%s
    " label code) + (format + "
    \n%s%s\n
    " + (if (not caption) "" + (format "" + (org-export-data caption info))) + (format "\n
    %s
    " lang label code)))))) + +;;;; Statistics Cookie + +(defun org-html-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((cookie-value (org-element-property :value statistics-cookie))) + (format "%s" cookie-value))) + +;;;; Strike-Through + +(defun org-html-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to HTML. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (format (or (cdr (assq 'strike-through org-html-text-markup-alist)) "%s") + contents)) + +;;;; Subscript + +(defun org-html-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to HTML. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "%s" contents)) + +;;;; Superscript + +(defun org-html-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to HTML. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "%s" contents)) + +;;;; Tabel Cell + +(defun org-html-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to HTML. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let* ((table-row (org-export-get-parent table-cell)) + (table (org-export-get-parent-table table-cell)) + (cell-attrs + (if (not org-html-table-align-individual-fields) "" + (format (if (and (boundp 'org-html-format-table-no-css) + org-html-format-table-no-css) + " align=\"%s\"" " class=\"%s\"") + (org-export-table-cell-alignment table-cell info))))) + (when (or (not contents) (string= "" (org-trim contents))) + (setq contents " ")) + (cond + ((and (org-export-table-has-header-p table info) + (= 1 (org-export-table-row-group table-row info))) + (concat "\n" (format (car org-html-table-header-tags) "col" cell-attrs) + contents (cdr org-html-table-header-tags))) + ((and org-html-table-use-header-tags-for-first-column + (zerop (cdr (org-export-table-cell-address table-cell info)))) + (concat "\n" (format (car org-html-table-header-tags) "row" cell-attrs) + contents (cdr org-html-table-header-tags))) + (t (concat "\n" (format (car org-html-table-data-tags) cell-attrs) + contents (cdr org-html-table-data-tags)))))) + +;;;; Table Row + +(defun org-html-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to HTML. +CONTENTS is the contents of the row. INFO is a plist used as a +communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let* ((rowgroup-number (org-export-table-row-group table-row info)) + (row-number (org-export-table-row-number table-row info)) + (start-rowgroup-p + (org-export-table-row-starts-rowgroup-p table-row info)) + (end-rowgroup-p + (org-export-table-row-ends-rowgroup-p table-row info)) + ;; `top-row-p' and `end-rowgroup-p' are not used directly + ;; but should be set so that `org-html-table-row-tags' can + ;; use them (see the docstring of this variable.) + (top-row-p (and (equal start-rowgroup-p '(top)) + (equal end-rowgroup-p '(below top)))) + (bottom-row-p (and (equal start-rowgroup-p '(above)) + (equal end-rowgroup-p '(bottom above)))) + (rowgroup-tags + (cond + ;; Case 1: Row belongs to second or subsequent rowgroups. + ((not (= 1 rowgroup-number)) + '("" . "\n")) + ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups. + ((org-export-table-has-header-p + (org-export-get-parent-table table-row) info) + '("" . "\n")) + ;; Case 2: Row is from first and only row group. + (t '("" . "\n"))))) + (concat + ;; Begin a rowgroup? + (when start-rowgroup-p (car rowgroup-tags)) + ;; Actual table row + (concat "\n" (eval (car org-html-table-row-tags)) + contents + "\n" + (eval (cdr org-html-table-row-tags))) + ;; End a rowgroup? + (when end-rowgroup-p (cdr rowgroup-tags)))))) + +;;;; Table + +(defun org-html-table-first-row-data-cells (table info) + "Transcode the first row of TABLE. +INFO is a plist used as a communication channel." + (let ((table-row + (org-element-map table 'table-row + (lambda (row) + (unless (eq (org-element-property :type row) 'rule) row)) + info 'first-match)) + (special-column-p (org-export-table-has-special-column-p table))) + (if (not special-column-p) (org-element-contents table-row) + (cdr (org-element-contents table-row))))) + +(defun org-html-table--table.el-table (table info) + "Format table.el tables into HTML. +INFO is a plist used as a communication channel." + (when (eq (org-element-property :type table) 'table.el) + (require 'table) + (let ((outbuf (with-current-buffer + (get-buffer-create "*org-export-table*") + (erase-buffer) (current-buffer)))) + (with-temp-buffer + (insert (org-element-property :value table)) + (goto-char 1) + (re-search-forward "^[ \t]*|[^|]" nil t) + (table-generate-source 'html outbuf)) + (with-current-buffer outbuf + (prog1 (org-trim (buffer-string)) + (kill-buffer) ))))) + +(defun org-html-table (table contents info) + "Transcode a TABLE element from Org to HTML. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (case (org-element-property :type table) + ;; Case 1: table.el table. Convert it using appropriate tools. + (table.el (org-html-table--table.el-table table info)) + ;; Case 2: Standard table. + (t + (let* ((label (org-element-property :name table)) + (caption (org-export-get-caption table)) + (attributes + (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)))) + (alignspec + (if (and (boundp 'org-html-format-table-no-css) + org-html-format-table-no-css) + "align=\"%s\"" "class=\"%s\"")) + (table-column-specs + (function + (lambda (table info) + (mapconcat + (lambda (table-cell) + (let ((alignment (org-export-table-cell-alignment + table-cell info))) + (concat + ;; Begin a colgroup? + (when (org-export-table-cell-starts-colgroup-p + table-cell info) + "\n") + ;; Add a column. Also specify it's alignment. + (format "\n" (format alignspec alignment)) + ;; End a colgroup? + (when (org-export-table-cell-ends-colgroup-p + table-cell info) + "\n")))) + (org-html-table-first-row-data-cells table info) "\n"))))) + (format "\n%s\n%s\n%s" + (if (equal attributes "") "" (concat " " attributes)) + (if (not caption) "" + (format "%s" + (org-export-data caption info))) + (funcall table-column-specs table info) + contents))))) + +;;;; Target + +(defun org-html-target (target contents info) + "Transcode a TARGET object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((id (org-export-solidify-link-text + (org-element-property :value target)))) + (org-html--anchor id))) + +;;;; Timestamp + +(defun org-html-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-html-plain-text + (org-timestamp-translate timestamp) info))) + (format "%s" + (replace-regexp-in-string "--" "–" value)))) + +;;;; Underline + +(defun org-html-underline (underline contents info) + "Transcode UNDERLINE from Org to HTML. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (format (or (cdr (assq 'underline org-html-text-markup-alist)) "%s") + contents)) + +;;;; Verbatim + +(defun org-html-verbatim (verbatim contents info) + "Transcode VERBATIM from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format (or (cdr (assq 'verbatim org-html-text-markup-alist)) "%s") + (org-html-plain-text (org-element-property :value verbatim) info))) + +;;;; Verse Block + +(defun org-html-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to HTML. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + ;; Replace each newline character with line break. Also replace + ;; each blank line with a line break. + (setq contents (replace-regexp-in-string + "^ *\\\\\\\\$" "
    \n" + (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" "
    \n" contents))) + ;; Replace each white space at beginning of a line with a + ;; non-breaking space. + (while (string-match "^[ \t]+" contents) + (let* ((num-ws (length (match-string 0 contents))) + (ws (let (out) (dotimes (i num-ws out) + (setq out (concat out " ")))))) + (setq contents (replace-match ws nil t contents)))) + (format "

    \n%s

    " contents)) + + +;;; Filter Functions + +(defun org-html-final-function (contents backend info) + "Filter to indent the HTML and convert HTML entities." + (with-temp-buffer + (insert contents) + (set-auto-mode t) + (if org-html-indent + (indent-region (point-min) (point-max))) + (when org-html-use-unicode-chars + (require 'mm-url) + (mm-url-decode-entities)) + (buffer-substring-no-properties (point-min) (point-max)))) + + +;;; End-user functions + +;;;###autoload +(defun org-html-export-as-html + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to an HTML buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\" and \"\" tags. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org HTML Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (if async + (org-export-async-start + (lambda (output) + (with-current-buffer (get-buffer-create "*Org HTML Export*") + (erase-buffer) + (insert output) + (goto-char (point-min)) + (set-auto-mode t) + (org-export-add-to-stack (current-buffer) 'html))) + `(org-export-as 'html ,subtreep ,visible-only ,body-only ',ext-plist)) + (let ((outbuf (org-export-to-buffer + 'html "*Org HTML Export*" + subtreep visible-only body-only ext-plist))) + ;; Set major mode. + (with-current-buffer outbuf (set-auto-mode t)) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window outbuf))))) + +;;;###autoload +(defun org-html-convert-region-to-html () + "Assume the current region has org-mode syntax, and convert it to HTML. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in an HTML buffer and use this +command to convert it." + (interactive) + (org-export-replace-region-by 'html)) + +;;;###autoload +(defun org-html-export-to-html + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a HTML file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\" and \"\" tags. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let* ((extension (concat "." org-html-extension)) + (file (org-export-output-file-name extension subtreep)) + (org-export-coding-system org-html-coding-system)) + (if async + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'html)) + (let ((org-export-coding-system org-html-coding-system)) + `(expand-file-name + (org-export-to-file + 'html ,file ,subtreep ,visible-only ,body-only ',ext-plist)))) + (let ((org-export-coding-system org-html-coding-system)) + (org-export-to-file + 'html file subtreep visible-only body-only ext-plist))))) + +;;;###autoload +(defun org-html-publish-to-html (plist filename pub-dir) + "Publish an org file to HTML. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'html filename + (concat "." (or (plist-get plist :html-extension) + org-html-extension "html")) + plist pub-dir)) + + +;;; FIXME + +;;;; org-format-table-html +;;;; org-format-org-table-html +;;;; org-format-table-table-html +;;;; org-table-number-fraction +;;;; org-table-number-regexp +;;;; org-html-table-caption-above +;;;; org-html-inline-image-extensions +;;;; org-export-preferred-target-alist +;;;; class for anchors +;;;; org-export-mark-todo-in-toc +;;;; org-html-format-org-link +;;;; (caption (and caption (org-xml-encode-org-text caption))) +;;;; alt = (file-name-nondirectory path) + +(provide 'ox-html) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-html.el ends here diff --git a/lisp/ox-icalendar.el b/lisp/ox-icalendar.el new file mode 100644 index 000000000..49299b014 --- /dev/null +++ b/lisp/ox-icalendar.el @@ -0,0 +1,1001 @@ +;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine + +;; Copyright (C) 2004-2012 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; This library implements an iCalendar back-end for Org generic +;; exporter. +;; +;; It provides three commands for export, depending on the chosen +;; source and desired output: `org-icalendar-export-to-ics' (current +;; file), `org-icalendar-export-agenda-files' (agenda files into +;; separate calendars) and `org-icalendar-combined-agenda-file' +;; (agenda files into one combined calendar). +;; +;; It also provides `org-icalendar-export-current-agenda' function, +;; which will create a calendar file from current agenda view. It is +;; meant to be called through `org-agenda-write'. +;; +;; This back-end introduces a new keyword, ICALENDAR_EXCLUDE_TAGS, +;; which allows to specify a different set of exclude tags from other +;; back-ends. +;; +;; It should follow RFC 5545 specifications. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox-ascii) +(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) + + + +;;; User-Configurable Variables + +(defgroup org-export-icalendar nil + "Options specific for iCalendar export back-end." + :tag "Org Export iCalendar" + :group 'org-export) + +(defcustom org-icalendar-combined-agenda-file "~/org.ics" + "The file name for the iCalendar file covering all agenda files. +This file is created with the command \\[org-icalendar-combine-agenda-files]. +The file name should be absolute. It will be overwritten without warning." + :group 'org-export-icalendar + :type 'file) + +(defcustom org-icalendar-alarm-time 0 + "Number of minutes for triggering an alarm for exported timed events. + +A zero value (the default) turns off the definition of an alarm trigger +for timed events. If non-zero, alarms are created. + +- a single alarm per entry is defined +- The alarm will go off N minutes before the event +- only a DISPLAY action is defined." + :group 'org-export-icalendar + :version "24.1" + :type 'integer) + +(defcustom org-icalendar-combined-name "OrgMode" + "Calendar name for the combined iCalendar representing all agenda files." + :group 'org-export-icalendar + :type 'string) + +(defcustom org-icalendar-combined-description "" + "Calendar description for the combined iCalendar (all agenda files)." + :group 'org-export-icalendar + :type 'string) + +(defcustom org-icalendar-exclude-tags nil + "Tags that exclude a tree from export. +This variable allows to specify different exclude tags from other +back-ends. It can also be set with the ICAL_EXCLUDE_TAGS +keyword." + :group 'org-export-icalendar + :type '(repeat (string :tag "Tag"))) + +(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due) + "Contexts where iCalendar export should use a deadline time stamp. + +This is a list with several symbols in it. Valid symbol are: +`event-if-todo' Deadlines in TODO entries become calendar events. +`event-if-not-todo' Deadlines in non-TODO entries become calendar events. +`todo-due' Use deadlines in TODO entries as due-dates" + :group 'org-export-icalendar + :type '(set :greedy t + (const :tag "Deadlines in non-TODO entries become events" + event-if-not-todo) + (const :tag "Deadline in TODO entries become events" + event-if-todo) + (const :tag "Deadlines in TODO entries become due-dates" + todo-due))) + +(defcustom org-icalendar-use-scheduled '(todo-start) + "Contexts where iCalendar export should use a scheduling time stamp. + +This is a list with several symbols in it. Valid symbol are: +`event-if-todo' Scheduling time stamps in TODO entries become an event. +`event-if-not-todo' Scheduling time stamps in non-TODO entries become an event. +`todo-start' Scheduling time stamps in TODO entries become start date. + Some calendar applications show TODO entries only after + that date." + :group 'org-export-icalendar + :type '(set :greedy t + (const :tag + "SCHEDULED timestamps in non-TODO entries become events" + event-if-not-todo) + (const :tag "SCHEDULED timestamps in TODO entries become events" + event-if-todo) + (const :tag "SCHEDULED in TODO entries become start date" + todo-start))) + +(defcustom org-icalendar-categories '(local-tags category) + "Items that should be entered into the \"categories\" field. + +This is a list of symbols, the following are valid: +`category' The Org mode category of the current file or tree +`todo-state' The todo state, if any +`local-tags' The tags, defined in the current line +`all-tags' All tags, including inherited ones." + :group 'org-export-icalendar + :type '(repeat + (choice + (const :tag "The file or tree category" category) + (const :tag "The TODO state" todo-state) + (const :tag "Tags defined in current line" local-tags) + (const :tag "All tags, including inherited ones" all-tags)))) + +(defcustom org-icalendar-with-timestamps 'active + "Non-nil means make an event from plain time stamps. + +It can be set to `active', `inactive', t or nil, in order to make +an event from, respectively, only active timestamps, only +inactive ones, all of them or none. + +This variable has precedence over `org-export-with-timestamps'. +It can also be set with the #+OPTIONS line, e.g. \"<:t\"." + :group 'org-export-icalendar + :type '(choice + (const :tag "All timestamps" t) + (const :tag "Only active timestamps" active) + (const :tag "Only inactive timestamps" inactive) + (const :tag "No timestamp" nil))) + +(defcustom org-icalendar-include-todo nil + "Non-nil means create VTODO components from TODO items. + +Valid values are: +nil don't include any task. +t include tasks that are not in DONE state. +`unblocked' include all TODO items that are not blocked. +`all' include both done and not done items." + :group 'org-export-icalendar + :type '(choice + (const :tag "None" nil) + (const :tag "Unfinished" t) + (const :tag "Unblocked" unblocked) + (const :tag "All" all) + (repeat :tag "Specific TODO keywords" + (string :tag "Keyword")))) + +(defcustom org-icalendar-include-bbdb-anniversaries nil + "Non-nil means a combined iCalendar file should include anniversaries. +The anniversaries are defined in the BBDB database." + :group 'org-export-icalendar + :type 'boolean) + +(defcustom org-icalendar-include-sexps t + "Non-nil means export to iCalendar files should also cover sexp entries. +These are entries like in the diary, but directly in an Org mode +file." + :group 'org-export-icalendar + :type 'boolean) + +(defcustom org-icalendar-include-body t + "Amount of text below headline to be included in iCalendar export. +This is a number of characters that should maximally be included. +Properties, scheduling and clocking lines will always be removed. +The text will be inserted into the DESCRIPTION field." + :group 'org-export-icalendar + :type '(choice + (const :tag "Nothing" nil) + (const :tag "Everything" t) + (integer :tag "Max characters"))) + +(defcustom org-icalendar-store-UID nil + "Non-nil means store any created UIDs in properties. + +The iCalendar standard requires that all entries have a unique identifier. +Org will create these identifiers as needed. When this variable is non-nil, +the created UIDs will be stored in the ID property of the entry. Then the +next time this entry is exported, it will be exported with the same UID, +superseding the previous form of it. This is essential for +synchronization services. + +This variable is not turned on by default because we want to avoid creating +a property drawer in every entry if people are only playing with this feature, +or if they are only using it locally." + :group 'org-export-icalendar + :type 'boolean) + +(defcustom org-icalendar-timezone (getenv "TZ") + "The time zone string for iCalendar export. +When nil or the empty string, use output +from (current-time-zone)." + :group 'org-export-icalendar + :type '(choice + (const :tag "Unspecified" nil) + (string :tag "Time zone"))) + +(defcustom org-icalendar-date-time-format ":%Y%m%dT%H%M%S" + "Format-string for exporting icalendar DATE-TIME. + +See `format-time-string' for a full documentation. The only +difference is that `org-icalendar-timezone' is used for %Z. + +Interesting value are: + - \":%Y%m%dT%H%M%S\" for local time + - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone + - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time" + :group 'org-export-icalendar + :version "24.1" + :type '(choice + (const :tag "Local time" ":%Y%m%dT%H%M%S") + (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S") + (const :tag "Universal time" ":%Y%m%dT%H%M%SZ") + (string :tag "Explicit format"))) + +(defvar org-icalendar-after-save-hook nil + "Hook run after an iCalendar file has been saved. +This hook is run with the name of the file as argument. A good +way to use this is to tell a desktop calendar application to +re-read the iCalendar file.") + + + +;;; Define Back-End + +(org-export-define-derived-backend 'icalendar 'ascii + :translate-alist '((clock . ignore) + (headline . org-icalendar-entry) + (inlinetask . ignore) + (planning . ignore) + (section . ignore) + (template . org-icalendar-template)) + :options-alist + '((:exclude-tags + "ICALENDAR_EXCLUDE_TAGS" nil org-icalendar-exclude-tags split) + (:with-timestamps nil "<" org-icalendar-with-timestamps) + (:with-vtodo nil nil org-icalendar-include-todo) + ;; The following property will be non-nil when export has been + ;; started from org-agenda-mode. In this case, any entry without + ;; a non-nil "ICALENDAR_MARK" property will be ignored. + (:icalendar-agenda-view nil nil nil)) + :filters-alist + '((:filter-headline . org-icalendar-clear-blank-lines)) + :menu-entry + '(?c "Export to iCalendar" + ((?f "Current file" org-icalendar-export-to-ics) + (?a "All agenda files" + (lambda (a s v b) (org-icalendar-export-agenda-files a))) + (?c "Combine all agenda files" + (lambda (a s v b) (org-icalendar-combine-agenda-files a)))))) + + + +;;; Internal Functions + +(defun org-icalendar-create-uid (file &optional bell h-markers) + "Set ID property on headlines missing it in FILE. +When optional argument BELL is non-nil, inform the user with +a message if the file was modified. With optional argument +H-MARKERS non-nil, it is a list of markers for the headlines +which will be updated." + (let ((pt (if h-markers (goto-char (car h-markers)) (point-min))) + modified-flag) + (org-map-entries + (lambda () + (let ((entry (org-element-at-point))) + (unless (or (< (point) pt) (org-element-property :ID entry)) + (org-id-get-create) + (setq modified-flag t) + (forward-line)) + (when h-markers (setq org-map-continue-from (pop h-markers))))) + nil nil 'comment) + (when (and bell modified-flag) + (message "ID properties created in file \"%s\"" file) + (sit-for 2)))) + +(defun org-icalendar-blocked-headline-p (headline info) + "Non-nil when HEADLINE is considered to be blocked. + +INFO is a plist used as a communication channel. + +a headline is blocked when either: + + - It has children which are not all in a completed state. + + - It has a parent with the property :ORDERED:, and there are + siblings prior to it with incomplete status. + + - Its parent is blocked because it has siblings that should be + done first or is a child of a blocked grandparent entry." + (or + ;; Check if any child is not done. + (org-element-map headline 'headline + (lambda (hl) (eq (org-element-property :todo-type hl) 'todo)) + info 'first-match) + ;; Check :ORDERED: node property. + (catch 'blockedp + (let ((current headline)) + (mapc (lambda (parent) + (cond + ((not (org-element-property :todo-keyword parent)) + (throw 'blockedp nil)) + ((org-not-nil (org-element-property :ORDERED parent)) + (let ((sibling current)) + (while (setq sibling (org-export-get-previous-element + sibling info)) + (when (eq (org-element-property :todo-type sibling) 'todo) + (throw 'blockedp t))))) + (t (setq current parent)))) + (org-export-get-genealogy headline)) + nil)))) + +(defun org-icalendar-use-UTC-date-time-p () + "Non-nil when `org-icalendar-date-time-format' requires UTC time." + (char-equal (elt org-icalendar-date-time-format + (1- (length org-icalendar-date-time-format))) ?Z)) + +(defvar org-agenda-default-appointment-duration) ; From org-agenda.el. +(defun org-icalendar-convert-timestamp (timestamp keyword &optional end utc) + "Convert TIMESTAMP to iCalendar format. + +TIMESTAMP is a timestamp object. KEYWORD is added in front of +it, in order to make a complete line (e.g. \"DTSTART\"). + +When optional argument END is non-nil, use end of time range. +Also increase the hour by two (if time string contains a time), +or the day by one (if it does not contain a time) when no +explicit ending time is specified. + +When optional argument UTC is non-nil, time will be expressed in +Universal Time, ignoring `org-icalendar-date-time-format'." + (let* ((year-start (org-element-property :year-start timestamp)) + (year-end (org-element-property :year-end timestamp)) + (month-start (org-element-property :month-start timestamp)) + (month-end (org-element-property :month-end timestamp)) + (day-start (org-element-property :day-start timestamp)) + (day-end (org-element-property :day-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp)) + (minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (with-time-p minute-start) + (equal-bounds-p + (equal (list year-start month-start day-start hour-start minute-start) + (list year-end month-end day-end hour-end minute-end))) + (mi (cond ((not with-time-p) 0) + ((not end) minute-start) + ((and org-agenda-default-appointment-duration equal-bounds-p) + (+ minute-end org-agenda-default-appointment-duration)) + (t minute-end))) + (h (cond ((not with-time-p) 0) + ((not end) hour-start) + ((or (not equal-bounds-p) + org-agenda-default-appointment-duration) + hour-end) + (t (+ hour-end 2)))) + (d (cond ((not end) day-start) + ((not with-time-p) (1+ day-end)) + (t day-end))) + (m (if end month-end month-start)) + (y (if end year-end year-start))) + (concat + keyword + (format-time-string + (cond (utc ":%Y%m%dT%H%M%SZ") + ((not with-time-p) ";VALUE=DATE:%Y%m%d") + (t (replace-regexp-in-string "%Z" + org-icalendar-timezone + org-icalendar-date-time-format + t))) + ;; Convert timestamp into internal time in order to use + ;; `format-time-string' and fix any mistake (i.e. MI >= 60). + (encode-time 0 mi h d m y) + (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p))))))) + +(defun org-icalendar-dtstamp () + "Return DTSTAMP property, as a string." + (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) + +(defun org-icalendar-get-categories (entry info) + "Return categories according to `org-icalendar-categories'. +ENTRY is a headline or an inlinetask element. INFO is a plist +used as a communication channel." + (mapconcat + 'identity + (org-uniquify + (let (categories) + (mapc (lambda (type) + (case type + (category + (push (org-export-get-category entry info) categories)) + (todo-state + (let ((todo (org-element-property :todo-keyword entry))) + (and todo (push todo categories)))) + (local-tags + (setq categories + (append (nreverse (org-export-get-tags entry info)) + categories))) + (all-tags + (setq categories + (append (nreverse (org-export-get-tags entry info nil t)) + categories))))) + org-icalendar-categories) + ;; Return list of categories, following specified order. + (nreverse categories))) ",")) + +(defun org-icalendar-transcode-diary-sexp (sexp uid summary) + "Transcode a diary sexp into iCalendar format. +SEXP is the diary sexp being transcoded, as a string. UID is the +unique identifier for the entry. SUMMARY defines a short summary +or subject for the event." + (when (require 'icalendar nil t) + (org-element-normalize-string + (with-temp-buffer + (let ((sexp (if (not (string-match "\\`<%%" sexp)) sexp + (concat (substring sexp 1 -1) " " summary)))) + (put-text-property 0 1 'uid uid sexp) + (insert sexp "\n")) + (org-diary-to-ical-string (current-buffer)))))) + +(defun org-icalendar-cleanup-string (s) + "Cleanup string S according to RFC 5545." + (when s + ;; Protect "\", "," and ";" characters. and replace newline + ;; characters with literal \n. + (replace-regexp-in-string + "[ \t]*\n" "\\n" + (replace-regexp-in-string "[\\,;]" "\\\&" s) + nil t))) + +(defun org-icalendar-fold-string (s) + "Fold string S according to RFC 5545." + (org-element-normalize-string + (mapconcat + (lambda (line) + ;; Limit each line to a maximum of 75 characters. If it is + ;; longer, fold it by using "\n " as a continuation marker. + (let ((len (length line))) + (if (<= len 75) line + (let ((folded-line (substring line 0 75)) + (chunk-start 75) + chunk-end) + ;; Since continuation marker takes up one character on the + ;; line, real contents must be split at 74 chars. + (while (< (setq chunk-end (+ chunk-start 74)) len) + (setq folded-line + (concat folded-line "\n " + (substring line chunk-start chunk-end)) + chunk-start chunk-end)) + (concat folded-line "\n " (substring line chunk-start)))))) + (org-split-string s "\n") "\n"))) + + + +;;; Filters + +(defun org-icalendar-clear-blank-lines (headline back-end info) + "Remove trailing blank lines in HEADLINE export. +HEADLINE is a string representing a transcoded headline. +BACK-END and INFO are ignored." + (replace-regexp-in-string "^\\(?:[ \t]*\n\\)*" "" headline)) + + + +;;; Transcode Functions + +;;;; Headline and Inlinetasks + +;; The main function is `org-icalendar-entry', which extracts +;; information from a headline or an inlinetask (summary, +;; description...) and then delegates code generation to +;; `org-icalendar--vtodo' and `org-icalendar--vevent', depending +;; on the component needed. + +;; Obviously, `org-icalendar--valarm' handles alarms, which can +;; happen within a VTODO component. + +(defun org-icalendar-entry (entry contents info) + "Transcode ENTRY element into iCalendar format. + +ENTRY is either a headline or an inlinetask. CONTENTS is +ignored. INFO is a plist used as a communication channel. + +This function is called on every headline, the section below +it (minus inlinetasks) being its contents. It tries to create +VEVENT and VTODO components out of scheduled date, deadline date, +plain timestamps, diary sexps. It also calls itself on every +inlinetask within the section." + (unless (org-element-property :footnote-section-p entry) + (let* ((type (org-element-type entry)) + ;; Determine contents really associated to the entry. For + ;; a headline, limit them to section, if any. For an + ;; inlinetask, this is every element within the task. + (inside + (if (eq type 'inlinetask) + (cons 'org-data (cons nil (org-element-contents entry))) + (let ((first (car (org-element-contents entry)))) + (and (eq (org-element-type first) 'section) + (cons 'org-data + (cons nil (org-element-contents first)))))))) + (concat + (unless (and (plist-get info :icalendar-agenda-view) + (not (org-element-property :ICALENDAR-MARK entry))) + (let ((todo-type (org-element-property :todo-type entry)) + (uid (or (org-element-property :ID entry) (org-id-new))) + (summary (org-icalendar-cleanup-string + (or (org-element-property :SUMMARY entry) + (org-export-data + (org-element-property :title entry) info)))) + (loc (org-icalendar-cleanup-string + (org-element-property :LOCATION entry))) + ;; Build description of the entry from associated + ;; section (headline) or contents (inlinetask). + (desc + (org-icalendar-cleanup-string + (or (org-element-property :DESCRIPTION entry) + (let ((contents (org-export-data inside info))) + (cond + ((not (org-string-nw-p contents)) nil) + ((wholenump org-icalendar-include-body) + (let ((contents (org-trim contents))) + (substring + contents 0 (min (length contents) + org-icalendar-include-body)))) + (org-icalendar-include-body (org-trim contents))))))) + (cat (org-icalendar-get-categories entry info))) + (concat + ;; Events: Delegate to `org-icalendar--vevent' to + ;; generate "VEVENT" component from scheduled, deadline, + ;; or any timestamp in the entry. + (let ((deadline (org-element-property :deadline entry))) + (and deadline + (memq (if todo-type 'event-if-todo 'event-if-not-todo) + org-icalendar-use-deadline) + (org-icalendar--vevent + entry deadline (concat "DL-" uid) + (concat "DL: " summary) loc desc cat))) + (let ((scheduled (org-element-property :scheduled entry))) + (and scheduled + (memq (if todo-type 'event-if-todo 'event-if-not-todo) + org-icalendar-use-scheduled) + (org-icalendar--vevent + entry scheduled (concat "SC-" uid) + (concat "S: " summary) loc desc cat))) + ;; When collecting plain timestamps from a headline and + ;; its title, skip inlinetasks since collection will + ;; happen once ENTRY is one of them. + (let ((counter 0)) + (mapconcat + 'identity + (org-element-map (cons (org-element-property :title entry) + (org-element-contents inside)) + 'timestamp + (lambda (ts) + (let ((uid (format "TS%d-%s" (incf counter) uid))) + (org-icalendar--vevent entry ts uid summary loc desc cat))) + info nil (and (eq type 'headline) 'inlinetask)) + "")) + ;; Task: First check if it is appropriate to export it. + ;; If so, call `org-icalendar--vtodo' to transcode it + ;; into a "VTODO" component. + (when (and todo-type + (case (plist-get info :with-vtodo) + (all t) + (unblocked + (and (eq type 'headline) + (not (org-icalendar-blocked-headline-p + entry info)))) + ('t (eq todo-type 'todo)))) + (org-icalendar--vtodo entry uid summary loc desc cat)) + ;; Diary-sexp: Collect every diary-sexp element within + ;; ENTRY and its title, and transcode them. If ENTRY is + ;; a headline, skip inlinetasks: they will be handled + ;; separately. + (when org-icalendar-include-sexps + (let ((counter 0)) + (mapconcat 'identity + (org-element-map + (cons (org-element-property :title entry) + (org-element-contents inside)) + 'diary-sexp + (lambda (sexp) + (org-icalendar-transcode-diary-sexp + (org-element-property :value sexp) + (format "DS%d-%s" (incf counter) uid) + summary)) + info nil (and (eq type 'headline) 'inlinetask)) + "")))))) + ;; If ENTRY is a headline, call current function on every + ;; inlinetask within it. In agenda export, this is independent + ;; from the mark (or lack thereof) on the entry. + (when (eq type 'headline) + (mapconcat 'identity + (org-element-map inside 'inlinetask + (lambda (task) (org-icalendar-entry task nil info)) + info) "")) + ;; Don't forget components from inner entries. + contents)))) + +(defun org-icalendar--vevent + (entry timestamp uid summary location description categories) + "Create a VEVENT component. + +ENTRY is either a headline or an inlinetask element. TIMESTAMP +is a timestamp object defining the date-time of the event. UID +is the unique identifier for the event. SUMMARY defines a short +summary or subject for the event. LOCATION defines the intended +venue for the event. DESCRIPTION provides the complete +description of the event. CATEGORIES defines the categories the +event belongs to. + +Return VEVENT component as a string." + (org-icalendar-fold-string + (if (eq (org-element-property :type timestamp) 'diary) + (org-icalendar-transcode-diary-sexp + (org-element-property :raw-value timestamp) uid summary) + (concat "BEGIN:VEVENT\n" + (org-icalendar-dtstamp) "\n" + "UID:" uid "\n" + (org-icalendar-convert-timestamp timestamp "DTSTART") "\n" + (org-icalendar-convert-timestamp timestamp "DTEND" t) "\n" + ;; RRULE. + (when (org-element-property :repeater-type timestamp) + (format "RRULE:FREQ=%s;INTERVAL=%d\n" + (case (org-element-property :repeater-unit timestamp) + (hour "HOURLY") (day "DAILY") (week "WEEKLY") + (month "MONTHLY") (year "YEARLY")) + (org-element-property :repeater-value timestamp))) + "SUMMARY:" summary "\n" + (and (org-string-nw-p location) (format "LOCATION:%s\n" location)) + (and (org-string-nw-p description) + (format "DESCRIPTION:%s\n" description)) + "CATEGORIES:" categories "\n" + ;; VALARM. + (org-icalendar--valarm entry timestamp summary) + "END:VEVENT")))) + +(defun org-icalendar--vtodo + (entry uid summary location description categories) + "Create a VTODO component. + +ENTRY is either a headline or an inlinetask element. UID is the +unique identifier for the task. SUMMARY defines a short summary +or subject for the task. LOCATION defines the intended venue for +the task. DESCRIPTION provides the complete description of the +task. CATEGORIES defines the categories the task belongs to. + +Return VTODO component as a string." + (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled) + (org-element-property :scheduled entry)) + ;; If we can't use a scheduled time for some + ;; reason, start task now. + (let ((now (decode-time (current-time)))) + (list 'timestamp + (list :type 'active + :minute-start (nth 1 now) + :hour-start (nth 2 now) + :day-start (nth 3 now) + :month-start (nth 4 now) + :year-start (nth 5 now))))))) + (org-icalendar-fold-string + (concat "BEGIN:VTODO\n" + "UID:TODO-" uid "\n" + (org-icalendar-dtstamp) "\n" + (org-icalendar-convert-timestamp start "DTSTART") "\n" + (and (memq 'todo-due org-icalendar-use-deadline) + (org-element-property :deadline entry) + (concat (org-icalendar-convert-timestamp + (org-element-property :deadline entry) "DUE") + "\n")) + "SUMMARY:" summary "\n" + (and (org-string-nw-p location) (format "LOCATION:%s\n" location)) + (and (org-string-nw-p description) + (format "DESCRIPTION:%s\n" description)) + "CATEGORIES:" categories "\n" + "SEQUENCE:1\n" + (format "PRIORITY:%d\n" + (let ((pri (or (org-element-property :priority entry) + org-default-priority))) + (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri)) + (- org-lowest-priority + org-highest-priority))))))) + (format "STATUS:%s\n" + (if (eq (org-element-property :todo-type entry) 'todo) + "NEEDS-ACTION" + "COMPLETED")) + "END:VTODO")))) + +(defun org-icalendar--valarm (entry timestamp summary) + "Create a VALARM component. + +ENTRY is the calendar entry triggering the alarm. TIMESTAMP is +the start date-time of the entry. SUMMARY defines a short +summary or subject for the task. + +Return VALARM component as a string, or nil if it isn't allowed." + ;; Create a VALARM entry if the entry is timed. This is not very + ;; general in that: + ;; (a) only one alarm per entry is defined, + ;; (b) only minutes are allowed for the trigger period ahead of the + ;; start time, + ;; (c) only a DISPLAY action is defined. [ESF] + (let ((alarm-time + (let ((warntime + (org-element-property :APPT_WARNTIME entry))) + (if warntime (string-to-number warntime) 0)))) + (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0)) + (org-element-property :hour-start timestamp) + (format "BEGIN:VALARM +ACTION:DISPLAY +DESCRIPTION:%s +TRIGGER:-P0DT0H%dM0S +END:VALARM\n" + summary + (if (zerop alarm-time) org-icalendar-alarm-time alarm-time))))) + + +;;;; Template + +(defun org-icalendar-template (contents info) + "Return complete document string after iCalendar conversion. +CONTENTS is the transcoded contents string. INFO is a plist used +as a communication channel." + (org-icalendar--vcalendar + ;; Name. + (if (not (plist-get info :input-file)) (buffer-name (buffer-base-buffer)) + (file-name-nondirectory + (file-name-sans-extension (plist-get info :input-file)))) + ;; Owner. + (if (not (plist-get info :with-author)) "" + (org-export-data (plist-get info :author) info)) + ;; Timezone. + (if (org-string-nw-p org-icalendar-timezone) org-icalendar-timezone + (cadr (current-time-zone))) + ;; Description. + (org-export-data (plist-get info :title) info) + contents)) + +(defun org-icalendar--vcalendar (name owner tz description contents) + "Create a VCALENDAR component. +NAME, OWNER, TZ, DESCRIPTION and CONTENTS are all strings giving, +respectively, the name of the calendar, its owner, the timezone +used, a short description and the other components included." + (concat (format "BEGIN:VCALENDAR +VERSION:2.0 +X-WR-CALNAME:%s +PRODID:-//%s//Emacs with Org mode//EN +X-WR-TIMEZONE:%s +X-WR-CALDESC:%s +CALSCALE:GREGORIAN\n" + (org-icalendar-cleanup-string name) + (org-icalendar-cleanup-string owner) + (org-icalendar-cleanup-string tz) + (org-icalendar-cleanup-string description)) + contents + "END:VCALENDAR\n")) + + + +;;; Interactive Functions + +;;;###autoload +(defun org-icalendar-export-to-ics + (&optional async subtreep visible-only body-only) + "Export current buffer to an iCalendar file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"BEGIN:VCALENDAR\" and \"END:VCALENDAR\". + +Return ICS file name." + (interactive) + (let ((file (buffer-file-name (buffer-base-buffer)))) + (when (and file org-icalendar-store-UID) + (org-icalendar-create-uid file 'warn-user))) + ;; Export part. Since this back-end is backed up by `ascii', ensure + ;; links will not be collected at the end of sections. + (let ((outfile (org-export-output-file-name ".ics" subtreep))) + (if async + (org-export-async-start + (lambda (f) + (org-export-add-to-stack f 'icalendar) + (run-hook-with-args 'org-icalendar-after-save-hook f)) + `(let ((org-ascii-links-to-notes nil)) + (expand-file-name + (org-export-to-file + 'icalendar ,outfile ,subtreep ,visible-only ,body-only + '(:ascii-charset utf-8))))) + (let ((org-ascii-links-to-notes nil)) + (org-export-to-file 'icalendar outfile subtreep visible-only body-only + '(:ascii-charset utf-8))) + (run-hook-with-args 'org-icalendar-after-save-hook outfile) + outfile))) + +;;;###autoload +(defun org-icalendar-export-agenda-files (&optional async) + "Export all agenda files to iCalendar files. +When optional argument ASYNC is non-nil, export happens in an +external process." + (interactive) + (if async + ;; Asynchronous export is not interactive, so we will not call + ;; `org-check-agenda-file'. Instead we remove any non-existent + ;; agenda file from the list. + (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t)))) + (org-export-async-start + (lambda (results) + (mapc (lambda (f) (org-export-add-to-stack f 'icalendar)) + results)) + `(let (output-files) + (mapc (lambda (file) + (with-current-buffer (org-get-agenda-file-buffer file) + (push (expand-file-name (org-icalendar-export-to-ics)) + output-files))) + ',files) + output-files))) + (let ((files (org-agenda-files t))) + (org-agenda-prepare-buffers files) + (unwind-protect + (mapc (lambda (file) + (catch 'nextfile + (org-check-agenda-file file) + (with-current-buffer (org-get-agenda-file-buffer file) + (org-icalendar-export-to-ics)))) + files) + (org-release-buffers org-agenda-new-buffers))))) + +;;;###autoload +(defun org-icalendar-combine-agenda-files (&optional async) + "Combine all agenda files into a single iCalendar file. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +The file is stored under the name chosen in +`org-icalendar-combined-agenda-file'." + (interactive) + (if async + (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t)))) + (org-export-async-start + (lambda (dummy) + (org-export-add-to-stack + (expand-file-name org-icalendar-combined-agenda-file) + 'icalendar)) + `(apply 'org-icalendar--combine-files nil ',files))) + (apply 'org-icalendar--combine-files nil (org-agenda-files t)))) + +(defun org-icalendar-export-current-agenda (file) + "Export current agenda view to an iCalendar FILE. +This function assumes major mode for current buffer is +`org-agenda-mode'." + (let (org-export-babel-evaluate ; Don't evaluate Babel block + (org-icalendar-combined-agenda-file file) + (marker-list + ;; Collect the markers pointing to entries in the current + ;; agenda buffer. + (let (markers) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((m (or (org-get-at-bol 'org-hd-marker) + (org-get-at-bol 'org-marker)))) + (and m (push m markers))) + (beginning-of-line 2))) + (nreverse markers)))) + (apply 'org-icalendar--combine-files + ;; Build restriction alist. + (let (restriction) + ;; Sort markers in each association within RESTRICTION. + (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x) + (dolist (m marker-list restriction) + (let* ((pos (marker-position m)) + (file (buffer-file-name + (org-base-buffer (marker-buffer m)))) + (file-markers (assoc file restriction))) + ;; Add POS in FILE association if one exists + ;; or create a new association for FILE. + (if file-markers (push pos (cdr file-markers)) + (push (list file pos) restriction)))))) + (org-agenda-files nil 'ifmode)))) + +(defun org-icalendar--combine-files (restriction &rest files) + "Combine entries from multiple files into an iCalendar file. +RESTRICTION, when non-nil, is an alist where key is a file name +and value a list of buffer positions pointing to entries that +should appear in the calendar. It only makes sense if the +function was called from an agenda buffer. FILES is a list of +files to build the calendar from." + (org-agenda-prepare-buffers files) + (unwind-protect + (progn + (with-temp-file org-icalendar-combined-agenda-file + (insert + (org-icalendar--vcalendar + ;; Name. + org-icalendar-combined-name + ;; Owner. + user-full-name + ;; Timezone. + (if (org-string-nw-p org-icalendar-timezone) + org-icalendar-timezone + (cadr (current-time-zone))) + ;; Description. + org-icalendar-combined-description + ;; Contents. + (concat + ;; Agenda contents. + (mapconcat + (lambda (file) + (catch 'nextfile + (org-check-agenda-file file) + (with-current-buffer (org-get-agenda-file-buffer file) + (let ((marks (cdr (assoc (expand-file-name file) restriction)))) + ;; Create ID if necessary. + (when org-icalendar-store-UID + (org-icalendar-create-uid file t marks)) + (unless (and restriction (not marks)) + ;; Add a hook adding :ICALENDAR_MARK: property + ;; to each entry appearing in agenda view. + ;; Use `apply-partially' because the function + ;; still has to accept one argument. + (let ((org-export-before-processing-hook + (cons (apply-partially + (lambda (m-list dummy) + (mapc (lambda (m) + (org-entry-put + m "ICALENDAR-MARK" "t")) + m-list)) + (sort marks '>)) + org-export-before-processing-hook))) + (org-export-as + 'icalendar nil nil t + (list :ascii-charset 'utf-8 + :icalendar-agenda-view restriction)))))))) + files "") + ;; BBDB anniversaries. + (when (and org-icalendar-include-bbdb-anniversaries + (require 'org-bbdb nil t)) + (with-temp-buffer + (org-bbdb-anniv-export-ical) + (buffer-string))))))) + (run-hook-with-args 'org-icalendar-after-save-hook + org-icalendar-combined-agenda-file)) + (org-release-buffers org-agenda-new-buffers))) + + +(provide 'ox-icalendar) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-icalendar.el ends here diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el new file mode 100644 index 000000000..2a315ef70 --- /dev/null +++ b/lisp/ox-latex.el @@ -0,0 +1,2959 @@ +;;; ox-latex.el --- LaTeX Back-End for Org Export Engine + +;; Copyright (C) 2011-2013 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; See Org manual for details. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox) +(require 'ox-publish) + +(defvar org-latex-default-packages-alist) +(defvar org-latex-packages-alist) +(defvar orgtbl-exp-regexp) + + + +;;; Define Back-End + +(org-export-define-backend 'latex + '((bold . org-latex-bold) + (center-block . org-latex-center-block) + (clock . org-latex-clock) + (code . org-latex-code) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (drawer . org-latex-drawer) + (dynamic-block . org-latex-dynamic-block) + (entity . org-latex-entity) + (example-block . org-latex-example-block) + (export-block . org-latex-export-block) + (export-snippet . org-latex-export-snippet) + (fixed-width . org-latex-fixed-width) + (footnote-definition . org-latex-footnote-definition) + (footnote-reference . org-latex-footnote-reference) + (headline . org-latex-headline) + (horizontal-rule . org-latex-horizontal-rule) + (inline-src-block . org-latex-inline-src-block) + (inlinetask . org-latex-inlinetask) + (italic . org-latex-italic) + (item . org-latex-item) + (keyword . org-latex-keyword) + (latex-environment . org-latex-latex-environment) + (latex-fragment . org-latex-latex-fragment) + (line-break . org-latex-line-break) + (link . org-latex-link) + (paragraph . org-latex-paragraph) + (plain-list . org-latex-plain-list) + (plain-text . org-latex-plain-text) + (planning . org-latex-planning) + (property-drawer . (lambda (&rest args) "")) + (quote-block . org-latex-quote-block) + (quote-section . org-latex-quote-section) + (radio-target . org-latex-radio-target) + (section . org-latex-section) + (special-block . org-latex-special-block) + (src-block . org-latex-src-block) + (statistics-cookie . org-latex-statistics-cookie) + (strike-through . org-latex-strike-through) + (subscript . org-latex-subscript) + (superscript . org-latex-superscript) + (table . org-latex-table) + (table-cell . org-latex-table-cell) + (table-row . org-latex-table-row) + (target . org-latex-target) + (template . org-latex-template) + (timestamp . org-latex-timestamp) + (underline . org-latex-underline) + (verbatim . org-latex-verbatim) + (verse-block . org-latex-verse-block)) + :export-block '("LATEX" "TEX") + :menu-entry + '(?l "Export to LaTeX" + ((?L "As LaTeX buffer" org-latex-export-as-latex) + (?l "As LaTeX file" org-latex-export-to-latex) + (?p "As PDF file" org-latex-export-to-pdf) + (?o "As PDF file and open" + (lambda (a s v b) + (if a (org-latex-export-to-pdf t s v b) + (org-open-file (org-latex-export-to-pdf nil s v b))))))) + :options-alist '((:latex-class "LATEX_CLASS" nil org-latex-default-class t) + (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t) + (:latex-header "LATEX_HEADER" nil nil newline) + (:latex-header-extra "LATEX_HEADER_EXTRA" nil nil newline) + (:latex-hyperref-p nil "texht" org-latex-with-hyperref t) + ;; Redefine regular options. + (:date "DATE" nil "\\today" t))) + + + +;;; Internal Variables + +(defconst org-latex-babel-language-alist + '(("af" . "afrikaans") + ("bg" . "bulgarian") + ("bt-br" . "brazilian") + ("ca" . "catalan") + ("cs" . "czech") + ("cy" . "welsh") + ("da" . "danish") + ("de" . "germanb") + ("de-at" . "naustrian") + ("de-de" . "ngerman") + ("el" . "greek") + ("en" . "english") + ("en-au" . "australian") + ("en-ca" . "canadian") + ("en-gb" . "british") + ("en-ie" . "irish") + ("en-nz" . "newzealand") + ("en-us" . "american") + ("es" . "spanish") + ("et" . "estonian") + ("eu" . "basque") + ("fi" . "finnish") + ("fr" . "frenchb") + ("fr-ca" . "canadien") + ("gl" . "galician") + ("hr" . "croatian") + ("hu" . "hungarian") + ("id" . "indonesian") + ("is" . "icelandic") + ("it" . "italian") + ("la" . "latin") + ("ms" . "malay") + ("nl" . "dutch") + ("no-no" . "nynorsk") + ("pl" . "polish") + ("pt" . "portuguese") + ("ro" . "romanian") + ("ru" . "russian") + ("sa" . "sanskrit") + ("sb" . "uppersorbian") + ("sk" . "slovak") + ("sl" . "slovene") + ("sq" . "albanian") + ("sr" . "serbian") + ("sv" . "swedish") + ("ta" . "tamil") + ("tr" . "turkish") + ("uk" . "ukrainian")) + "Alist between language code and corresponding Babel option.") + +(defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr") + ("qbordermatrix" . "\\cr") + ("kbordermatrix" . "\\\\")) + "Alist between matrix macros and their row ending.") + + + +;;; User Configurable Variables + +(defgroup org-export-latex nil + "Options for exporting Org mode files to LaTeX." + :tag "Org Export LaTeX" + :group 'org-export) + + +;;;; Preamble + +(defcustom org-latex-default-class "article" + "The default LaTeX class." + :group 'org-export-latex + :type '(string :tag "LaTeX class")) + +(defcustom org-latex-classes + '(("article" + "\\documentclass[11pt]{article}" + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}") + ("\\paragraph{%s}" . "\\paragraph*{%s}") + ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) + ("report" + "\\documentclass[11pt]{report}" + ("\\part{%s}" . "\\part*{%s}") + ("\\chapter{%s}" . "\\chapter*{%s}") + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) + ("book" + "\\documentclass[11pt]{book}" + ("\\part{%s}" . "\\part*{%s}") + ("\\chapter{%s}" . "\\chapter*{%s}") + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))) + "Alist of LaTeX classes and associated header and structure. +If #+LATEX_CLASS is set in the buffer, use its value and the +associated information. Here is the structure of each cell: + + \(class-name + header-string + \(numbered-section . unnumbered-section) + ...) + +The header string +----------------- + +The HEADER-STRING is the header that will be inserted into the +LaTeX file. It should contain the \\documentclass macro, and +anything else that is needed for this setup. To this header, the +following commands will be added: + +- Calls to \\usepackage for all packages mentioned in the + variables `org-latex-default-packages-alist' and + `org-latex-packages-alist'. Thus, your header definitions + should avoid to also request these packages. + +- Lines specified via \"#+LATEX_HEADER:\" and + \"#+LATEX_HEADER_EXTRA:\" keywords. + +If you need more control about the sequence in which the header +is built up, or if you want to exclude one of these building +blocks for a particular class, you can use the following +macro-like placeholders. + + [DEFAULT-PACKAGES] \\usepackage statements for default packages + [NO-DEFAULT-PACKAGES] do not include any of the default packages + [PACKAGES] \\usepackage statements for packages + [NO-PACKAGES] do not include the packages + [EXTRA] the stuff from #+LATEX_HEADER(_EXTRA) + [NO-EXTRA] do not include #+LATEX_HEADER(_EXTRA) stuff + +So a header like + + \\documentclass{article} + [NO-DEFAULT-PACKAGES] + [EXTRA] + \\providecommand{\\alert}[1]{\\textbf{#1}} + [PACKAGES] + +will omit the default packages, and will include the +#+LATEX_HEADER and #+LATEX_HEADER_EXTRA lines, then have a call +to \\providecommand, and then place \\usepackage commands based +on the content of `org-latex-packages-alist'. + +If your header, `org-latex-default-packages-alist' or +`org-latex-packages-alist' inserts +\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be +replaced with a coding system derived from +`buffer-file-coding-system'. See also the variable +`org-latex-inputenc-alist' for a way to influence this mechanism. + +The sectioning structure +------------------------ + +The sectioning structure of the class is given by the elements +following the header string. For each sectioning level, a number +of strings is specified. A %s formatter is mandatory in each +section string and will be replaced by the title of the section. + +Instead of a cons cell (numbered . unnumbered), you can also +provide a list of 2 or 4 elements, + + \(numbered-open numbered-close) + +or + + \(numbered-open numbered-close unnumbered-open unnumbered-close) + +providing opening and closing strings for a LaTeX environment +that should represent the document section. The opening clause +should have a %s to represent the section title. + +Instead of a list of sectioning commands, you can also specify +a function name. That function will be called with two +parameters, the (reduced) level of the headline, and a predicate +non-nil when the headline should be numbered. It must return +a format string in which the section title will be added." + :group 'org-export-latex + :type '(repeat + (list (string :tag "LaTeX class") + (string :tag "LaTeX header") + (repeat :tag "Levels" :inline t + (choice + (cons :tag "Heading" + (string :tag " numbered") + (string :tag "unnumbered")) + (list :tag "Environment" + (string :tag "Opening (numbered)") + (string :tag "Closing (numbered)") + (string :tag "Opening (unnumbered)") + (string :tag "Closing (unnumbered)")) + (function :tag "Hook computing sectioning")))))) + +(defcustom org-latex-inputenc-alist nil + "Alist of inputenc coding system names, and what should really be used. +For example, adding an entry + + (\"utf8\" . \"utf8x\") + +will cause \\usepackage[utf8x]{inputenc} to be used for buffers that +are written as utf8 files." + :group 'org-export-latex + :type '(repeat + (cons + (string :tag "Derived from buffer") + (string :tag "Use this instead")))) + +(defcustom org-latex-title-command "\\maketitle" + "The command used to insert the title just after \\begin{document}. +If this string contains the formatting specification \"%s\" then +it will be used as a formatting string, passing the title as an +argument." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-toc-command "\\tableofcontents\n\n" + "LaTeX command to set the table of contents, list of figures, etc. +This command only applies to the table of contents generated with +the toc:nil option, not to those generated with #+TOC keyword." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-with-hyperref t + "Toggle insertion of \\hypersetup{...} in the preamble." + :group 'org-export-latex + :type 'boolean) + + +;;;; Headline + +(defcustom org-latex-format-headline-function + 'org-latex-format-headline-default-function + "Function for formatting the headline's text. + +This function will be called with 5 arguments: +TODO the todo keyword (string or nil). +TODO-TYPE the type of todo (symbol: `todo', `done', nil) +PRIORITY the priority of the headline (integer or nil) +TEXT the main headline text (string). +TAGS the tags as a list of strings (list of strings or nil). + +The function result will be used in the section format string. + +Use `org-latex-format-headline-default-function' by default, +which format headlines like for Org version prior to 8.0." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + + +;;;; Footnotes + +(defcustom org-latex-footnote-separator "\\textsuperscript{,}\\," + "Text used to separate footnotes." + :group 'org-export-latex + :type 'string) + + +;;;; Timestamps + +(defcustom org-latex-active-timestamp-format "\\textit{%s}" + "A printf format string to be applied to active timestamps." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-inactive-timestamp-format "\\textit{%s}" + "A printf format string to be applied to inactive timestamps." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-diary-timestamp-format "\\textit{%s}" + "A printf format string to be applied to diary timestamps." + :group 'org-export-latex + :type 'string) + + +;;;; Links + +(defcustom org-latex-image-default-option "" + "Default option for images." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-latex-image-default-width ".9\\linewidth" + "Default width for images. +This value will not be used if a height is provided." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-latex-image-default-height "" + "Default height for images. +This value will not be used if a width is provided, or if the +image is wrapped within a \"figure\" or \"wrapfigure\" +environment." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-latex-default-figure-position "htb" + "Default position for latex figures." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-inline-image-rules + '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\)\\'")) + "Rules characterizing image files that can be inlined into LaTeX. + +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path. + +Note that, by default, the image extension *actually* allowed +depend on the way the LaTeX file is processed. When used with +pdflatex, pdf, jpg and png images are OK. When processing +through dvi to Postscript, only ps and eps are allowed. The +default we use here encompasses both." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +(defcustom org-latex-link-with-unknown-path-format "\\texttt{%s}" + "Format string for links with unknown path type." + :group 'org-export-latex + :type 'string) + + +;;;; Tables + +(defcustom org-latex-default-table-environment "tabular" + "Default environment used to build tables." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-latex-default-table-mode 'table + "Default mode for tables. + +Value can be a symbol among: + + `table' Regular LaTeX table. + + `math' In this mode, every cell is considered as being in math + mode and the complete table will be wrapped within a math + environment. It is particularly useful to write matrices. + + `inline-math' This mode is almost the same as `math', but the + math environment will be inlined. + + `verbatim' The table is exported as it appears in the Org + buffer, within a verbatim environment. + +This value can be overridden locally with, i.e. \":mode math\" in +LaTeX attributes. + +When modifying this variable, it may be useful to change +`org-latex-default-table-environment' accordingly." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice (const :tag "Table" table) + (const :tag "Matrix" math) + (const :tag "Inline matrix" inline-math) + (const :tag "Verbatim" verbatim))) + +(defcustom org-latex-tables-centered t + "When non-nil, tables are exported in a center environment." + :group 'org-export-latex + :type 'boolean) + +(defcustom org-latex-tables-booktabs nil + "When non-nil, display tables in a formal \"booktabs\" style. +This option assumes that the \"booktabs\" package is properly +loaded in the header of the document. This value can be ignored +locally with \":booktabs t\" and \":booktabs nil\" LaTeX +attributes." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-latex-table-caption-above t + "When non-nil, place caption string at the beginning of the table. +Otherwise, place it near the end." + :group 'org-export-latex + :type 'boolean) + +(defcustom org-latex-table-scientific-notation "%s\\,(%s)" + "Format string to display numbers in scientific notation. +The format should have \"%s\" twice, for mantissa and exponent +\(i.e., \"%s\\\\times10^{%s}\"). + +When nil, no transformation is made." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (string :tag "Format string") + (const :tag "No formatting"))) + + +;;;; Text markup + +(defcustom org-latex-text-markup-alist '((bold . "\\textbf{%s}") + (code . verb) + (italic . "\\emph{%s}") + (strike-through . "\\st{%s}") + (underline . "\\underline{%s}") + (verbatim . protectedtexttt)) + "Alist of LaTeX expressions to convert text markup. + +The key must be a symbol among `bold', `code', `italic', +`strike-through', `underline' and `verbatim'. The value is +a formatting string to wrap fontified text with. + +Value can also be set to the following symbols: `verb' and +`protectedtexttt'. For the former, Org will use \"\\verb\" to +create a format string and select a delimiter character that +isn't in the string. For the latter, Org will use \"\\texttt\" +to typeset and try to protect special characters. + +If no association can be found for a given markup, text will be +returned as-is." + :group 'org-export-latex + :type 'alist + :options '(bold code italic strike-through underline verbatim)) + + +;;;; Drawers + +(defcustom org-latex-format-drawer-function nil + "Function called to format a drawer in LaTeX code. + +The function must accept two parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + +The function should return the string to be exported. + +For example, the variable could be set to the following function +in order to mimic default behaviour: + +\(defun org-latex-format-drawer-default \(name contents\) + \"Format a drawer element for LaTeX export.\" + contents\)" + :group 'org-export-latex + :type 'function) + + +;;;; Inlinetasks + +(defcustom org-latex-format-inlinetask-function nil + "Function called to format an inlinetask in LaTeX code. + +The function must accept six parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a list of strings. + CONTENTS the contents of the inlinetask, as a string. + +The function should return the string to be exported. + +For example, the variable could be set to the following function +in order to mimic default behaviour: + +\(defun org-latex-format-inlinetask \(todo type priority name tags contents\) +\"Format an inline task element for LaTeX export.\" + \(let ((full-title + \(concat + \(when todo + \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo)) + \(when priority (format \"\\\\framebox{\\\\#%c} \" priority)) + title + \(when tags + \(format \"\\\\hfill{}\\\\textsc{:%s:}\" + \(mapconcat 'identity tags \":\"))))) + \(format (concat \"\\\\begin{center}\\n\" + \"\\\\fbox{\\n\" + \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\" + \"%s\\n\\n\" + \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\" + \"%s\" + \"\\\\end{minipage}}\" + \"\\\\end{center}\") + full-title contents))" + :group 'org-export-latex + :type 'function) + + +;; Src blocks + +(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 +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\")) + +Alternatively, + + \(setq org-latex-listings 'minted) + +causes source code to be exported using the minted package as +opposed to listings. If you want to use minted, you need to add +the minted package to `org-latex-packages-alist', for example +using customize, or with + + \(require 'ox-latex) + \(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." + :group 'org-export-latex + :type '(choice + (const :tag "Use listings" t) + (const :tag "Use minted" 'minted) + (const :tag "Export verbatim" nil))) + +(defcustom org-latex-listings-langs + '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp") + (c "C") (cc "C++") + (fortran "fortran") + (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby") + (html "HTML") (xml "XML") + (tex "TeX") (latex "TeX") + (shell-script "bash") + (gnuplot "Gnuplot") + (ocaml "Caml") (caml "Caml") + (sql "SQL") (sqlite "sql")) + "Alist mapping languages to their listing language counterpart. +The key is a symbol, the major mode symbol without the \"-mode\". +The value is the string that should be inserted as the language +parameter for the listings package. If the mode name and the +listings name are the same, the language does not need an entry +in this list - but it does not hurt if it is present." + :group 'org-export-latex + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Listings language")))) + +(defcustom org-latex-listings-options nil + "Association list of options for the latex listings package. + +These options are supplied as a comma-separated list to the +\\lstset command. Each element of the association list should be +a list containing two strings: the name of the option, and the +value. For example, + + (setq org-latex-listings-options + '((\"basicstyle\" \"\\small\") + (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\"))) + +will typeset the code in a small size font with underlined, bold +black keywords. + +Note that the same options will be applied to blocks of all +languages." + :group 'org-export-latex + :type '(repeat + (list + (string :tag "Listings option name ") + (string :tag "Listings option value")))) + +(defcustom org-latex-minted-langs + '((emacs-lisp "common-lisp") + (cc "c++") + (cperl "perl") + (shell-script "bash") + (caml "ocaml")) + "Alist mapping languages to their minted language counterpart. +The key is a symbol, the major mode symbol without the \"-mode\". +The value is the string that should be inserted as the language +parameter for the minted package. If the mode name and the +listings name are the same, the language does not need an entry +in this list - but it does not hurt if it is present. + +Note that minted uses all lower case for language identifiers, +and that the full list of language identifiers can be obtained +with: + + pygmentize -L lexers" + :group 'org-export-latex + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Minted language")))) + +(defcustom org-latex-minted-options nil + "Association list of options for the latex minted package. + +These options are supplied within square brackets in +\\begin{minted} environments. Each element of the alist should +be a list containing two strings: the name of the option, and the +value. For example, + + \(setq org-latex-minted-options + '\((\"bgcolor\" \"bg\") \(\"frame\" \"lines\"))) + +will result in src blocks being exported with + +\\begin{minted}[bgcolor=bg,frame=lines]{} + +as the start of the minted environment. Note that the same +options will be applied to blocks of all languages." + :group 'org-export-latex + :type '(repeat + (list + (string :tag "Minted option name ") + (string :tag "Minted option value")))) + +(defcustom org-latex-long-listings nil + "When non-nil no listing will be wrapped within a float. + +Removing floats may break some functionalities. For example, it +will be impossible to use cross-references to listings when using +`minted' set-up when this variable is non-nil. + +This value can be locally ignored with \":long-listing t\" and +\":long-listing nil\" LaTeX attributes." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defvar org-latex-custom-lang-environments nil + "Alist mapping languages to language-specific LaTeX environments. + +It is used during export of src blocks by the listings and minted +latex packages. For example, + + \(setq org-latex-custom-lang-environments + '\(\(python \"pythoncode\"\)\)\) + +would have the effect that if org encounters begin_src python +during latex export it will output + + \\begin{pythoncode} + + \\end{pythoncode}") + + +;;;; Compilation + +(defcustom org-latex-pdf-process + '("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f") + "Commands to process a LaTeX file to a PDF file. +This is a list of strings, each of them will be given to the +shell as a command. %f in the command will be replaced by the +full file name, %b by the file base name (i.e. without directory +and extension parts) and %o by the base directory of the file. + +The reason why this is a list is that it usually takes several +runs of `pdflatex', maybe mixed with a call to `bibtex'. Org +does not have a clever mechanism to detect which of these +commands have to be run to get to a stable result, and it also +does not do any error checking. + +By default, Org uses 3 runs of `pdflatex' to do the processing. +If you have texi2dvi on your system and if that does not cause +the infamous egrep/locale bug: + + http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html + +then `texi2dvi' is the superior choice. Org does offer it as one +of the customize options. + +Alternatively, this may be a Lisp function that does the +processing, so you could use this to apply the machinery of +AUCTeX or the Emacs LaTeX mode. This function should accept the +file name as its single argument." + :group 'org-export-pdf + :type '(choice + (repeat :tag "Shell command sequence" + (string :tag "Shell command")) + (const :tag "2 runs of pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "3 runs of pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "pdflatex,bibtex,pdflatex,pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "bibtex %b" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "2 runs of xelatex" + ("xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "3 runs of xelatex" + ("xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "xelatex,bibtex,xelatex,xelatex" + ("xelatex -interaction nonstopmode -output-directory %o %f" + "bibtex %b" + "xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "texi2dvi" + ("texi2dvi -p -b -c -V %f")) + (const :tag "rubber" + ("rubber -d --into %o %f")) + (function))) + +(defcustom org-latex-logfiles-extensions + '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") + "The list of file extensions to consider as LaTeX logfiles. +The logfiles will be remove if `org-latex-remove-logfiles' is +non-nil." + :group 'org-export-latex + :type '(repeat (string :tag "Extension"))) + +(defcustom org-latex-remove-logfiles t + "Non-nil means remove the logfiles produced by PDF production. +By default, logfiles are files with these extensions: .aux, .idx, +.log, .out, .toc, .nav, .snm and .vrb. To define the set of +logfiles to remove, set `org-latex-logfiles-extensions'." + :group 'org-export-latex + :type 'boolean) + +(defcustom org-latex-known-errors + '(("Reference.*?undefined" . "[undefined reference]") + ("Citation.*?undefined" . "[undefined citation]") + ("Undefined control sequence" . "[undefined control sequence]") + ("^! LaTeX.*?Error" . "[LaTeX error]") + ("^! Package.*?Error" . "[package error]") + ("Runaway argument" . "Runaway argument")) + "Alist of regular expressions and associated messages for the user. +The regular expressions are used to find possible errors in the +log of a latex-run." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat + (cons + (string :tag "Regexp") + (string :tag "Message")))) + + + +;;; Internal Functions + +(defun org-latex--caption/label-string (element info) + "Return caption and label LaTeX string for ELEMENT. + +INFO is a plist holding contextual information. If there's no +caption nor label, return the empty string. + +For non-floats, see `org-latex--wrap-label'." + (let* ((label (org-element-property :name element)) + (label-str (if (not (org-string-nw-p label)) "" + (format "\\label{%s}" + (org-export-solidify-link-text label)))) + (main (org-export-get-caption element)) + (short (org-export-get-caption element t))) + (cond + ((and (not main) (equal label-str "")) "") + ((not main) (concat label-str "\n")) + ;; Option caption format with short name. + (short (format "\\caption[%s]{%s%s}\n" + (org-export-data short info) + label-str + (org-export-data main info))) + ;; Standard caption format. + (t (format "\\caption{%s%s}\n" label-str (org-export-data main info)))))) + +(defun org-latex-guess-inputenc (header) + "Set the coding system in inputenc to what the buffer is. + +HEADER is the LaTeX header string. This function only applies +when specified inputenc option is \"AUTO\". + +Return the new header, as a string." + (let* ((cs (or (ignore-errors + (latexenc-coding-system-to-inputenc + (or org-export-coding-system buffer-file-coding-system))) + "utf8"))) + (if (not cs) header + ;; First translate if that is requested. + (setq cs (or (cdr (assoc cs org-latex-inputenc-alist)) cs)) + ;; Then find the \usepackage statement and replace the option. + (replace-regexp-in-string "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}" + cs header t nil 1)))) + +(defun org-latex-guess-babel-language (header info) + "Set Babel's language according to LANGUAGE keyword. + +HEADER is the LaTeX header string. INFO is the plist used as +a communication channel. + +Insertion of guessed language only happens when Babel package has +explicitly been loaded. Then it is added to the rest of +package's options. + +Return the new header." + (let ((language-code (plist-get info :language))) + ;; If no language is set or Babel package is not loaded, return + ;; HEADER as-is. + (if (or (not (stringp language-code)) + (not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header))) + header + (let ((options (save-match-data + (org-split-string (match-string 1 header) ","))) + (language (cdr (assoc language-code + org-latex-babel-language-alist)))) + ;; If LANGUAGE is already loaded, return header. Otherwise, + ;; append LANGUAGE to other options. + (if (member language options) header + (replace-match (mapconcat 'identity + (append options (list language)) + ",") + nil nil header 1)))))) + +(defun org-latex--find-verb-separator (s) + "Return a character not used in string S. +This is used to choose a separator for constructs like \\verb." + (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) + (loop for c across ll + when (not (string-match (regexp-quote (char-to-string c)) s)) + return (char-to-string c)))) + +(defun org-latex--make-option-string (options) + "Return a comma separated string of keywords and values. +OPTIONS is an alist where the key is the options keyword as +a string, and the value a list containing the keyword value, or +nil." + (mapconcat (lambda (pair) + (concat (first pair) + (when (> (length (second pair)) 0) + (concat "=" (second pair))))) + options + ",")) + +(defun org-latex--wrap-label (element output) + "Wrap label associated to ELEMENT around OUTPUT, if appropriate. +This function shouldn't be used for floats. See +`org-latex--caption/label-string'." + (let ((label (org-element-property :name element))) + (if (not (and (org-string-nw-p output) (org-string-nw-p label))) output + (concat (format "\\label{%s}\n" (org-export-solidify-link-text label)) + output)))) + +(defun org-latex--text-markup (text markup) + "Format TEXT depending on MARKUP text markup. +See `org-latex-text-markup-alist' for details." + (let ((fmt (cdr (assq markup org-latex-text-markup-alist)))) + (cond + ;; No format string: Return raw text. + ((not fmt) text) + ;; Handle the `verb' special case: Find and appropriate separator + ;; and use "\\verb" command. + ((eq 'verb fmt) + (let ((separator (org-latex--find-verb-separator text))) + (concat "\\verb" separator text separator))) + ;; Handle the `protectedtexttt' special case: Protect some + ;; special chars and use "\texttt{%s}" format string. + ((eq 'protectedtexttt fmt) + (let ((start 0) + (trans '(("\\" . "\\textbackslash{}") + ("~" . "\\textasciitilde{}") + ("^" . "\\textasciicircum{}"))) + (rtn "") + char) + (while (string-match "[\\{}$%&_#~^]" text) + (setq char (match-string 0 text)) + (if (> (match-beginning 0) 0) + (setq rtn (concat rtn (substring text 0 (match-beginning 0))))) + (setq text (substring text (1+ (match-beginning 0)))) + (setq char (or (cdr (assoc char trans)) (concat "\\" char)) + rtn (concat rtn char))) + (setq text (concat rtn text) + fmt "\\texttt{%s}") + (while (string-match "--" text) + (setq text (replace-match "-{}-" t t text))) + (format fmt text))) + ;; Else use format string. + (t (format fmt text))))) + +(defun org-latex--delayed-footnotes-definitions (element info) + "Return footnotes definitions in ELEMENT as a string. + +INFO is a plist used as a communication channel. + +Footnotes definitions are returned within \"\\footnotetxt{}\" +commands. + +This function is used within constructs that don't support +\"\\footnote{}\" command (i.e. an item's tag). In that case, +\"\\footnotemark\" is used within the construct and the function +just outside of it." + (mapconcat + (lambda (ref) + (format + "\\footnotetext[%s]{%s}" + (org-export-get-footnote-number ref info) + (org-trim + (org-export-data + (org-export-get-footnote-definition ref info) info)))) + ;; Find every footnote reference in ELEMENT. + (let* (all-refs + search-refs ; For byte-compiler. + (search-refs + (function + (lambda (data) + ;; Return a list of all footnote references never seen + ;; before in DATA. + (org-element-map data 'footnote-reference + (lambda (ref) + (when (org-export-footnote-first-reference-p ref info) + (push ref all-refs) + (when (eq (org-element-property :type ref) 'standard) + (funcall search-refs + (org-export-get-footnote-definition ref info))))) + info) + (reverse all-refs))))) + (funcall search-refs element)) + "")) + + + +;;; Template + +(defun org-latex-template (contents info) + "Return complete document string after LaTeX conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (let ((title (org-export-data (plist-get info :title) info))) + (concat + ;; Time-stamp. + (and (plist-get info :time-stamp-file) + (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) + ;; Document class and packages. + (let ((class (plist-get info :latex-class)) + (class-options (plist-get info :latex-class-options))) + (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))))) + ;; Possibly limit depth for headline numbering. + (let ((sec-num (plist-get info :section-numbers))) + (when (integerp sec-num) + (format "\\setcounter{secnumdepth}{%d}\n" sec-num))) + ;; Author. + (let ((author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (and (plist-get info :with-email) + (org-export-data (plist-get info :email) info)))) + (cond ((and author email (not (string= "" email))) + (format "\\author{%s\\thanks{%s}}\n" author email)) + ((or author email) (format "\\author{%s}\n" (or author email))))) + ;; Date. + (let ((date (and (plist-get info :with-date) (org-export-get-date info)))) + (format "\\date{%s}\n" (org-export-data date info))) + ;; Title + (format "\\title{%s}\n" title) + ;; Hyperref options. + (when (plist-get info :latex-hyperref-p) + (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" + (or (plist-get info :keywords) "") + (or (plist-get info :description) "") + (if (not (plist-get info :with-creator)) "" + (plist-get info :creator)))) + ;; Document start. + "\\begin{document}\n\n" + ;; Title command. + (org-element-normalize-string + (cond ((string= "" title) nil) + ((not (stringp org-latex-title-command)) nil) + ((string-match "\\(?:[^%]\\|^\\)%s" + org-latex-title-command) + (format org-latex-title-command title)) + (t org-latex-title-command))) + ;; Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth + (concat (when (wholenump depth) + (format "\\setcounter{tocdepth}{%d}\n" depth)) + org-latex-toc-command))) + ;; Document's body. + contents + ;; Creator. + (let ((creator-info (plist-get info :with-creator))) + (cond + ((not creator-info) "") + ((eq creator-info 'comment) + (format "%% %s\n" (plist-get info :creator))) + (t (concat (plist-get info :creator) "\n")))) + ;; Document end. + "\\end{document}"))) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-latex-bold (bold contents info) + "Transcode BOLD from Org to LaTeX. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (org-latex--text-markup contents 'bold)) + + +;;;; Center Block + +(defun org-latex-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the center block. INFO is a plist +holding contextual information." + (org-latex--wrap-label + center-block + (format "\\begin{center}\n%s\\end{center}" contents))) + + +;;;; Clock + +(defun org-latex-clock (clock contents info) + "Transcode a CLOCK element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat + "\\noindent" + (format "\\textbf{%s} " org-clock-string) + (format org-latex-inactive-timestamp-format + (concat (org-translate-time + (org-element-property :raw-value + (org-element-property :value clock))) + (let ((time (org-element-property :duration clock))) + (and time (format " (%s)" time))))) + "\\\\")) + + +;;;; Code + +(defun org-latex-code (code contents info) + "Transcode a CODE object from Org to LaTeX. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (org-latex--text-markup (org-element-property :value code) 'code)) + + +;;;; Drawer + +(defun org-latex-drawer (drawer contents info) + "Transcode a DRAWER element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((name (org-element-property :drawer-name drawer)) + (output (if (functionp org-latex-format-drawer-function) + (funcall org-latex-format-drawer-function + name contents) + ;; If there's no user defined function: simply + ;; display contents of the drawer. + contents))) + (org-latex--wrap-label drawer output))) + + +;;;; Dynamic Block + +(defun org-latex-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + (org-latex--wrap-label dynamic-block contents)) + + +;;;; Entity + +(defun org-latex-entity (entity contents info) + "Transcode an ENTITY object from Org to LaTeX. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (let ((ent (org-element-property :latex entity))) + (if (org-element-property :latex-math-p entity) (format "$%s$" ent) ent))) + + +;;;; Example Block + +(defun org-latex-example-block (example-block contents info) + "Transcode an EXAMPLE-BLOCK element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (when (org-string-nw-p (org-element-property :value example-block)) + (org-latex--wrap-label + example-block + (format "\\begin{verbatim}\n%s\\end{verbatim}" + (org-export-format-code-default example-block info))))) + + +;;;; Export Block + +(defun org-latex-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (member (org-element-property :type export-block) '("LATEX" "TEX")) + (org-remove-indentation (org-element-property :value export-block)))) + + +;;;; Export Snippet + +(defun org-latex-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'latex) + (org-element-property :value export-snippet))) + + +;;;; Fixed Width + +(defun org-latex-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-latex--wrap-label + fixed-width + (format "\\begin{verbatim}\n%s\\end{verbatim}" + (org-remove-indentation + (org-element-property :value fixed-width))))) + + +;;;; Footnote Reference +;; +;; Footnote reference export is handled by +;; `org-latex-footnote-reference'. +;; +;; Internally, `org-latex--get-footnote-counter' is used to restore +;; the value of the LaTeX "footnote" counter after a jump due to +;; a reference to an already defined footnote. It is only needed in +;; item tags since the optional argument to \footnotemark is not +;; allowed there. + +(defun org-latex--get-footnote-counter (footnote-reference info) + "Return \"footnote\" counter before FOOTNOTE-REFERENCE is encountered. +INFO is a plist used as a communication channel." + ;; Find original counter value by counting number of footnote + ;; references appearing for the first time before the current + ;; footnote reference. + (let* ((label (org-element-property :label footnote-reference)) + seen-refs + search-ref ; For byte-compiler. + (search-ref + (function + (lambda (data) + ;; Search footnote references through DATA, filling + ;; SEEN-REFS along the way. + (org-element-map data 'footnote-reference + (lambda (fn) + (let ((fn-lbl (org-element-property :label fn))) + (cond + ;; Anonymous footnote match: return number. + ((eq fn footnote-reference) (length seen-refs)) + ;; Anonymous footnote: it's always a new one. + ;; Also, be sure to return nil from the `cond' so + ;; `first-match' doesn't get us out of the loop. + ((not fn-lbl) (push 'inline seen-refs) nil) + ;; Label not seen so far: add it so SEEN-REFS. + ;; + ;; Also search for subsequent references in + ;; footnote definition so numbering follows + ;; reading logic. Note that we don't care about + ;; inline definitions, since `org-element-map' + ;; already traverses them at the right time. + ((not (member fn-lbl seen-refs)) + (push fn-lbl seen-refs) + (funcall search-ref + (org-export-get-footnote-definition fn info)))))) + ;; Don't enter footnote definitions since it will + ;; happen when their first reference is found. + info 'first-match 'footnote-definition))))) + (funcall search-ref (plist-get info :parse-tree)))) + +(defun org-latex-footnote-reference (footnote-reference contents info) + "Transcode a FOOTNOTE-REFERENCE element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (concat + ;; Insert separator between two footnotes in a row. + (let ((prev (org-export-get-previous-element footnote-reference info))) + (when (eq (org-element-type prev) 'footnote-reference) + org-latex-footnote-separator)) + (cond + ;; Use \footnotemark if reference is within an item's tag. + ((eq (org-element-type (org-export-get-parent-element footnote-reference)) + 'item) + (if (org-export-footnote-first-reference-p footnote-reference info) + "\\footnotemark" + ;; Since we can't specify footnote number as an optional + ;; argument within an item tag, some extra work has to be done + ;; when the footnote has already been referenced. In that + ;; case, set footnote counter to the desired number, use the + ;; footnotemark, then set counter back to its original value. + (format + "\\setcounter{footnote}{%s}\\footnotemark\\setcounter{footnote}{%s}" + (1- (org-export-get-footnote-number footnote-reference info)) + (org-latex--get-footnote-counter footnote-reference info)))) + ;; Use \footnotemark if the footnote has already been defined. + ((not (org-export-footnote-first-reference-p footnote-reference info)) + (format "\\footnotemark[%s]{}" + (org-export-get-footnote-number footnote-reference info))) + ;; Use \footnotemark if reference is within another footnote + ;; reference, footnote definition or table cell. + ((loop for parent in (org-export-get-genealogy footnote-reference) + thereis (memq (org-element-type parent) + '(footnote-reference footnote-definition table-cell))) + "\\footnotemark") + ;; Otherwise, define it with \footnote command. + (t + (let ((def (org-export-get-footnote-definition footnote-reference info))) + (concat + (format "\\footnote{%s}" (org-trim (org-export-data def info))) + ;; Retrieve all footnote references within the footnote and + ;; add their definition after it, since LaTeX doesn't support + ;; them inside. + (org-latex--delayed-footnotes-definitions def info))))))) + + +;;;; Headline + +(defun org-latex-headline (headline contents info) + "Transcode a HEADLINE element from Org to LaTeX. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (unless (org-element-property :footnote-section-p headline) + (let* ((class (plist-get info :latex-class)) + (level (org-export-get-relative-level headline info)) + (numberedp (org-export-numbered-headline-p headline info)) + (class-sectionning (assoc class org-latex-classes)) + ;; Section formatting will set two placeholders: one for + ;; the title and the other for the contents. + (section-fmt + (let ((sec (if (functionp (nth 2 class-sectionning)) + (funcall (nth 2 class-sectionning) level numberedp) + (nth (1+ level) class-sectionning)))) + (cond + ;; No section available for that LEVEL. + ((not sec) nil) + ;; Section format directly returned by a function. Add + ;; placeholder for contents. + ((stringp sec) (concat sec "\n%s")) + ;; (numbered-section . unnumbered-section) + ((not (consp (cdr sec))) + (concat (funcall (if numberedp #'car #'cdr) sec) "\n%s")) + ;; (numbered-open numbered-close) + ((= (length sec) 2) + (when numberedp (concat (car sec) "\n%s" (nth 1 sec)))) + ;; (num-in num-out no-num-in no-num-out) + ((= (length sec) 4) + (if numberedp (concat (car sec) "\n%s" (nth 1 sec)) + (concat (nth 2 sec) "\n%s" (nth 3 sec))))))) + (text (org-export-data (org-element-property :title headline) info)) + (todo + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + ;; Create the headline text along with a no-tag version. + ;; The latter is required to remove tags from toc. + (full-text (funcall org-latex-format-headline-function + todo todo-type priority text tags)) + ;; Associate \label to the headline for internal links. + (headline-label + (format "\\label{sec-%s}\n" + (mapconcat 'number-to-string + (org-export-get-headline-number headline info) + "-"))) + (pre-blanks + (make-string (org-element-property :pre-blank headline) 10))) + (if (or (not section-fmt) (org-export-low-level-p headline info)) + ;; This is a deep sub-tree: export it as a list item. Also + ;; export as items headlines for which no section format has + ;; been found. + (let ((low-level-body + (concat + ;; If headline is the first sibling, start a list. + (when (org-export-first-sibling-p headline info) + (format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize))) + ;; Itemize headline + "\\item " full-text "\n" headline-label pre-blanks contents))) + ;; If headline is not the last sibling simply return + ;; LOW-LEVEL-BODY. Otherwise, also close the list, before + ;; any blank line. + (if (not (org-export-last-sibling-p headline info)) low-level-body + (replace-regexp-in-string + "[ \t\n]*\\'" + (format "\n\\\\end{%s}" (if numberedp 'enumerate 'itemize)) + low-level-body))) + ;; This is a standard headline. Export it as a section. Add + ;; an alternative heading when possible. + (let ((opt-title + (funcall org-latex-format-headline-function + todo todo-type priority + (org-export-data + (org-export-get-alt-title headline info) info) + (and (eq (plist-get info :with-tags) t) tags)))) + (if (and numberedp opt-title + (string-match "\\`\\\\\\(.*?[^*]\\){" section-fmt)) + (format (replace-match "\\1[%s]" nil nil section-fmt 1) + ;; Replace square brackets with parenthesis + ;; since square brackets are not supported in + ;; optional arguments. + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string "\\]" ")" opt-title)) + full-text + (concat headline-label pre-blanks contents)) + ;; Impossible to add an alternative heading. Fallback to + ;; regular sectioning format string. + (format section-fmt full-text + (concat headline-label pre-blanks contents)))))))) + +(defun org-latex-format-headline-default-function + (todo todo-type priority text tags) + "Default format function for a headline. +See `org-latex-format-headline-function' for details." + (concat + (and todo (format "{\\bfseries\\sffamily %s} " todo)) + (and priority (format "\\framebox{\\#%c} " priority)) + text + (and tags + (format "\\hfill{}\\textsc{%s}" (mapconcat 'identity tags ":"))))) + + +;;;; Horizontal Rule + +(defun org-latex-horizontal-rule (horizontal-rule contents info) + "Transcode an HORIZONTAL-RULE object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((attr (org-export-read-attribute :attr_latex horizontal-rule)) + (prev (org-export-get-previous-element horizontal-rule info))) + (concat + ;; Make sure the rule doesn't start at the end of the current + ;; line by separating it with a blank line from previous element. + (when (and prev + (let ((prev-blank (org-element-property :post-blank prev))) + (or (not prev-blank) (zerop prev-blank)))) + "\n") + (org-latex--wrap-label + horizontal-rule + (format "\\rule{%s}{%s}" + (or (plist-get attr :width) "\\linewidth") + (or (plist-get attr :thickness) "0.5pt")))))) + + +;;;; Inline Src Block + +(defun org-latex-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((code (org-element-property :value inline-src-block)) + (separator (org-latex--find-verb-separator code))) + (cond + ;; Do not use a special package: transcode it verbatim. + ((not org-latex-listings) + (concat "\\verb" separator code separator)) + ;; Use minted package. + ((eq org-latex-listings 'minted) + (let* ((org-lang (org-element-property :language inline-src-block)) + (mint-lang (or (cadr (assq (intern org-lang) + org-latex-minted-langs)) + org-lang)) + (options (org-latex--make-option-string + org-latex-minted-options))) + (concat (format "\\mint%s{%s}" + (if (string= options "") "" (format "[%s]" options)) + mint-lang) + separator code separator))) + ;; Use listings package. + (t + ;; Maybe translate language's name. + (let* ((org-lang (org-element-property :language inline-src-block)) + (lst-lang (or (cadr (assq (intern org-lang) + org-latex-listings-langs)) + org-lang)) + (options (org-latex--make-option-string + (append org-latex-listings-options + `(("language" ,lst-lang)))))) + (concat (format "\\lstinline[%s]" options) + separator code separator)))))) + + +;;;; Inlinetask + +(defun org-latex-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((title (org-export-data (org-element-property :title inlinetask) info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword inlinetask))) + (and todo (org-export-data todo info))))) + (todo-type (org-element-property :todo-type inlinetask)) + (tags (and (plist-get info :with-tags) + (org-export-get-tags inlinetask info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority inlinetask)))) + ;; If `org-latex-format-inlinetask-function' is provided, call it + ;; with appropriate arguments. + (if (functionp org-latex-format-inlinetask-function) + (funcall org-latex-format-inlinetask-function + todo todo-type priority title tags contents) + ;; Otherwise, use a default template. + (org-latex--wrap-label + inlinetask + (let ((full-title + (concat + (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo)) + (when priority (format "\\framebox{\\#%c} " priority)) + title + (when tags (format "\\hfill{}\\textsc{:%s:}" + (mapconcat 'identity tags ":")))))) + (format (concat "\\begin{center}\n" + "\\fbox{\n" + "\\begin{minipage}[c]{.6\\textwidth}\n" + "%s\n\n" + "\\rule[.8em]{\\textwidth}{2pt}\n\n" + "%s" + "\\end{minipage}\n" + "}\n" + "\\end{center}") + full-title contents)))))) + + +;;;; Italic + +(defun org-latex-italic (italic contents info) + "Transcode ITALIC from Org to LaTeX. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (org-latex--text-markup contents 'italic)) + + +;;;; Item + +(defun org-latex-item (item contents info) + "Transcode an ITEM element from Org to LaTeX. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((counter + (let ((count (org-element-property :counter item)) + (level + ;; Determine level of current item to determine the + ;; correct LaTeX counter to use (enumi, enumii...). + (let ((parent item) (level 0)) + (while (memq (org-element-type + (setq parent (org-export-get-parent parent))) + '(plain-list item)) + (when (and (eq (org-element-type parent) 'plain-list) + (eq (org-element-property :type parent) + 'ordered)) + (incf level))) + level))) + (and count + (< level 5) + (format "\\setcounter{enum%s}{%s}\n" + (nth (1- level) '("i" "ii" "iii" "iv")) + (1- count))))) + (checkbox (case (org-element-property :checkbox item) + (on "$\\boxtimes$ ") + (off "$\\Box$ ") + (trans "$\\boxminus$ "))) + (tag (let ((tag (org-element-property :tag item))) + ;; Check-boxes must belong to the tag. + (and tag (format "[%s] " + (concat checkbox + (org-export-data tag info))))))) + (concat counter "\\item" (or tag (concat " " checkbox)) + (and contents (org-trim contents)) + ;; If there are footnotes references in tag, be sure to + ;; add their definition at the end of the item. This + ;; workaround is necessary since "\footnote{}" command is + ;; not supported in tags. + (and tag + (org-latex--delayed-footnotes-definitions + (org-element-property :tag item) info))))) + + +;;;; Keyword + +(defun org-latex-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "LATEX") value) + ((string= key "INDEX") (format "\\index{%s}" value)) + ((string= key "TOC") + (let ((value (downcase value))) + (cond + ((string-match "\\" value) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc)))) + (concat + (when (wholenump depth) + (format "\\setcounter{tocdepth}{%s}\n" depth)) + "\\tableofcontents"))) + ((string= "tables" value) "\\listoftables") + ((string= "listings" value) + (cond + ((eq org-latex-listings 'minted) "\\listoflistings") + (org-latex-listings "\\lstlistoflistings") + ;; At the moment, src blocks with a caption are wrapped + ;; into a figure environment. + (t "\\listoffigures"))))))))) + + +;;;; Latex Environment + +(defun org-latex-latex-environment (latex-environment contents info) + "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (plist-get info :with-latex) + (let ((label (org-element-property :name latex-environment)) + (value (org-remove-indentation + (org-element-property :value latex-environment)))) + (if (not (org-string-nw-p label)) value + ;; Environment is labelled: label must be within the environment + ;; (otherwise, a reference pointing to that element will count + ;; the section instead). + (with-temp-buffer + (insert value) + (goto-char (point-min)) + (forward-line) + (insert + (format "\\label{%s}\n" (org-export-solidify-link-text label))) + (buffer-string)))))) + + +;;;; Latex Fragment + +(defun org-latex-latex-fragment (latex-fragment contents info) + "Transcode a LATEX-FRAGMENT object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (plist-get info :with-latex) + (org-element-property :value latex-fragment))) + + +;;;; Line Break + +(defun org-latex-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + "\\\\\n") + + +;;;; Link + +(defun org-latex--inline-image (link info) + "Return LaTeX code for an inline image. +LINK is the link pointing to the inline image. INFO is a plist +used as a communication channel." + (let* ((parent (org-export-get-parent-element link)) + (path (let ((raw-path (org-element-property :path link))) + (if (not (file-name-absolute-p raw-path)) raw-path + (expand-file-name raw-path)))) + (filetype (file-name-extension path)) + (caption (org-latex--caption/label-string parent info)) + ;; Retrieve latex attributes from the element around. + (attr (org-export-read-attribute :attr_latex parent)) + (float (let ((float (plist-get attr :float))) + (cond ((string= float "wrap") 'wrap) + ((string= float "multicolumn") 'multicolumn) + ((or (string= float "figure") + (org-element-property :caption parent)) + 'figure)))) + (placement + (let ((place (plist-get attr :placement))) + (cond (place (format "%s" place)) + ((eq float 'wrap) "{l}{0.5\\textwidth}") + ((eq float 'figure) + (format "[%s]" org-latex-default-figure-position)) + (t "")))) + (comment-include (if (plist-get attr :comment-include) "%" "")) + ;; It is possible to specify width and height in the + ;; ATTR_LATEX line, and also via default variables. + (width (cond ((plist-get attr :width)) + ((plist-get attr :height) "") + ((eq float 'wrap) "0.48\\textwidth") + (t org-latex-image-default-width))) + (height (cond ((plist-get attr :height)) + ((or (plist-get attr :width) + (memq float '(figure wrap))) "") + (t org-latex-image-default-height))) + (options (let ((opt (or (plist-get attr :options) + org-latex-image-default-option))) + (if (not (string-match "\\`\\[\\(.*\\)\\]\\'" opt)) opt + (match-string 1 opt)))) + image-code) + (if (equal filetype "tikz") + ;; For tikz images: + ;; - use \input to read in image file. + ;; - if options are present, wrap in a tikzpicture environment. + ;; - if width or height are present, use \resizebox to change + ;; the image size. + (progn + (setq image-code (format "\\input{%s}" path)) + (when (org-string-nw-p options) + (setq image-code + (format "\\begin{tikzpicture}[%s]\n%s\n\\end{tikzpicture}" + options + image-code))) + (when (or (org-string-nw-p width) (org-string-nw-p height)) + (setq image-code (format "\\resizebox{%s}{%s}{%s}" + (if (org-string-nw-p width) width "!") + (if (org-string-nw-p height) height "!") + image-code)))) + ;; For other images: + ;; - add width and height to options. + ;; - include the image with \includegraphics. + (when (org-string-nw-p width) + (setq options (concat options ",width=" width))) + (when (org-string-nw-p height) + (setq options (concat options ",height=" height))) + (setq image-code + (format "\\includegraphics%s{%s}" + (cond ((not (org-string-nw-p options)) "") + ((= (aref options 0) ?,) + (format "[%s]"(substring options 1))) + (t (format "[%s]" options))) + path))) + ;; Return proper string, depending on FLOAT. + (case float + (wrap (format "\\begin{wrapfigure}%s +\\centering +%s%s +%s\\end{wrapfigure}" placement comment-include image-code caption)) + (multicolumn (format "\\begin{figure*}%s +\\centering +%s%s +%s\\end{figure*}" placement comment-include image-code caption)) + (figure (format "\\begin{figure}%s +\\centering +%s%s +%s\\end{figure}" placement comment-include image-code caption)) + (otherwise image-code)))) + +(defun org-latex-link (link desc info) + "Transcode a LINK object from Org to LaTeX. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (and (not (string= desc "")) desc)) + (imagep (org-export-inline-image-p + link org-latex-inline-image-rules)) + (path (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((string= type "file") + (if (not (file-name-absolute-p raw-path)) raw-path + (concat "file://" (expand-file-name raw-path)))) + (t raw-path))) + protocol) + (cond + ;; Image file. + (imagep (org-latex--inline-image link info)) + ;; Radio link: Transcode target's contents and use them as link's + ;; description. + ((string= type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (when destination + (format "\\hyperref[%s]{%s}" + (org-export-solidify-link-text path) + (org-export-data (org-element-contents destination) info))))) + ;; 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)))) + (case (org-element-type destination) + ;; Id link points to an external file. + (plain-text + (if desc (format "\\href{%s}{%s}" destination desc) + (format "\\url{%s}" destination))) + ;; Fuzzy link points nowhere. + ('nil + (format org-latex-link-with-unknown-path-format + (or desc + (org-export-data + (org-element-property :raw-link link) info)))) + ;; LINK points to a headline. If headlines are numbered + ;; and the link has no description, display headline's + ;; number. Otherwise, display description or headline's + ;; title. + (headline + (let ((label + (format "sec-%s" + (mapconcat + 'number-to-string + (org-export-get-headline-number destination info) + "-")))) + (if (and (plist-get info :section-numbers) (not desc)) + (format "\\ref{%s}" label) + (format "\\hyperref[%s]{%s}" label + (or desc + (org-export-data + (org-element-property :title destination) info)))))) + ;; Fuzzy link points to a target. Do as above. + (otherwise + (let ((path (org-export-solidify-link-text path))) + (if (not desc) (format "\\ref{%s}" path) + (format "\\hyperref[%s]{%s}" path desc))))))) + ;; Coderef: replace link with the reference name or the + ;; equivalent line number. + ((string= type "coderef") + (format (org-export-get-coderef-format path desc) + (org-export-resolve-coderef path info))) + ;; Link type is handled by a special function. + ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) + (funcall protocol (org-link-unescape path) desc 'latex)) + ;; External link with a description part. + ((and path desc) (format "\\href{%s}{%s}" path desc)) + ;; External link without a description part. + (path (format "\\url{%s}" path)) + ;; No path, only description. Try to do something useful. + (t (format org-latex-link-with-unknown-path-format desc))))) + + +;;;; Paragraph + +(defun org-latex-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to LaTeX. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + contents) + + +;;;; Plain List + +(defun org-latex-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to LaTeX. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (let* ((type (org-element-property :type plain-list)) + (attr (org-export-read-attribute :attr_latex plain-list)) + (latex-type (let ((env (plist-get attr :environment))) + (cond (env (format "%s" env)) + ((eq type 'ordered) "enumerate") + ((eq type 'unordered) "itemize") + ((eq type 'descriptive) "description"))))) + (org-latex--wrap-label + plain-list + (format "\\begin{%s}%s\n%s\\end{%s}" + latex-type + ;; Put optional arguments, if any inside square brackets + ;; when necessary. + (let ((options (format "%s" (or (plist-get attr :options) "")))) + (cond ((equal options "") "") + ((string-match "\\`\\[.*\\]\\'" options) options) + (t (format "[%s]" options)))) + contents + latex-type)))) + + +;;;; Plain Text + +(defun org-latex-plain-text (text info) + "Transcode a TEXT string from Org to LaTeX. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (let ((specialp (plist-get info :with-special-strings)) + (output text)) + ;; Protect %, #, &, $, ^, _, { and }. + (while (string-match "\\([^\\]\\|^\\)\\([%$#&{}^_]\\)" output) + (setq output + (replace-match + (format "\\%s" (match-string 2 output)) nil t output 2))) + ;; Protect \. If special strings are used, be careful not to + ;; protect "\" in "\-" constructs. + (let ((symbols (if specialp "-%$#&{}^_\\" "%$#&{}^_\\"))) + (setq output + (replace-regexp-in-string + (format "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%s]\\|$\\)" symbols) + "$\\backslash$" output nil t 1))) + ;; Protect ~. + (setq output + (replace-regexp-in-string + "\\([^\\]\\|^\\)\\(~\\)" "\\textasciitilde{}" output nil t 2)) + ;; Activate smart quotes. Be sure to provide original TEXT string + ;; since OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :latex info text))) + ;; LaTeX into \LaTeX{} and TeX into \TeX{}. + (let ((case-fold-search nil) + (start 0)) + (while (string-match "\\<\\(\\(?:La\\)?TeX\\)\\>" output start) + (setq output (replace-match + (format "\\%s{}" (match-string 1 output)) nil t output) + start (match-end 0)))) + ;; Convert special strings. + (when specialp + (setq output + (replace-regexp-in-string "\\.\\.\\." "\\ldots{}" output nil t))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" output))) + ;; Return value. + output)) + + +;;;; Planning + +(defun org-latex-planning (planning contents info) + "Transcode a PLANNING element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat + "\\noindent" + (mapconcat + 'identity + (delq nil + (list + (let ((closed (org-element-property :closed planning))) + (when closed + (concat + (format "\\textbf{%s} " org-closed-string) + (format org-latex-inactive-timestamp-format + (org-translate-time + (org-element-property :raw-value closed)))))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat + (format "\\textbf{%s} " org-deadline-string) + (format org-latex-active-timestamp-format + (org-translate-time + (org-element-property :raw-value deadline)))))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat + (format "\\textbf{%s} " org-scheduled-string) + (format org-latex-active-timestamp-format + (org-translate-time + (org-element-property :raw-value scheduled)))))))) + " ") + "\\\\")) + + +;;;; Quote Block + +(defun org-latex-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (org-latex--wrap-label + quote-block + (format "\\begin{quote}\n%s\\end{quote}" contents))) + + +;;;; Quote Section + +(defun org-latex-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (format "\\begin{verbatim}\n%s\\end{verbatim}" value)))) + + +;;;; Radio Target + +(defun org-latex-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to LaTeX. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (format "\\label{%s}%s" + (org-export-solidify-link-text + (org-element-property :value radio-target)) + text)) + + +;;;; Section + +(defun org-latex-section (section contents info) + "Transcode a SECTION element from Org to LaTeX. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + contents) + + +;;;; Special Block + +(defun org-latex-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((type (downcase (org-element-property :type special-block))) + (opt (org-export-read-attribute :attr_latex special-block :options))) + (concat (format "\\begin{%s}%s\n" type (or opt "")) + ;; Insert any label or caption within the block + ;; (otherwise, a reference pointing to that element will + ;; count the section instead). + (org-latex--caption/label-string special-block info) + contents + (format "\\end{%s}" type)))) + + +;;;; Src Block + +(defun org-latex-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (when (org-string-nw-p (org-element-property :value src-block)) + (let* ((lang (org-element-property :language src-block)) + (caption (org-element-property :caption src-block)) + (label (org-element-property :name src-block)) + (custom-env (and lang + (cadr (assq (intern lang) + org-latex-custom-lang-environments)))) + (num-start (case (org-element-property :number-lines src-block) + (continued (org-export-get-loc src-block info)) + (new 0))) + (retain-labels (org-element-property :retain-labels src-block)) + (long-listing + (let ((attr (org-export-read-attribute :attr_latex src-block))) + (if (plist-member attr :long-listing) + (plist-get attr :long-listing) + org-latex-long-listings)))) + (cond + ;; Case 1. No source fontification. + ((not org-latex-listings) + (let* ((caption-str (org-latex--caption/label-string src-block info)) + (float-env (and (not long-listing) + (or label caption) + (format "\\begin{figure}[H]\n%s%%s\n\\end{figure}" + caption-str)))) + (format + (or float-env "%s") + (concat (format "\\begin{verbatim}\n%s\\end{verbatim}" + (org-export-format-code-default src-block info)))))) + ;; Case 2. Custom environment. + (custom-env (format "\\begin{%s}\n%s\\end{%s}\n" + custom-env + (org-export-format-code-default src-block info) + custom-env)) + ;; Case 3. Use minted package. + ((eq org-latex-listings 'minted) + (let ((float-env + (and (not long-listing) + (or label caption) + (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}" + (org-latex--caption/label-string src-block info)))) + (body + (format + "\\begin{minted}[%s]{%s}\n%s\\end{minted}" + ;; Options. + (org-latex--make-option-string + (if (or (not num-start) + (assoc "linenos" org-latex-minted-options)) + org-latex-minted-options + (append `(("linenos") + ("firstnumber" ,(number-to-string (1+ num-start)))) + org-latex-minted-options))) + ;; Language. + (or (cadr (assq (intern lang) org-latex-minted-langs)) lang) + ;; Source code. + (let* ((code-info (org-export-unravel-code src-block)) + (max-width + (apply 'max + (mapcar 'length + (org-split-string (car code-info) + "\n"))))) + (org-export-format-code + (car code-info) + (lambda (loc num ref) + (concat + loc + (when ref + ;; Ensure references are flushed to the right, + ;; separated with 6 spaces from the widest line + ;; of code. + (concat (make-string (+ (- max-width (length loc)) 6) + ?\s) + (format "(%s)" ref))))) + nil (and retain-labels (cdr code-info))))))) + ;; Return value. + (if float-env (format float-env body) body))) + ;; Case 4. Use listings package. + (t + (let ((lst-lang + (or (cadr (assq (intern lang) org-latex-listings-langs)) lang)) + (caption-str + (when caption + (let ((main (org-export-get-caption src-block)) + (secondary (org-export-get-caption src-block t))) + (if (not secondary) + (format "{%s}" (org-export-data main info)) + (format "{[%s]%s}" + (org-export-data secondary info) + (org-export-data main info))))))) + (concat + ;; Options. + (format "\\lstset{%s}\n" + (org-latex--make-option-string + (append + org-latex-listings-options + `(("language" ,lst-lang)) + (when label `(("label" ,label))) + (when caption-str `(("caption" ,caption-str))) + (cond ((assoc "numbers" org-latex-listings-options) nil) + ((not num-start) '(("numbers" "none"))) + ((zerop num-start) '(("numbers" "left"))) + (t `(("numbers" "left") + ("firstnumber" + ,(number-to-string (1+ num-start))))))))) + ;; Source code. + (format + "\\begin{lstlisting}\n%s\\end{lstlisting}" + (let* ((code-info (org-export-unravel-code src-block)) + (max-width + (apply 'max + (mapcar 'length + (org-split-string (car code-info) "\n"))))) + (org-export-format-code + (car code-info) + (lambda (loc num ref) + (concat + loc + (when ref + ;; Ensure references are flushed to the right, + ;; separated with 6 spaces from the widest line of + ;; code + (concat (make-string (+ (- max-width (length loc)) 6) ? ) + (format "(%s)" ref))))) + nil (and retain-labels (cdr code-info)))))))))))) + + +;;;; Statistics Cookie + +(defun org-latex-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (replace-regexp-in-string + "%" "\\%" (org-element-property :value statistics-cookie) nil t)) + + +;;;; Strike-Through + +(defun org-latex-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to LaTeX. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (org-latex--text-markup contents 'strike-through)) + + +;;;; Subscript + +(defun org-latex--script-size (object info) + "Transcode a subscript or superscript object. +OBJECT is an Org object. INFO is a plist used as a communication +channel." + (let ((in-script-p + ;; Non-nil if object is already in a sub/superscript. + (let ((parent object)) + (catch 'exit + (while (setq parent (org-export-get-parent parent)) + (let ((type (org-element-type parent))) + (cond ((memq type '(subscript superscript)) + (throw 'exit t)) + ((memq type org-element-all-elements) + (throw 'exit nil)))))))) + (type (org-element-type object)) + (output "")) + (org-element-map (org-element-contents object) + (cons 'plain-text org-element-all-objects) + (lambda (obj) + (case (org-element-type obj) + ((entity latex-fragment) + (let ((data (org-trim (org-export-data obj info)))) + (string-match + "\\`\\(?:\\\\[([]\\|\\$+\\)?\\(.*?\\)\\(?:\\\\[])]\\|\\$+\\)?\\'" + data) + (setq output + (concat output + (match-string 1 data) + (let ((blank (org-element-property :post-blank obj))) + (and blank (> blank 0) "\\ ")))))) + (plain-text + (setq output + (format "%s\\text{%s}" output (org-export-data obj info)))) + (otherwise + (setq output + (concat output + (org-export-data obj info) + (let ((blank (org-element-property :post-blank obj))) + (and blank (> blank 0) "\\ "))))))) + info nil org-element-recursive-objects) + ;; Result. Do not wrap into math mode if already in a subscript + ;; or superscript. Do not wrap into curly brackets if OUTPUT is + ;; a single character. Also merge consecutive subscript and + ;; superscript into the same math snippet. + (concat (and (not in-script-p) + (let ((prev (org-export-get-previous-element object info))) + (or (not prev) + (not (eq (org-element-type prev) + (if (eq type 'subscript) 'superscript + 'subscript))) + (let ((blank (org-element-property :post-blank prev))) + (and blank (> blank 0))))) + "$") + (if (eq (org-element-type object) 'subscript) "_" "^") + (and (> (length output) 1) "{") + output + (and (> (length output) 1) "}") + (and (not in-script-p) + (or (let ((blank (org-element-property :post-blank object))) + (and blank (> blank 0))) + (not (eq (org-element-type + (org-export-get-next-element object info)) + (if (eq type 'subscript) 'superscript + 'subscript)))) + "$")))) + +(defun org-latex-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to LaTeX. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (org-latex--script-size subscript info)) + + +;;;; Superscript + +(defun org-latex-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to LaTeX. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (org-latex--script-size superscript info)) + + +;;;; Table +;; +;; `org-latex-table' is the entry point for table transcoding. It +;; takes care of tables with a "verbatim" mode. Otherwise, it +;; delegates the job to either `org-latex--table.el-table', +;; `org-latex--org-table' or `org-latex--math-table' functions, +;; depending of the type of the table and the mode requested. +;; +;; `org-latex--align-string' is a subroutine used to build alignment +;; string for Org tables. + +(defun org-latex-table (table contents info) + "Transcode a TABLE element from Org to LaTeX. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (if (eq (org-element-property :type table) 'table.el) + ;; "table.el" table. Convert it using appropriate tools. + (org-latex--table.el-table table info) + (let ((type (or (org-export-read-attribute :attr_latex table :mode) + org-latex-default-table-mode))) + (cond + ;; Case 1: Verbatim table. + ((string= type "verbatim") + (format "\\begin{verbatim}\n%s\n\\end{verbatim}" + ;; Re-create table, without affiliated keywords. + (org-trim (org-element-interpret-data + `(table nil ,@(org-element-contents table)))))) + ;; Case 2: Matrix. + ((or (string= type "math") (string= type "inline-math")) + (org-latex--math-table table info)) + ;; Case 3: Standard table. + (t (concat (org-latex--org-table table contents info) + ;; When there are footnote references within the + ;; table, insert their definition just after it. + (org-latex--delayed-footnotes-definitions table info))))))) + +(defun org-latex--align-string (table info) + "Return an appropriate LaTeX alignment string. +TABLE is the considered table. INFO is a plist used as +a communication channel." + (or (org-export-read-attribute :attr_latex table :align) + (let (align) + ;; Extract column groups and alignment from first (non-rule) + ;; row. + (org-element-map + (org-element-map table 'table-row + (lambda (row) + (and (eq (org-element-property :type row) 'standard) row)) + info 'first-match) + 'table-cell + (lambda (cell) + (let ((borders (org-export-table-cell-borders cell info))) + ;; Check left border for the first cell only. + (when (and (memq 'left borders) (not align)) + (push "|" align)) + (push (case (org-export-table-cell-alignment cell info) + (left "l") + (right "r") + (center "c")) + align) + (when (memq 'right borders) (push "|" align)))) + info) + (apply 'concat (nreverse align))))) + +(defun org-latex--org-table (table contents info) + "Return appropriate LaTeX code for an Org table. + +TABLE is the table type element to transcode. CONTENTS is its +contents, as a string. INFO is a plist used as a communication +channel. + +This function assumes TABLE has `org' as its `:type' property and +`table' as its `:mode' attribute." + (let* ((caption (org-latex--caption/label-string table info)) + (attr (org-export-read-attribute :attr_latex table)) + ;; Determine alignment string. + (alignment (org-latex--align-string table info)) + ;; Determine environment for the table: longtable, tabular... + (table-env (or (plist-get attr :environment) + org-latex-default-table-environment)) + ;; If table is a float, determine environment: table, table* + ;; or sidewaystable. + (float-env (unless (member table-env '("longtable" "longtabu")) + (let ((float (plist-get attr :float))) + (cond + ((string= float "sidewaystable") "sidewaystable") + ((string= float "multicolumn") "table*") + ((or (string= float "table") + (org-element-property :caption table)) + "table"))))) + ;; Extract others display options. + (fontsize (let ((font (plist-get attr :font))) + (and font (concat font "\n")))) + (width (plist-get attr :width)) + (spreadp (plist-get attr :spread)) + (placement (or (plist-get attr :placement) + (format "[%s]" org-latex-default-figure-position))) + (centerp (if (plist-member attr :center) (plist-get attr :center) + org-latex-tables-centered))) + ;; Prepare the final format string for the table. + (cond + ;; Longtable. + ((equal "longtable" table-env) + (concat (and fontsize (concat "{" fontsize)) + (format "\\begin{longtable}{%s}\n" alignment) + (and org-latex-table-caption-above + (org-string-nw-p caption) + (concat caption "\\\\\n")) + contents + (and (not org-latex-table-caption-above) + (org-string-nw-p caption) + (concat caption "\\\\\n")) + "\\end{longtable}\n" + (and fontsize "}"))) + ;; Longtabu + ((equal "longtabu" table-env) + (concat (and fontsize (concat "{" fontsize)) + (format "\\begin{longtabu}%s{%s}\n" + (if width + (format " %s %s " + (if spreadp "spread" "to") width) "") + alignment) + (and org-latex-table-caption-above + (org-string-nw-p caption) + (concat caption "\\\\\n")) + contents + (and (not org-latex-table-caption-above) + (org-string-nw-p caption) + (concat caption "\\\\\n")) + "\\end{longtabu}\n" + (and fontsize "}"))) + ;; Others. + (t (concat (cond + (float-env + (concat (format "\\begin{%s}%s\n" float-env placement) + (if org-latex-table-caption-above caption "") + (when centerp "\\centering\n") + fontsize)) + (centerp (concat "\\begin{center}\n" fontsize)) + (fontsize (concat "{" fontsize))) + (cond ((equal "tabu" table-env) + (format "\\begin{tabu}%s{%s}\n%s\\end{tabu}" + (if width (format + (if spreadp " spread %s " " to %s ") + width) "") + alignment + contents)) + (t (format "\\begin{%s}%s{%s}\n%s\\end{%s}" + table-env + (if width (format "{%s}" width) "") + alignment + contents + table-env))) + (cond + (float-env + (concat (if org-latex-table-caption-above "" caption) + (format "\n\\end{%s}" float-env))) + (centerp "\n\\end{center}") + (fontsize "}"))))))) + +(defun org-latex--table.el-table (table info) + "Return appropriate LaTeX code for a table.el table. + +TABLE is the table type element to transcode. INFO is a plist +used as a communication channel. + +This function assumes TABLE has `table.el' as its `:type' +property." + (require 'table) + ;; Ensure "*org-export-table*" buffer is empty. + (with-current-buffer (get-buffer-create "*org-export-table*") + (erase-buffer)) + (let ((output (with-temp-buffer + (insert (org-element-property :value table)) + (goto-char 1) + (re-search-forward "^[ \t]*|[^|]" nil t) + (table-generate-source 'latex "*org-export-table*") + (with-current-buffer "*org-export-table*" + (org-trim (buffer-string)))))) + (kill-buffer (get-buffer "*org-export-table*")) + ;; Remove left out comments. + (while (string-match "^%.*\n" output) + (setq output (replace-match "" t t output))) + (let ((attr (org-export-read-attribute :attr_latex table))) + (when (plist-get attr :rmlines) + ;; When the "rmlines" attribute is provided, remove all hlines + ;; but the the one separating heading from the table body. + (let ((n 0) (pos 0)) + (while (and (< (length output) pos) + (setq pos (string-match "^\\\\hline\n?" output pos))) + (incf n) + (unless (= n 2) (setq output (replace-match "" nil nil output)))))) + (let ((centerp (if (plist-member attr :center) (plist-get attr :center) + org-latex-tables-centered))) + (if (not centerp) output + (format "\\begin{center}\n%s\n\\end{center}" output)))))) + +(defun org-latex--math-table (table info) + "Return appropriate LaTeX code for a matrix. + +TABLE is the table type element to transcode. INFO is a plist +used as a communication channel. + +This function assumes TABLE has `org' as its `:type' property and +`inline-math' or `math' as its `:mode' attribute.." + (let* ((caption (org-latex--caption/label-string table info)) + (attr (org-export-read-attribute :attr_latex table)) + (inlinep (equal (plist-get attr :mode) "inline-math")) + (env (or (plist-get attr :environment) + org-latex-default-table-environment)) + (contents + (mapconcat + (lambda (row) + ;; Ignore horizontal rules. + (when (eq (org-element-property :type row) 'standard) + ;; Return each cell unmodified. + (concat + (mapconcat + (lambda (cell) + (substring (org-element-interpret-data cell) 0 -1)) + (org-element-map row 'table-cell 'identity info) "&") + (or (cdr (assoc env org-latex-table-matrix-macros)) "\\\\") + "\n"))) + (org-element-map table 'table-row 'identity info) "")) + ;; Variables related to math clusters (contiguous math tables + ;; of the same type). + (mode (org-export-read-attribute :attr_latex table :mode)) + (prev (org-export-get-previous-element table info)) + (next (org-export-get-next-element table info)) + (same-mode-p + (lambda (table) + ;; Non-nil when TABLE has the same mode as current table. + (string= (or (org-export-read-attribute :attr_latex table :mode) + org-latex-default-table-mode) + mode)))) + (concat + ;; Opening string. If TABLE is in the middle of a table cluster, + ;; do not insert any. + (cond ((and prev + (eq (org-element-type prev) 'table) + (memq (org-element-property :post-blank prev) '(0 nil)) + (funcall same-mode-p prev)) + nil) + (inlinep "\\(") + ((org-string-nw-p caption) (concat "\\begin{equation}\n" caption)) + (t "\\[")) + ;; Prefix. + (or (plist-get attr :math-prefix) "") + ;; Environment. Also treat special cases. + (cond ((equal env "array") + (let ((align (org-latex--align-string table info))) + (format "\\begin{array}{%s}\n%s\\end{array}" align contents))) + ((assoc env org-latex-table-matrix-macros) + (format "\\%s%s{\n%s}" + env + (or (plist-get attr :math-arguments) "") + contents)) + (t (format "\\begin{%s}\n%s\\end{%s}" env contents env))) + ;; Suffix. + (or (plist-get attr :math-suffix) "") + ;; Closing string. If TABLE is in the middle of a table cluster, + ;; do not insert any. If it closes such a cluster, be sure to + ;; close the cluster with a string matching the opening string. + (cond ((and next + (eq (org-element-type next) 'table) + (memq (org-element-property :post-blank table) '(0 nil)) + (funcall same-mode-p next)) + nil) + (inlinep "\\)") + ;; Find cluster beginning to know which environment to use. + ((let ((cluster-beg table) prev) + (while (and (setq prev (org-export-get-previous-element + cluster-beg info)) + (memq (org-element-property :post-blank prev) + '(0 nil)) + (funcall same-mode-p prev)) + (setq cluster-beg prev)) + (and (or (org-element-property :caption cluster-beg) + (org-element-property :name cluster-beg)) + "\n\\end{equation}"))) + (t "\\]"))))) + + +;;;; Table Cell + +(defun org-latex-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to LaTeX. +CONTENTS is the cell contents. INFO is a plist used as +a communication channel." + (concat (if (and contents + org-latex-table-scientific-notation + (string-match orgtbl-exp-regexp contents)) + ;; Use appropriate format string for scientific + ;; notation. + (format org-latex-table-scientific-notation + (match-string 1 contents) + (match-string 2 contents)) + contents) + (when (org-export-get-next-element table-cell info) " & "))) + + +;;;; Table Row + +(defun org-latex-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to LaTeX. +CONTENTS is the contents of the row. INFO is a plist used as +a communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let* ((attr (org-export-read-attribute :attr_latex + (org-export-get-parent table-row))) + (longtablep (member (or (plist-get attr :environment) + org-latex-default-table-environment) + '("longtable" "longtabu"))) + (booktabsp (if (plist-member attr :booktabs) + (plist-get attr :booktabs) + org-latex-tables-booktabs)) + ;; TABLE-ROW's borders are extracted from its first cell. + (borders (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) + (concat + ;; When BOOKTABS are activated enforce top-rule even when no + ;; hline was specifically marked. + (cond ((and booktabsp (memq 'top borders)) "\\toprule\n") + ((and (memq 'top borders) (memq 'above borders)) "\\hline\n")) + contents "\\\\\n" + (cond + ;; Special case for long tables. Define header and footers. + ((and longtablep (org-export-table-row-ends-header-p table-row info)) + (format "%s +\\endhead +%s\\multicolumn{%d}{r}{Continued on next page} \\\\ +\\endfoot +\\endlastfoot" + (if booktabsp "\\midrule" "\\hline") + (if booktabsp "\\midrule" "\\hline") + ;; Number of columns. + (cdr (org-export-table-dimensions + (org-export-get-parent-table table-row) info)))) + ;; When BOOKTABS are activated enforce bottom rule even when + ;; no hline was specifically marked. + ((and booktabsp (memq 'bottom borders)) "\\bottomrule") + ((and (memq 'bottom borders) (memq 'below borders)) "\\hline") + ((memq 'below borders) (if booktabsp "\\midrule" "\\hline"))))))) + + +;;;; Target + +(defun org-latex-target (target contents info) + "Transcode a TARGET object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "\\label{%s}" + (org-export-solidify-link-text (org-element-property :value target)))) + + +;;;; Timestamp + +(defun org-latex-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-latex-plain-text + (org-timestamp-translate timestamp) info))) + (case (org-element-property :type timestamp) + ((active active-range) (format org-latex-active-timestamp-format value)) + ((inactive inactive-range) + (format org-latex-inactive-timestamp-format value)) + (otherwise (format org-latex-diary-timestamp-format value))))) + + +;;;; Underline + +(defun org-latex-underline (underline contents info) + "Transcode UNDERLINE from Org to LaTeX. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (org-latex--text-markup contents 'underline)) + + +;;;; Verbatim + +(defun org-latex-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to LaTeX. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (org-latex--text-markup (org-element-property :value verbatim) 'verbatim)) + + +;;;; Verse Block + +(defun org-latex-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to LaTeX. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + (org-latex--wrap-label + verse-block + ;; In a verse environment, add a line break to each newline + ;; character and change each white space at beginning of a line + ;; into a space of 1 em. Also change each blank line with + ;; a vertical space of 1 em. + (progn + (setq contents (replace-regexp-in-string + "^ *\\\\\\\\$" "\\\\vspace*{1em}" + (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" contents))) + (while (string-match "^[ \t]+" contents) + (let ((new-str (format "\\hspace*{%dem}" + (length (match-string 0 contents))))) + (setq contents (replace-match new-str nil t contents)))) + (format "\\begin{verse}\n%s\\end{verse}" contents)))) + + + +;;; End-user functions + +;;;###autoload +(defun org-latex-export-as-latex + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer as a LaTeX buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org LATEX Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (if async + (org-export-async-start + (lambda (output) + (with-current-buffer (get-buffer-create "*Org LATEX Export*") + (erase-buffer) + (insert output) + (goto-char (point-min)) + (LaTeX-mode) + (org-export-add-to-stack (current-buffer) 'latex))) + `(org-export-as 'latex ,subtreep ,visible-only ,body-only + ',ext-plist)) + (let ((outbuf + (org-export-to-buffer 'latex "*Org LATEX Export*" + subtreep visible-only body-only ext-plist))) + (with-current-buffer outbuf (LaTeX-mode)) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window outbuf))))) + +;;;###autoload +(defun org-latex-convert-region-to-latex () + "Assume the current region has org-mode syntax, and convert it to LaTeX. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in an LaTeX buffer and use this +command to convert it." + (interactive) + (org-export-replace-region-by 'latex)) + +;;;###autoload +(defun org-latex-export-to-latex + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a LaTeX file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".tex" subtreep))) + (if async + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'latex)) + `(expand-file-name + (org-export-to-file + 'latex ,outfile ,subtreep ,visible-only ,body-only ',ext-plist))) + (org-export-to-file + 'latex outfile subtreep visible-only body-only ext-plist)))) + +;;;###autoload +(defun org-latex-export-to-pdf + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to LaTeX then process through to PDF. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return PDF file's name." + (interactive) + (if async + (let ((outfile (org-export-output-file-name ".tex" subtreep))) + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'latex)) + `(expand-file-name + (org-latex-compile + (org-export-to-file + 'latex ,outfile ,subtreep ,visible-only ,body-only + ',ext-plist))))) + (org-latex-compile + (org-latex-export-to-latex + nil subtreep visible-only body-only ext-plist)))) + +(defun org-latex-compile (texfile &optional snippet) + "Compile a TeX file. + +TEXFILE is the name of the file being compiled. Processing is +done through the command specified in `org-latex-pdf-process'. + +When optional argument SNIPPET is non-nil, TEXFILE is a temporary +file used to preview a LaTeX snippet. In this case, do not +create a log buffer and do not bother removing log files. + +Return PDF file name or an error if it couldn't be produced." + (let* ((base-name (file-name-sans-extension (file-name-nondirectory texfile))) + (full-name (file-truename texfile)) + (out-dir (file-name-directory texfile)) + ;; Make sure `default-directory' is set to TEXFILE directory, + ;; not to whatever value the current buffer may have. + (default-directory (file-name-directory full-name)) + errors) + (unless snippet (message (format "Processing LaTeX file %s..." texfile))) + (save-window-excursion + (cond + ;; A function is provided: Apply it. + ((functionp org-latex-pdf-process) + (funcall org-latex-pdf-process (shell-quote-argument texfile))) + ;; A list is provided: Replace %b, %f and %o with appropriate + ;; values in each command before applying it. Output is + ;; redirected to "*Org PDF LaTeX Output*" buffer. + ((consp org-latex-pdf-process) + (let ((outbuf (and (not snippet) + (get-buffer-create "*Org PDF LaTeX Output*")))) + (mapc + (lambda (command) + (shell-command + (replace-regexp-in-string + "%b" (shell-quote-argument base-name) + (replace-regexp-in-string + "%f" (shell-quote-argument full-name) + (replace-regexp-in-string + "%o" (shell-quote-argument out-dir) command t t) t t) t t) + outbuf)) + org-latex-pdf-process) + ;; Collect standard errors from output buffer. + (setq errors (and (not snippet) (org-latex--collect-errors outbuf))))) + (t (error "No valid command to process to PDF"))) + (let ((pdffile (concat out-dir base-name ".pdf"))) + ;; Check for process failure. Provide collected errors if + ;; possible. + (if (not (file-exists-p pdffile)) + (error (concat (format "PDF file %s wasn't produced" pdffile) + (when errors (concat ": " errors)))) + ;; Else remove log files, when specified, and signal end of + ;; process to user, along with any error encountered. + (when (and (not snippet) org-latex-remove-logfiles) + (dolist (ext org-latex-logfiles-extensions) + (let ((file (concat out-dir base-name "." ext))) + (when (file-exists-p file) (delete-file file))))) + (message (concat "Process completed" + (if (not errors) "." + (concat " with errors: " errors))))) + ;; Return output file name. + pdffile)))) + +(defun org-latex--collect-errors (buffer) + "Collect some kind of errors from \"pdflatex\" command output. + +BUFFER is the buffer containing output. + +Return collected error types as a string, or nil if there was +none." + (with-current-buffer buffer + (save-excursion + (goto-char (point-max)) + (when (re-search-backward "^[ \t]*This is .*?TeX.*?Version" nil t) + (let ((case-fold-search t) + (errors "")) + (dolist (latex-error org-latex-known-errors) + (when (save-excursion (re-search-forward (car latex-error) nil t)) + (setq errors (concat errors " " (cdr latex-error))))) + (and (org-string-nw-p errors) (org-trim errors))))))) + +;;;###autoload +(defun org-latex-publish-to-latex (plist filename pub-dir) + "Publish an Org file to LaTeX. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'latex filename ".tex" plist pub-dir)) + +;;;###autoload +(defun org-latex-publish-to-pdf (plist filename pub-dir) + "Publish an Org file to PDF (via LaTeX). + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + ;; Unlike to `org-latex-publish-to-latex', PDF file is generated + ;; in working directory and then moved to publishing directory. + (org-publish-attachment + plist + (org-latex-compile (org-publish-org-to 'latex filename ".tex" plist)) + pub-dir)) + + +(provide 'ox-latex) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-latex.el ends here diff --git a/contrib/lisp/org-e-man.el b/lisp/ox-man.el similarity index 50% rename from contrib/lisp/org-e-man.el rename to lisp/ox-man.el index 808b28974..4a5add893 100644 --- a/contrib/lisp/org-e-man.el +++ b/lisp/ox-man.el @@ -1,24 +1,25 @@ -;; org-e-man.el --- Man Back-End For Org Export Engine +;; ox-man.el --- Man Back-End for Org Export Engine ;; Copyright (C) 2011-2013 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou -;; Author: Luis R Anaya +;; Luis R Anaya ;; Keywords: outlines, hypermedia, calendar, wp -;; -;; This program is free software; you can redistribute it and/or modify +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -26,144 +27,145 @@ ;; ;; To test it, run ;; -;; M-: (org-export-to-buffer 'e-man "*Test e-Man*") RET +;; M-: (org-export-to-buffer 'man "*Test Man*") RET ;; ;; in an org-mode buffer then switch to the buffer to see the Man -;; export. See contrib/lisp/org-export.el for more details on how -;; this exporter works. +;; export. See ox.el for more details on how this exporter works. ;; ;; It introduces one new buffer keywords: ;; "MAN_CLASS_OPTIONS". -;;;; Code: +;;; Code: -(require 'org-export) +(require 'ox) (eval-when-compile (require 'cl)) (defvar org-export-man-default-packages-alist) (defvar org-export-man-packages-alist) - +(defvar orgtbl-exp-regexp) +;;; Define Back-End - -;;;; Define Back-End - -(defvar org-e-man-translate-alist - '((babel-call . org-e-man-babel-call) - (bold . org-e-man-bold) - (center-block . org-e-man-center-block) - (clock . org-e-man-clock) - (code . org-e-man-code) - (comment . org-e-man-comment) - (comment-block . org-e-man-comment-block) - (drawer . org-e-man-drawer) - (dynamic-block . org-e-man-dynamic-block) - (entity . org-e-man-entity) - (example-block . org-e-man-example-block) - (export-block . org-e-man-export-block) - (export-snippet . org-e-man-export-snippet) - (fixed-width . org-e-man-fixed-width) - (footnote-definition . org-e-man-footnote-definition) - (footnote-reference . org-e-man-footnote-reference) - (headline . org-e-man-headline) - (horizontal-rule . org-e-man-horizontal-rule) - (inline-babel-call . org-e-man-inline-babel-call) - (inline-src-block . org-e-man-inline-src-block) - (inlinetask . org-e-man-inlinetask) - (italic . org-e-man-italic) - (item . org-e-man-item) - (keyword . org-e-man-keyword) - (man-environment . org-e-man-man-environment) - (man-fragment . org-e-man-man-fragment) - (line-break . org-e-man-line-break) - (link . org-e-man-link) - (macro . org-e-man-macro) - (paragraph . org-e-man-paragraph) - (plain-list . org-e-man-plain-list) - (plain-text . org-e-man-plain-text) - (planning . org-e-man-planning) - (property-drawer . org-e-man-property-drawer) - (quote-block . org-e-man-quote-block) - (quote-section . org-e-man-quote-section) - (radio-target . org-e-man-radio-target) - (section . org-e-man-section) - (special-block . org-e-man-special-block) - (src-block . org-e-man-src-block) - (statistics-cookie . org-e-man-statistics-cookie) - (strike-through . org-e-man-strike-through) - (subscript . org-e-man-subscript) - (superscript . org-e-man-superscript) - (table . org-e-man-table) - (table-cell . org-e-man-table-cell) - (table-row . org-e-man-table-row) - (target . org-e-man-target) - (template . org-e-man-template) - (timestamp . org-e-man-timestamp) - (underline . org-e-man-underline) - (verbatim . org-e-man-verbatim) - (verse-block . org-e-man-verse-block)) - "Alist between element or object types and translators.") - -(defconst org-e-man-options-alist - '((:date "DATE" nil nil t) - (:man-class "MAN_CLASS" nil nil t) +(org-export-define-backend 'man + '((babel-call . org-man-babel-call) + (bold . org-man-bold) + (center-block . org-man-center-block) + (clock . org-man-clock) + (code . org-man-code) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (drawer . org-man-drawer) + (dynamic-block . org-man-dynamic-block) + (entity . org-man-entity) + (example-block . org-man-example-block) + (export-block . org-man-export-block) + (export-snippet . org-man-export-snippet) + (fixed-width . org-man-fixed-width) + (footnote-definition . org-man-footnote-definition) + (footnote-reference . org-man-footnote-reference) + (headline . org-man-headline) + (horizontal-rule . org-man-horizontal-rule) + (inline-babel-call . org-man-inline-babel-call) + (inline-src-block . org-man-inline-src-block) + (inlinetask . org-man-inlinetask) + (italic . org-man-italic) + (item . org-man-item) + (keyword . org-man-keyword) + (line-break . org-man-line-break) + (link . org-man-link) + (paragraph . org-man-paragraph) + (plain-list . org-man-plain-list) + (plain-text . org-man-plain-text) + (planning . org-man-planning) + (property-drawer . (lambda (&rest args) "")) + (quote-block . org-man-quote-block) + (quote-section . org-man-quote-section) + (radio-target . org-man-radio-target) + (section . org-man-section) + (special-block . org-man-special-block) + (src-block . org-man-src-block) + (statistics-cookie . org-man-statistics-cookie) + (strike-through . org-man-strike-through) + (subscript . org-man-subscript) + (superscript . org-man-superscript) + (table . org-man-table) + (table-cell . org-man-table-cell) + (table-row . org-man-table-row) + (target . org-man-target) + (template . org-man-template) + (timestamp . org-man-timestamp) + (underline . org-man-underline) + (verbatim . org-man-verbatim) + (verse-block . org-man-verse-block)) + :export-block "MAN" + :menu-entry + '(?m "Export to MAN" + ((?m "As MAN file" org-man-export-to-man) + (?p "As PDF file" org-man-export-to-pdf) + (?o "As PDF file and open" + (lambda (a s v b) + (if a (org-man-export-to-pdf t s v b) + (org-open-file (org-man-export-to-pdf nil s v b))))))) + :options-alist + '((:man-class "MAN_CLASS" nil nil t) (:man-class-options "MAN_CLASS_OPTIONS" nil nil t) - (:man-header-extra "MAN_HEADER" nil nil newline)) - "Alist between Man export properties and ways to set them. -See `org-export-options-alist' for more information on the -structure of the values.") + (:man-header-extra "MAN_HEADER" nil nil newline))) - ;;; User Configurable Variables - -(defgroup org-export-e-man nil +(defgroup org-export-man nil "Options for exporting Org mode files to Man." :tag "Org Export Man" :group 'org-export) +;;; Tables -;;;; Tables - - -(defcustom org-e-man-tables-centered t +(defcustom org-man-tables-centered t "When non-nil, tables are exported in a center environment." - :group 'org-export-e-man + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) -(defcustom org-e-man-tables-verbatim nil +(defcustom org-man-tables-verbatim nil "When non-nil, tables are exported verbatim." - :group 'org-export-e-man + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) -(defcustom org-e-man-table-scientific-notation "%sE%s" + +(defcustom org-man-table-scientific-notation "%sE%s" "Format string to display numbers in scientific notation. The format should have \"%s\" twice, for mantissa and exponent \(i.e. \"%s\\\\times10^{%s}\"). When nil, no transformation is made." - :group 'org-export-e-man + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") :type '(choice (string :tag "Format string") (const :tag "No formatting"))) -;;;; Inlinetasks - - +;;; Inlinetasks ;; Src blocks -(defcustom org-e-man-source-highlight nil +(defcustom org-man-source-highlight nil "Use GNU source highlight to embellish source blocks " - :group 'org-export-e-man + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) -(defcustom org-e-man-source-highlight-langs + +(defcustom org-man-source-highlight-langs '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp") (scheme "scheme") (c "c") (cc "cpp") (csharp "csharp") (d "d") @@ -188,20 +190,23 @@ The value is the string that should be inserted as the language parameter for the listings package. If the mode name and the listings name are the same, the language does not need an entry in this list - but it does not hurt if it is present." - :group 'org-export-e-man + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") :type '(repeat (list (symbol :tag "Major mode ") (string :tag "Listings language")))) -(defvar org-e-man-custom-lang-environments nil + +(defvar org-man-custom-lang-environments nil "Alist mapping languages to language-specific Man environments. It is used during export of src blocks by the listings and man packages. For example, - \(setq org-e-man-custom-lang-environments + \(setq org-man-custom-lang-environments '\(\(python \"pythoncode\"\)\)\) would have the effect that if org encounters begin_src python @@ -209,45 +214,9 @@ during man export." ) -;;;; Plain text +;;; Compilation -(defcustom org-e-man-quotes - '(("fr" - ("\\(\\s-\\|[[(]\\|^\\)\"" . "«~") - ("\\(\\S-\\)\"" . "~»") - ("\\(\\s-\\|(\\|^\\)'" . "'")) - ("en" - ("\\(\\s-\\|[[(]\\|^\\)\"" . "``") - ("\\(\\S-\\)\"" . "''") - ("\\(\\s-\\|(\\|^\\)'" . "`"))) - - "Alist for quotes to use when converting english double-quotes. - -The CAR of each item in this alist is the language code. -The CDR of each item in this alist is a list of three CONS: -- the first CONS defines the opening quote; -- the second CONS defines the closing quote; -- the last CONS defines single quotes. - -For each item in a CONS, the first string is a regexp -for allowed characters before/after the quote, the second -string defines the replacement string for this quote." - :group 'org-export-e-man - :type '(list - (cons :tag "Opening quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")) - (cons :tag "Closing quote" - (string :tag "Regexp for char after ") - (string :tag "Replacement quote ")) - (cons :tag "Single quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")))) - - -;;;; Compilation - -(defcustom org-e-man-pdf-process +(defcustom org-man-pdf-process '("tbl %f | eqn | groff -man | ps2pdf - > %b.pdf" "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf" "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf") @@ -255,8 +224,8 @@ string defines the replacement string for this quote." "Commands to process a Man file to a PDF file. This is a list of strings, each of them will be given to the shell as a command. %f in the command will be replaced by the -full file name, %b by the file base name \(i.e. without -extension) and %o by the base directory of the file. +full file name, %b by the file base name (i.e. without directory +and extension parts) and %o by the base directory of the file. By default, Org uses 3 runs of to do the processing. @@ -265,114 +234,87 @@ Alternatively, this may be a Lisp function that does the processing. This function should accept the file name as its single argument." :group 'org-export-pdf + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") :type '(choice (repeat :tag "Shell command sequence" (string :tag "Shell command")) (const :tag "2 runs of pdfgroff" ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" - "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf")) + "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" )) (const :tag "3 runs of pdfgroff" ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf")) (function))) -(defcustom org-e-man-logfiles-extensions +(defcustom org-man-logfiles-extensions '("log" "out" "toc") "The list of file extensions to consider as Man logfiles." - :group 'org-export-e-man + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") :type '(repeat (string :tag "Extension"))) -(defcustom org-e-man-remove-logfiles t +(defcustom org-man-remove-logfiles t "Non-nil means remove the logfiles produced by PDF production. These are the .aux, .log, .out, and .toc files." - :group 'org-export-e-man + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) - - -;; Preamble - - -;; Adding MAN as a block parser to make sure that its contents -;; does not execute - -(add-to-list 'org-element-block-name-alist - '("MAN" . org-element-export-block-parser)) - - - ;;; Internal Functions -(defun org-e-man--caption/label-string (caption label info) - "Return caption and label Man string for floats. +(defun org-man--caption/label-string (element info) + "Return caption and label Man string for ELEMENT. -CAPTION is a cons cell of secondary strings, the car being the -standard caption and the cdr its short form. LABEL is a string -representing the label. INFO is a plist holding contextual -information. +INFO is a plist holding contextual information. If there's no +caption nor label, return the empty string. -If there's no caption nor label, return the empty string. +For non-floats, see `org-man--wrap-label'." + (let ((label (org-element-property :label element)) + (main (org-export-get-caption element)) + (short (org-export-get-caption element t))) + (cond ((and (not main) (not label)) "") + ((not main) (format "\\fI%s\\fP" label)) + ;; Option caption format with short name. + (short (format "\\fR%s\\fP - \\fI\\P - %s\n" + (org-export-data short info) + (org-export-data main info))) + ;; Standard caption format. + (t (format "\\fR%s\\fP" (org-export-data main info)))))) -For non-floats, see `org-e-man--wrap-label'." - (let ((label-str "")) - (cond - ((and (not caption) (not label)) "") - ((not caption) (format "\\fI%s\\fP" label)) - ;; Option caption format with short name. - ((cdr caption) - (format "\\fR%s\\fP - \\fI%s\\P - %s\n" - (org-export-data (cdr caption) info) - label-str - (org-export-data (car caption) info))) - ;; Standard caption format. - (t (format "\\fR%s\\fP" - (org-export-data (car caption) info)))))) - -(defun org-e-man--quotation-marks (text info) - "Export quotation marks depending on language conventions. -TEXT is a string containing quotation marks to be replaced. INFO -is a plist used as a communication channel." - (mapc (lambda(l) - (let ((start 0)) - (while (setq start (string-match (car l) text start)) - (let ((new-quote (concat (match-string 1 text) (cdr l)))) - (setq text (replace-match new-quote t t text)))))) - (cdr (or (assoc (plist-get info :language) org-e-man-quotes) - ;; Falls back on English. - (assoc "en" org-e-man-quotes)))) - text) - -(defun org-e-man--wrap-label (element output) +(defun org-man--wrap-label (element output) "Wrap label associated to ELEMENT around OUTPUT, if appropriate. This function shouldn't be used for floats. See -`org-e-man--caption/label-string'." +`org-man--caption/label-string'." (let ((label (org-element-property :name element))) (if (or (not output) (not label) (string= output "") (string= label "")) output (concat (format "%s\n.br\n" label) output)))) + - - ;;; Template -(defun org-e-man-template (contents info) +(defun org-man-template (contents info) "Return complete document string after Man conversion. CONTENTS is the transcoded contents string. INFO is a plist holding export options." (let* ((title (org-export-data (plist-get info :title) info)) - (attr - (read (format "(%s)" - (mapconcat - #'identity - (list (plist-get info :man-class-options)) - " ")))) - (section-item (plist-get attr :section-id))) + (attr (read (format "(%s)" + (mapconcat + #'identity + (list (plist-get info :man-class-options)) + " ")))) + (section-item (plist-get attr :section-id))) (concat + (cond ((and title (stringp section-item)) (format ".TH \"%s\" \"%s\" \n" title section-item)) @@ -384,67 +326,69 @@ holding export options." ".TH \" \" \"1\" ")) contents))) + + - - ;;; Transcode Functions -;;;; Babel Call - +;;; Babel Call +;; ;; Babel Calls are ignored. -;;;; Bold +;;; Bold -(defun org-e-man-bold (bold contents info) +(defun org-man-bold (bold contents info) "Transcode BOLD from Org to Man. CONTENTS is the text with bold markup. INFO is a plist holding contextual information." (format "\\fB%s\\fP" contents)) -;;;; Center Block +;;; Center Block -(defun org-e-man-center-block (center-block contents info) +(defun org-man-center-block (center-block contents info) "Transcode a CENTER-BLOCK element from Org to Man. CONTENTS holds the contents of the center block. INFO is a plist holding contextual information." - (org-e-man--wrap-label + (org-man--wrap-label center-block (format ".ce %d\n.nf\n%s\n.fi" - (- (length (split-string contents "\n")) 1) + (- (length (split-string contents "\n")) 1 ) contents))) -;;;; Clock +;;; Clock -(defun org-e-man-clock (clock contents info) +(defun org-man-clock (clock contents info) "Transcode a CLOCK element from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." - "") + "" ) -;;;; Code +;;; Code -(defun org-e-man-code (code contents info) +(defun org-man-code (code contents info) "Transcode a CODE object from Org to Man. CONTENTS is nil. INFO is a plist used as a communication channel." (format "\\fC%s\\fP" code)) -;;;; Comment +;;; Comment +;; ;; Comments are ignored. -;;;; Comment Block +;;; Comment Block +;; ;; Comment Blocks are ignored. -;;;; Drawer +;;; Drawer -(defun org-e-man-drawer (drawer contents info) +(defun org-man-drawer (drawer contents info) "Transcode a DRAWER element from Org to Man. DRAWER holds the drawer information CONTENTS holds the contents of the block. @@ -452,76 +396,79 @@ channel." contents) -;;;; Dynamic Block +;;; Dynamic Block -(defun org-e-man-dynamic-block (dynamic-block contents info) +(defun org-man-dynamic-block (dynamic-block contents info) "Transcode a DYNAMIC-BLOCK element from Org to Man. CONTENTS holds the contents of the block. INFO is a plist holding contextual information. See `org-export-data'." - (org-e-man--wrap-label dynamic-block contents)) + (org-man--wrap-label dynamic-block contents)) -;;;; Entity +;;; Entity -(defun org-e-man-entity (entity contents info) +(defun org-man-entity (entity contents info) "Transcode an ENTITY object from Org to Man. CONTENTS are the definition itself. INFO is a plist holding contextual information." - (let ((ent (org-element-property :utf8 entity))) ent)) + (org-element-property :utf-8 entity)) -;;;; Example Block +;;; Example Block -(defun org-e-man-example-block (example-block contents info) +(defun org-man-example-block (example-block contents info) "Transcode an EXAMPLE-BLOCK element from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-man--wrap-label + (org-man--wrap-label example-block (format ".RS\n.nf\n%s\n.fi\n.RE" (org-export-format-code-default example-block info)))) -;;;; Export Block -(defun org-e-man-export-block (export-block contents info) +;;; Export Block + +(defun org-man-export-block (export-block contents info) "Transcode a EXPORT-BLOCK element from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." (when (string= (org-element-property :type export-block) "MAN") (org-remove-indentation (org-element-property :value export-block)))) -;;;; Export Snippet +;;; Export Snippet -(defun org-e-man-export-snippet (export-snippet contents info) +(defun org-man-export-snippet (export-snippet contents info) "Transcode a EXPORT-SNIPPET object from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." - (when (eq (org-export-snippet-backend export-snippet) 'e-man) + (when (eq (org-export-snippet-backend export-snippet) 'man) (org-element-property :value export-snippet))) -;;;; Fixed Width +;;; Fixed Width -(defun org-e-man-fixed-width (fixed-width contents info) +(defun org-man-fixed-width (fixed-width contents info) "Transcode a FIXED-WIDTH element from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." - (org-e-man--wrap-label + (org-man--wrap-label fixed-width (format "\\fC\n%s\\fP" (org-remove-indentation (org-element-property :value fixed-width))))) -;;;; Footnote Definition +;;; Footnote Definition +;; ;; Footnote Definitions are ignored. -;;;; Footnote References +;;; Footnote References +;; ;; Footnote References are Ignored -;;;; Headline +;;; Headline -(defun org-e-man-headline (headline contents info) - "Transcode an HEADLINE element from Org to Man. +(defun org-man-headline (headline contents info) + "Transcode a HEADLINE element from Org to Man. CONTENTS holds the contents of the headline. INFO is a plist holding contextual information." (let* ((level (org-export-get-relative-level headline info)) @@ -562,45 +509,43 @@ holding contextual information." low-level-body)))) ;; Case 3. Standard headline. Export it as a section. - (t (format section-fmt text contents))))) + (t (format section-fmt text contents ))))) - -;;;; Horizontal Rule +;;; Horizontal Rule ;; Not supported - -;;;; Inline Babel Call +;;; Inline Babel Call +;; ;; Inline Babel Calls are ignored. +;;; Inline Src Block -;;;; Inline Src Block - -(defun org-e-man-inline-src-block (inline-src-block contents info) +(defun org-man-inline-src-block (inline-src-block contents info) "Transcode an INLINE-SRC-BLOCK element from Org to Man. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let* ((code (org-element-property :value inline-src-block))) (cond - (org-e-man-source-highlight + (org-man-source-highlight (let* ((tmpdir (if (featurep 'xemacs) temp-directory - temporary-file-directory)) + temporary-file-directory )) (in-file (make-temp-name (expand-file-name "srchilite" tmpdir))) (out-file (make-temp-name (expand-file-name "reshilite" tmpdir))) (org-lang (org-element-property :language inline-src-block)) (lst-lang (cadr (assq (intern org-lang) - org-e-man-source-highlight-langs))) + org-man-source-highlight-langs))) (cmd (concat (expand-file-name "source-highlight") " -s " lst-lang " -f groff_man" " -i " in-file - " -o " out-file))) + " -o " out-file ))) (if lst-lang - (let ((code-block "")) + (let ((code-block "" )) (with-temp-file in-file (insert code)) (shell-command cmd) (setq code-block (org-file-contents out-file)) @@ -616,19 +561,20 @@ contextual information." "\\fP\n.fi\n.RE\n"))))) -;;;; Inlinetask -;;;; Italic +;;; Inlinetask +;;; Italic -(defun org-e-man-italic (italic contents info) +(defun org-man-italic (italic contents info) "Transcode ITALIC from Org to Man. CONTENTS is the text with italic markup. INFO is a plist holding contextual information." (format "\\fI%s\\fP" contents)) -;;;; Item +;;; Item -(defun org-e-man-item (item contents info) + +(defun org-man-item (item contents info) "Transcode an ITEM element from Org to Man. CONTENTS holds the contents of the item. INFO is a plist holding @@ -639,7 +585,7 @@ contextual information." (checkbox (case (org-element-property :checkbox item) (on "\\o'\\(sq\\(mu'") ;; (off "\\(sq ") ;; - (trans "\\o'\\(sq\\(mi'"))) ;; + (trans "\\o'\\(sq\\(mi'" ))) ;; (tag (let ((tag (org-element-property :tag item))) ;; Check-boxes must belong to the tag. @@ -647,7 +593,7 @@ contextual information." (concat checkbox (org-export-data tag info))))))) - (if (and (null tag) + (if (and (null tag ) (null checkbox)) (let* ((bullet (org-trim bullet)) (marker (cond ((string= "-" bullet) "\\(em") @@ -656,15 +602,15 @@ contextual information." (format "%s " (org-trim bullet))) (t "\\(dg")))) (concat ".IP " marker " 4\n" - (org-trim (or contents " ")))) + (org-trim (or contents " " )))) ; else (concat ".TP\n" (or tag (concat " " checkbox)) "\n" - (org-trim (or contents " ")))))) + (org-trim (or contents " " )))))) + +;;; Keyword -;;;; Keyword - -(defun org-e-man-keyword (keyword contents info) +(defun org-man-keyword (keyword contents info) "Transcode a KEYWORD element from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." (let ((key (org-element-property :key keyword)) @@ -672,50 +618,21 @@ CONTENTS is nil. INFO is a plist holding contextual information." (cond ((string= key "MAN") value) ((string= key "INDEX") nil) - ;; Invisible targets. - ((string= key "TARGET") nil) - ((string= key "TOC") nil)))) + ((string= key "TOC" ) nil)))) -;;;; Man Environment +;;; Line Break -(defun org-e-man-man-environment (man-environment contents info) - "Transcode a MAN-ENVIRONMENT element from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((label (org-element-property :name man-environment)) - (value (org-remove-indentation - (org-element-property :value man-environment)))) - (if (not (org-string-nw-p label)) value - ;; Environment is labelled: label must be within the environment - ;; (otherwise, a reference pointing to that element will count - ;; the section instead). - (with-temp-buffer - (insert value) - (goto-char (point-min)) - (forward-line) - (insert (format "%s\n" label)) - (buffer-string))))) - - -;;;; Man Fragment - -(defun org-e-man-man-fragment (man-fragment contents info) - "Transcode a MAN-FRAGMENT object from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-element-property :value man-fragment)) - - -;;;; Line Break - -(defun org-e-man-line-break (line-break contents info) +(defun org-man-line-break (line-break contents info) "Transcode a LINE-BREAK object from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." ".br\n") -;;;; Link +;;; Link -(defun org-e-man-link (link desc info) + +(defun org-man-link (link desc info) "Transcode a LINK object from Org to Man. DESC is the description part of the link, or the empty string. @@ -747,18 +664,9 @@ INFO is a plist holding contextual information. See (t (format "\\fI%s\\fP" desc))))) -;;;; Macro +;;; Paragraph -(defun org-e-man-macro (macro contents info) - "Transcode a MACRO element from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual information." - ;; Use available tools. - (org-export-expand-macro macro info)) - - -;;;; Paragraph - -(defun org-e-man-paragraph (paragraph contents info) +(defun org-man-paragraph (paragraph contents info) "Transcode a PARAGRAPH element from Org to Man. CONTENTS is the contents of the paragraph, as a string. INFO is the plist used as a communication channel." @@ -767,67 +675,67 @@ the plist used as a communication channel." (let ((parent-type (car parent)) (fixed-paragraph "")) (cond ((and (eq parent-type 'item) - (plist-get (nth 1 parent) :bullet)) + (plist-get (nth 1 parent) :bullet )) (setq fixed-paragraph (concat "" contents))) ((eq parent-type 'section) (setq fixed-paragraph (concat ".PP\n" contents))) ((eq parent-type 'footnote-definition) (setq fixed-paragraph contents)) (t (setq fixed-paragraph (concat "" contents)))) - fixed-paragraph)))) + fixed-paragraph )))) -;;;; Plain List +;;; Plain List -(defun org-e-man-plain-list (plain-list contents info) +(defun org-man-plain-list (plain-list contents info) "Transcode a PLAIN-LIST element from Org to Man. CONTENTS is the contents of the list. INFO is a plist holding contextual information." contents) +;;; Plain Text -;;;; Plain Text - -(defun org-e-man-plain-text (text info) +(defun org-man-plain-text (text info) "Transcode a TEXT string from Org to Man. TEXT is the string to transcode. INFO is a plist holding contextual information." - ;; Protect - (setq text (replace-regexp-in-string - "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)" - "$\\" text nil t 1)) - - ;; Handle quotation marks - (setq text (org-e-man--quotation-marks text info)) - - ;; Handle break preservation if required. - - (when (plist-get info :preserve-breaks) - (setq text (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" - text))) - ;; Return value. - text) + (let ((output text)) + ;; Protect various chars. + (setq output (replace-regexp-in-string + "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)" + "$\\" output nil t 1)) + ;; Activate smart quotes. Be sure to provide original TEXT string + ;; since OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :utf-8 info text))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n" + output))) + ;; Return value. + output)) -;;;; Planning -;;;; Property Drawer +;;; Planning -;;;; Quote Block +;;; Property Drawer -(defun org-e-man-quote-block (quote-block contents info) + +;;; Quote Block + +(defun org-man-quote-block (quote-block contents info) "Transcode a QUOTE-BLOCK element from Org to Man. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." - (org-e-man--wrap-label + (org-man--wrap-label quote-block (format ".RS\n%s\n.RE" contents))) +;;; Quote Section -;;;; Quote Section - -(defun org-e-man-quote-section (quote-section contents info) +(defun org-man-quote-section (quote-section contents info) "Transcode a QUOTE-SECTION element from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." (let ((value (org-remove-indentation @@ -835,150 +743,139 @@ CONTENTS is nil. INFO is a plist holding contextual information." (when value (format ".RS\\fI%s\\fP\n.RE\n" value)))) -;;;; Radio Target +;;; Radio Target -(defun org-e-man-radio-target (radio-target text info) +(defun org-man-radio-target (radio-target text info) "Transcode a RADIO-TARGET object from Org to Man. TEXT is the text of the target. INFO is a plist holding contextual information." - text) + text ) -;;;; Section +;;; Section -(defun org-e-man-section (section contents info) +(defun org-man-section (section contents info) "Transcode a SECTION element from Org to Man. CONTENTS holds the contents of the section. INFO is a plist holding contextual information." contents) -;;;; Special Block +;;; Special Block -(defun org-e-man-special-block (special-block contents info) +(defun org-man-special-block (special-block contents info) "Transcode a SPECIAL-BLOCK element from Org to Man. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let ((type (downcase (org-element-property :type special-block)))) - (org-e-man--wrap-label + (org-man--wrap-label special-block (format "%s\n" contents)))) -;;;; Src Block +;;; Src Block -(defun org-e-man-src-block (src-block contents info) +(defun org-man-src-block (src-block contents info) "Transcode a SRC-BLOCK element from Org to Man. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let* ((lang (org-element-property :language src-block)) - (caption (org-element-property :caption src-block)) - (label (org-element-property :name src-block)) (code (org-element-property :value src-block)) (custom-env (and lang (cadr (assq (intern lang) - org-e-man-custom-lang-environments)))) + org-man-custom-lang-environments)))) (num-start (case (org-element-property :number-lines src-block) (continued (org-export-get-loc src-block info)) (new 0))) (retain-labels (org-element-property :retain-labels src-block))) (cond ;; Case 1. No source fontification. - ((not org-e-man-source-highlight) - (let ((caption-str (org-e-man--caption/label-string caption label info))) - (concat - (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n" - (org-export-format-code-default src-block info))))) - ((and org-e-man-source-highlight) - (let* ((tmpdir (if (featurep 'xemacs) - temp-directory - temporary-file-directory)) + ((not org-man-source-highlight) + (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n" + (org-export-format-code-default src-block info))) + (org-man-source-highlight + (let* ((tmpdir (if (featurep 'xemacs) + temp-directory + temporary-file-directory )) - (in-file (make-temp-name - (expand-file-name "srchilite" tmpdir))) - (out-file (make-temp-name - (expand-file-name "reshilite" tmpdir))) + (in-file (make-temp-name + (expand-file-name "srchilite" tmpdir))) + (out-file (make-temp-name + (expand-file-name "reshilite" tmpdir))) - (org-lang (org-element-property :language src-block)) - (lst-lang (cadr (assq (intern org-lang) - org-e-man-source-highlight-langs))) + (org-lang (org-element-property :language src-block)) + (lst-lang (cadr (assq (intern org-lang) + org-man-source-highlight-langs))) - (cmd (concat "source-highlight" - " -s " lst-lang - " -f groff_man " - " -i " in-file - " -o " out-file))) + (cmd (concat "source-highlight" + " -s " lst-lang + " -f groff_man " + " -i " in-file + " -o " out-file))) - (if lst-lang - (let ((code-block "")) - (with-temp-file in-file (insert code)) - (shell-command cmd) - (setq code-block (org-file-contents out-file)) - (delete-file in-file) - (delete-file out-file) - code-block) - (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" - code))))))) + (if lst-lang + (let ((code-block "")) + (with-temp-file in-file (insert code)) + (shell-command cmd) + (setq code-block (org-file-contents out-file)) + (delete-file in-file) + (delete-file out-file) + code-block) + (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code))))))) -;;;; Statistics Cookie +;;; Statistics Cookie -(defun org-e-man-statistics-cookie (statistics-cookie contents info) +(defun org-man-statistics-cookie (statistics-cookie contents info) "Transcode a STATISTICS-COOKIE object from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." (org-element-property :value statistics-cookie)) -;;;; Strike-Through +;;; Strike-Through -(defun org-e-man-strike-through (strike-through contents info) +(defun org-man-strike-through (strike-through contents info) "Transcode STRIKE-THROUGH from Org to Man. CONTENTS is the text with strike-through markup. INFO is a plist holding contextual information." (format "\\fI%s\\fP" contents)) +;;; Subscript -;;;; Subscript - -(defun org-e-man-subscript (subscript contents info) +(defun org-man-subscript (subscript contents info) "Transcode a SUBSCRIPT object from Org to Man. CONTENTS is the contents of the object. INFO is a plist holding contextual information." (format "\\d\\s-2%s\\s+2\\u" contents)) +;;; Superscript "^_%s$ -;;;; Superscript "^_%s$ - -(defun org-e-man-superscript (superscript contents info) +(defun org-man-superscript (superscript contents info) "Transcode a SUPERSCRIPT object from Org to Man. CONTENTS is the contents of the object. INFO is a plist holding contextual information." (format "\\u\\s-2%s\\s+2\\d" contents)) -;;;; Table +;;; Table ;; -;; `org-e-man-table' is the entry point for table transcoding. It +;; `org-man-table' is the entry point for table transcoding. It ;; takes care of tables with a "verbatim" attribute. Otherwise, it -;; delegates the job to either `org-e-man-table--table.el-table' or -;; `org-e-man-table--org-table' functions, depending of the type of +;; delegates the job to either `org-man-table--table.el-table' or +;; `org-man-table--org-table' functions, depending of the type of ;; the table. ;; -;; `org-e-man-table--align-string' is a subroutine used to build +;; `org-man-table--align-string' is a subroutine used to build ;; alignment string for Org tables. -(defun org-e-man-table (table contents info) +(defun org-man-table (table contents info) "Transcode a TABLE element from Org to Man. CONTENTS is the contents of the table. INFO is a plist holding contextual information." (cond ;; Case 1: verbatim table. - ((or org-e-man-tables-verbatim - (let ((attr - (read - (format - "(%s)" + ((or org-man-tables-verbatim + (let ((attr (read (format "(%s)" (mapconcat #'identity (org-element-property :attr_man table) @@ -992,42 +889,40 @@ contextual information." (org-element-interpret-data `(table nil ,@(org-element-contents table)))))) ;; Case 2: Standard table. - (t (org-e-man-table--org-table table contents info)))) + (t (org-man-table--org-table table contents info)))) -(defun org-e-man-table--align-string (divider table info) +(defun org-man-table--align-string (divider table info) "Return an appropriate Man alignment string. TABLE is the considered table. INFO is a plist used as a communication channel." -(let (alignment) - ;; Extract column groups and alignment from first (non-rule) - ;; row. - (org-element-map - (org-element-map - table 'table-row - (lambda (row) - (and (eq (org-element-property :type row) 'standard) row)) - info 'first-match) - 'table-cell - (lambda (cell) - (let* ((borders (org-export-table-cell-borders cell info)) - (raw-width (org-export-table-cell-width cell info)) - (width-cm (when raw-width (/ raw-width 5))) - (width (if raw-width (format "w(%dc)" - (if (< width-cm 1) 1 width-cm)) ""))) - ;; Check left border for the first cell only. - (when (and (memq 'left borders) (not alignment)) - (push "|" alignment)) - (push - (case (org-export-table-cell-alignment cell info) - (left (concat "l" width divider)) - (right (concat "r" width divider)) - (center (concat "c" width divider))) - alignment) - (when (memq 'right borders) (push "|" alignment)))) - info) - (apply 'concat (reverse alignment)))) + (let (alignment) + ;; Extract column groups and alignment from first (non-rule) row. + (org-element-map + (org-element-map table 'table-row + (lambda (row) + (and (eq (org-element-property :type row) 'standard) row)) + info 'first-match) + 'table-cell + (lambda (cell) + (let* ((borders (org-export-table-cell-borders cell info)) + (raw-width (org-export-table-cell-width cell info)) + (width-cm (when raw-width (/ raw-width 5))) + (width (if raw-width (format "w(%dc)" + (if (< width-cm 1) 1 width-cm)) ""))) + ;; Check left border for the first cell only. + (when (and (memq 'left borders) (not alignment)) + (push "|" alignment)) + (push + (case (org-export-table-cell-alignment cell info) + (left (concat "l" width divider)) + (right (concat "r" width divider)) + (center (concat "c" width divider))) + alignment) + (when (memq 'right borders) (push "|" alignment)))) + info) + (apply 'concat (reverse alignment)))) -(defun org-e-man-table--org-table (table contents info) +(defun org-man-table--org-table (table contents info) "Return appropriate Man code for an Org table. TABLE is the table type element to transcode. CONTENTS is its @@ -1035,123 +930,115 @@ contents, as a string. INFO is a plist used as a communication channel. This function assumes TABLE has `org' as its `:type' attribute." - (let* ((label (org-element-property :name table)) - (caption (org-e-man--caption/label-string - (org-element-property :caption table) label info)) - (attr - (read - (format - "(%s)" - (mapconcat - #'identity - (org-element-property :attr_man table) - " ")))) - - (divider (if (plist-get attr :divider) - "|" - " ")) + (let* ((attr (org-export-read-attribute :attr_man table)) + (label (org-element-property :name table)) + (caption (and (not (plist-get attr :disable-caption)) + (org-man--caption/label-string table info))) + (divider (if (plist-get attr :divider) "|" " ")) ;; Determine alignment string. - (alignment (org-e-man-table--align-string divider table info)) + (alignment (org-man-table--align-string divider table info)) ;; Extract others display options. + (lines (org-split-string contents "\n")) (attr-list - (let ((result-list '())) - (dolist (attr-item - (list - (if (plist-get attr :expand) - "expand" - nil) + (delq nil + (list + (and (plist-get attr :expand) "expand") + (let ((placement (plist-get attr :placement))) + (cond ((string= placement 'center) "center") + ((string= placement 'left) nil) + (t (if org-man-tables-centered "center" "")))) + (or (plist-get attr :boxtype) "box")))) - (case (plist-get attr :placement) - ('center "center") - ('left nil) - (t - (if org-e-man-tables-centered - "center" ""))) + (title-line (plist-get attr :title-line)) + (long-cells (plist-get attr :long-cells)) - (case (plist-get attr :boxtype) - ('box "box") - ('doublebox "doublebox") - ('allbox "allbox") - ('none nil) - (t "box")))) + (table-format (concat + (format "%s" (or (car attr-list) "" )) + (or + (let ((output-list '())) + (when (cdr attr-list) + (dolist (attr-item (cdr attr-list)) + (setq output-list (concat output-list (format ",%s" attr-item))))) + output-list) + ""))) - (if attr-item - (add-to-list 'result-list attr-item))) - result-list)) - - - (title-line (plist-get attr :title-line)) - - (table-format - (concat - (format "%s" - (or (car attr-list) "")) - (or - (let ((output-list '())) - (when (cdr attr-list) - (dolist (attr-item (cdr attr-list)) - (setq output-list (concat output-list (format ",%s" attr-item))))) - output-list) - ""))) - - (first-line - (when lines (org-split-string (car lines) "\t")))) + (first-line (when lines (org-split-string (car lines) "\t")))) ;; Prepare the final format string for the table. + (cond ;; Others. (lines (concat ".TS\n " table-format ";\n" (format "%s.\n" (let ((final-line "")) - (when title-line (dotimes (i (length first-line)) (setq final-line (concat final-line "cb" divider)))) (setq final-line (concat final-line "\n")) + (if alignment (setq final-line (concat final-line alignment)) (dotimes (i (length first-line)) (setq final-line (concat final-line "c" divider)))) + final-line )) + + (format "%s.TE\n" + (let ((final-line "") + (long-line "") + (lines (org-split-string contents "\n"))) + + (dolist (line-item lines) + (setq long-line "") + + (if long-cells + (progn + (if (string= line-item "_") + (setq long-line (format "%s\n" line-item)) + ;; else string = + (let ((cell-item-list (org-split-string line-item "\t"))) + (dolist (cell-item cell-item-list) + + (cond ((eq cell-item (car (last cell-item-list))) + (setq long-line (concat long-line + (format "T{\n%s\nT}\t\n" cell-item )))) + (t + (setq long-line (concat long-line + (format "T{\n%s\nT}\t" cell-item )))))) + long-line)) + ;; else long cells + (setq final-line (concat final-line long-line ))) + + (setq final-line (concat final-line line-item "\n")))) final-line)) - (format "%s.TE" - (let ((final-line "")) - (dolist (line-item lines) - (cond - (t - (setq lines (org-split-string contents "\n")) + (and caption (format ".TB \"%s\"" caption))))))) - (setq final-line (concat final-line - (car (org-split-string line-item "\\\\")) "\n"))))) - final-line))))))) +;;; Table Cell - -;;;; Table Cell - -(defun org-e-man-table-cell (table-cell contents info) +(defun org-man-table-cell (table-cell contents info) "Transcode a TABLE-CELL element from Org to Man CONTENTS is the cell contents. INFO is a plist used as a communication channel." - (concat (if (and contents - org-e-man-table-scientific-notation - (string-match orgtbl-exp-regexp contents)) - ;; Use appropriate format string for scientific - ;; notation. - (format org-e-man-table-scientific-notation - (match-string 1 contents) - (match-string 2 contents)) - contents) - (when (org-export-get-next-element table-cell info) " \t "))) + (concat (if (and contents + org-man-table-scientific-notation + (string-match orgtbl-exp-regexp contents)) + ;; Use appropriate format string for scientific + ;; notation. + (format org-man-table-scientific-notation + (match-string 1 contents) + (match-string 2 contents)) + contents ) + (when (org-export-get-next-element table-cell info) "\t"))) -;;;; Table Row +;;; Table Row -(defun org-e-man-table-row (table-row contents info) +(defun org-man-table-row (table-row contents info) "Transcode a TABLE-ROW element from Org to Man CONTENTS is the contents of the row. INFO is a plist used as a communication channel." @@ -1167,19 +1054,20 @@ a communication channel." (org-export-table-cell-borders (car (org-element-contents table-row)) info))) (concat - ;; Mark "hline" for horizontal lines. + ;; Mark horizontal lines (cond ((and (memq 'top borders) (memq 'above borders)) "_\n")) - contents "\\\\\n" + contents + (cond ;; When BOOKTABS are activated enforce bottom rule even when ;; no hline was specifically marked. - ((and (memq 'bottom borders) (memq 'below borders)) "_\n") - ((memq 'below borders) "_")))))) + ((and (memq 'bottom borders) (memq 'below borders)) "\n_") + ((memq 'below borders) "\n_")))))) -;;;; Target +;;; Target -(defun org-e-man-target (target contents info) +(defun org-man-target (target contents info) "Transcode a TARGET object from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1187,36 +1075,36 @@ information." (org-export-solidify-link-text (org-element-property :value target)))) -;;;; Timestamp +;;; Timestamp -(defun org-e-man-timestamp (timestamp contents info) +(defun org-man-timestamp (timestamp contents info) "Transcode a TIMESTAMP object from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." - "") + "" ) -;;;; Underline +;;; Underline -(defun org-e-man-underline (underline contents info) +(defun org-man-underline (underline contents info) "Transcode UNDERLINE from Org to Man. CONTENTS is the text with underline markup. INFO is a plist holding contextual information." (format "\\fI%s\\fP" contents)) -;;;; Verbatim +;;; Verbatim -(defun org-e-man-verbatim (verbatim contents info) +(defun org-man-verbatim (verbatim contents info) "Transcode a VERBATIM object from Org to Man. CONTENTS is nil. INFO is a plist used as a communication channel." (format ".nf\n%s\n.fi" contents)) -;;;; Verse Block +;;; Verse Block -(defun org-e-man-verse-block (verse-block contents info) +(defun org-man-verse-block (verse-block contents info) "Transcode a VERSE-BLOCK element from Org to Man. CONTENTS is verse block contents. INFO is a plist holding contextual information." @@ -1226,8 +1114,8 @@ contextual information." ;;; Interactive functions -(defun org-e-man-export-to-man - (&optional subtreep visible-only body-only ext-plist pub-dir) +(defun org-man-export-to-man + (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to a Man file. If narrowing is active in the current buffer, only export its @@ -1235,6 +1123,10 @@ narrowed part. If a region is active, export that region. +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + When optional argument SUBTREEP is non-nil, export the sub-tree at point, extracting information from the headline properties first. @@ -1249,17 +1141,20 @@ EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to file-local settings. -When optional argument PUB-DIR is set, use it as the publishing -directory. - Return output file's name." (interactive) - (let ((outfile (org-export-output-file-name ".man" subtreep pub-dir))) - (org-export-to-file - 'e-man outfile subtreep visible-only body-only ext-plist))) + (let ((outfile (org-export-output-file-name ".man" subtreep))) + (if async + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'man)) + `(expand-file-name + (org-export-to-file + 'man ,outfile ,subtreep ,visible-only ,body-only ',ext-plist))) + (org-export-to-file + 'man outfile subtreep visible-only body-only ext-plist)))) -(defun org-e-man-export-to-pdf - (&optional subtreep visible-only body-only ext-plist pub-dir) +(defun org-man-export-to-pdf + (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to Groff then process through to PDF. If narrowing is active in the current buffer, only export its @@ -1267,6 +1162,10 @@ narrowed part. If a region is active, export that region. +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + When optional argument SUBTREEP is non-nil, export the sub-tree at point, extracting information from the headline properties first. @@ -1281,73 +1180,78 @@ EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to file-local settings. -When optional argument PUB-DIR is set, use it as the publishing -directory. - Return PDF file's name." (interactive) - (org-e-man-compile - (org-e-man-export-to-man - subtreep visible-only body-only ext-plist pub-dir))) + (if async + (let ((outfile (org-export-output-file-name ".man" subtreep))) + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'man)) + `(expand-file-name + (org-man-compile + (org-export-to-file + 'man ,outfile ,subtreep ,visible-only ,body-only + ',ext-plist))))) + (org-man-compile + (org-man-export-to-man nil subtreep visible-only body-only ext-plist)))) -(defun org-e-man-compile (grofffile) +(defun org-man-compile (file) "Compile a Groff file. -GROFFFILE is the name of the file being compiled. Processing is -done through the command specified in `org-e-man-pdf-process'. +FILE is the name of the file being compiled. Processing is done +through the command specified in `org-man-pdf-process'. Return PDF file name or an error if it couldn't be produced." - (let* ((wconfig (current-window-configuration)) - (grofffile (file-truename grofffile)) - (base (file-name-sans-extension grofffile)) + (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) + (full-name (file-truename file)) + (out-dir (file-name-directory file)) + ;; Make sure `default-directory' is set to FILE directory, + ;; not to whatever value the current buffer may have. + (default-directory (file-name-directory full-name)) errors) - (message (format "Processing Groff file %s ..." grofffile)) - (unwind-protect - (progn - (cond - ;; A function is provided: Apply it. - ((functionp org-e-man-pdf-process) - (funcall org-e-man-pdf-process (shell-quote-argument grofffile))) - ;; A list is provided: Replace %b, %f and %o with appropriate - ;; values in each command before applying it. Output is - ;; redirected to "*Org PDF Groff Output*" buffer. - ((consp org-e-man-pdf-process) - (let* ((out-dir (or (file-name-directory grofffile) "./")) - (outbuf (get-buffer-create "*Org PDF Groff Output*"))) - (mapc - (lambda (command) - (shell-command - (replace-regexp-in-string - "%b" (shell-quote-argument base) - (replace-regexp-in-string - "%f" (shell-quote-argument grofffile) - (replace-regexp-in-string - "%o" (shell-quote-argument out-dir) command t t) t t) t t) - outbuf)) - org-e-man-pdf-process) - ;; Collect standard errors from output buffer. - (setq errors (org-e-man-collect-errors outbuf)))) - (t (error "No valid command to process to PDF"))) - (let ((pdffile (concat base ".pdf"))) - ;; Check for process failure. Provide collected errors if - ;; possible. - (if (not (file-exists-p pdffile)) - (error (concat (format "PDF file %s wasn't produced" pdffile) - (when errors (concat ": " errors)))) - ;; Else remove log files, when specified, and signal end of - ;; process to user, along with any error encountered. - (when org-e-man-remove-logfiles - (dolist (ext org-e-man-logfiles-extensions) - (let ((file (concat base "." ext))) - (when (file-exists-p file) (delete-file file))))) - (message (concat "Process completed" - (if (not errors) "." - (concat " with errors: " errors))))) - ;; Return output file name. - pdffile)) - (set-window-configuration wconfig)))) + (message (format "Processing Groff file %s..." file)) + (save-window-excursion + (cond + ;; A function is provided: Apply it. + ((functionp org-man-pdf-process) + (funcall org-man-pdf-process (shell-quote-argument file))) + ;; A list is provided: Replace %b, %f and %o with appropriate + ;; values in each command before applying it. Output is + ;; redirected to "*Org PDF Groff Output*" buffer. + ((consp org-man-pdf-process) + (let ((outbuf (get-buffer-create "*Org PDF Groff Output*"))) + (mapc + (lambda (command) + (shell-command + (replace-regexp-in-string + "%b" (shell-quote-argument base-name) + (replace-regexp-in-string + "%f" (shell-quote-argument full-name) + (replace-regexp-in-string + "%o" (shell-quote-argument out-dir) command t t) t t) t t) + outbuf)) + org-man-pdf-process) + ;; Collect standard errors from output buffer. + (setq errors (org-man-collect-errors outbuf)))) + (t (error "No valid command to process to PDF"))) + (let ((pdffile (concat out-dir base-name ".pdf"))) + ;; Check for process failure. Provide collected errors if + ;; possible. + (if (not (file-exists-p pdffile)) + (error (concat (format "PDF file %s wasn't produced" pdffile) + (when errors (concat ": " errors)))) + ;; Else remove log files, when specified, and signal end of + ;; process to user, along with any error encountered. + (when org-man-remove-logfiles + (dolist (ext org-man-logfiles-extensions) + (let ((file (concat out-dir base-name "." ext))) + (when (file-exists-p file) (delete-file file))))) + (message (concat "Process completed" + (if (not errors) "." + (concat " with errors: " errors))))) + ;; Return output file name. + pdffile)))) -(defun org-e-man-collect-errors (buffer) +(defun org-man-collect-errors (buffer) "Collect some kind of errors from \"groff\" output BUFFER is the buffer containing output. Return collected error types as a string, or nil if there was @@ -1356,8 +1260,13 @@ none." (save-excursion (goto-char (point-max)) ;; Find final run - nil))) + nil ))) -(provide 'org-e-man) -;;; org-e-man.el ends here +(provide 'ox-man) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-man.el ends here diff --git a/contrib/lisp/org-md.el b/lisp/ox-md.el similarity index 69% rename from contrib/lisp/org-md.el rename to lisp/ox-md.el index b9919e93a..61f42b864 100644 --- a/contrib/lisp/org-md.el +++ b/lisp/ox-md.el @@ -1,27 +1,27 @@ -;;; org-md.el --- Markdown Back-End for Org Export Engine +;;; ox-md.el --- Markdown Back-End for Org Export Engine ;; Copyright (C) 2012, 2013 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou -;; Keywords: org, wp, tex +;; Keywords: org, wp, markdown -;; This program is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This library implements a Markdown back-end (vanilla flavour) for -;; Org exporter, based on `e-html'. +;; Org exporter, based on `html' back-end. ;; ;; It provides two commands for export, depending on the desired ;; output: `org-md-export-as-markdown' (temporary buffer) and @@ -29,7 +29,8 @@ ;;; Code: -(require 'org-e-html) +(eval-when-compile (require 'cl)) +(require 'ox-html) @@ -39,7 +40,8 @@ "Options specific to Markdown export back-end." :tag "Org Markdown" :group 'org-export - :version "24.2") + :version "24.4" + :package-version '(Org . "8.0")) (defcustom org-md-headline-style 'atx "Style used to format headlines. @@ -53,30 +55,43 @@ This variable can be set to either `atx' or `setext'." ;;; Define Back-End -(org-export-define-derived-backend md e-html - :export-block ("MD" "MARKDOWN") - :filters-alist ((:filter-parse-tree . org-md-separate-elements)) - :translate-alist ((bold . org-md-bold) - (code . org-md-verbatim) - (example-block . org-md-example-block) - (footnote-definition . ignore) - (footnote-reference . ignore) - (headline . org-md-headline) - (horizontal-rule . org-md-horizontal-rule) - (inline-src-block . org-md-verbatim) - (italic . org-md-italic) - (item . org-md-item) - (line-break . org-md-line-break) - (link . org-md-link) - (paragraph . org-md-paragraph) - (plain-list . org-md-plain-list) - (plain-text . org-md-plain-text) - (quote-block . org-md-quote-block) - (quote-section . org-md-example-block) - (section . org-md-section) - (src-block . org-md-example-block) - (template . org-md-template) - (verbatim . org-md-verbatim))) +(org-export-define-derived-backend 'md 'html + :export-block '("MD" "MARKDOWN") + :filters-alist '((:filter-parse-tree . org-md-separate-elements)) + :menu-entry + '(?m "Export to Markdown" + ((?M "To temporary buffer" + (lambda (a s v b) (org-md-export-as-markdown a s v))) + (?m "To file" (lambda (a s v b) (org-md-export-to-markdown a s v))) + (?o "To file and open" + (lambda (a s v b) + (if a (org-md-export-to-markdown t s v) + (org-open-file (org-md-export-to-markdown nil s v))))))) + :translate-alist '((bold . org-md-bold) + (code . org-md-verbatim) + (underline . org-md-verbatim) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (example-block . org-md-example-block) + (fixed-width . org-md-example-block) + (footnote-definition . ignore) + (footnote-reference . ignore) + (headline . org-md-headline) + (horizontal-rule . org-md-horizontal-rule) + (inline-src-block . org-md-verbatim) + (italic . org-md-italic) + (item . org-md-item) + (line-break . org-md-line-break) + (link . org-md-link) + (paragraph . org-md-paragraph) + (plain-list . org-md-plain-list) + (plain-text . org-md-plain-text) + (quote-block . org-md-quote-block) + (quote-section . org-md-example-block) + (section . org-md-section) + (src-block . org-md-example-block) + (template . org-md-template) + (verbatim . org-md-verbatim))) @@ -89,14 +104,13 @@ TREE is the parse tree being exported. BACKEND is the export back-end used. INFO is a plist used as a communication channel. Assume BACKEND is `md'." - (org-element-map - tree org-element-all-elements - (lambda (elem) - (unless (eq (org-element-type elem) 'org-data) - (org-element-put-property - elem :post-blank - (let ((post-blank (org-element-property :post-blank elem))) - (if (not post-blank) 1 (max 1 post-blank))))))) + (org-element-map tree org-element-all-elements + (lambda (elem) + (unless (eq (org-element-type elem) 'org-data) + (org-element-put-property + elem :post-blank + (let ((post-blank (org-element-property :post-blank elem))) + (if (not post-blank) 1 (max 1 post-blank))))))) ;; Return updated tree. tree) @@ -165,7 +179,7 @@ a communication channel." ;; Headline text without tags. (heading (concat todo priority title))) (cond - ;; Cannot create an headline. Fall-back to a list. + ;; Cannot create a headline. Fall-back to a list. ((or (org-export-low-level-p headline info) (not (memq org-md-headline-style '(atx setext))) (and (eq org-md-headline-style 'atx) (> level 6)) @@ -241,7 +255,7 @@ a communication channel." "Transcode LINE-BREAK object into Markdown format. CONTENTS is nil. INFO is a plist used as a communication channel." - " ") + " \n") ;;;; Link @@ -254,9 +268,9 @@ a communication channel." (function (lambda (raw-path info) ;; Treat links to `file.org' as links to `file.html', if - ;; needed. See `org-e-html-link-org-files-as-html'. + ;; needed. See `org-html-link-org-files-as-html'. (cond - ((and org-e-html-link-org-files-as-html + ((and org-html-link-org-files-as-html (string= ".org" (downcase (file-name-extension raw-path ".")))) (concat (file-name-sans-extension raw-path) "." @@ -278,13 +292,15 @@ a communication channel." (org-export-get-headline-number destination info) "."))))))) - ((org-export-inline-image-p link org-e-html-inline-image-rules) - (format "![%s](%s)" - (let ((caption - (org-element-property - :caption (org-export-get-parent-element link)))) - (when caption (org-export-data (car caption) info))) - path)) + ((org-export-inline-image-p link org-html-inline-image-rules) + (let ((path (let ((raw-path (org-element-property :path link))) + (if (not (file-name-absolute-p raw-path)) raw-path + (expand-file-name raw-path))))) + (format "![%s](%s)" + (let ((caption (org-export-get-caption + (org-export-get-parent-element link)))) + (when caption (org-export-data caption info))) + path))) ((string= type "coderef") (let ((ref (org-element-property :path link))) (format (org-export-get-coderef-format ref contents) @@ -294,23 +310,17 @@ a communication channel." (org-export-data (org-element-contents destination) info))) ((equal type "fuzzy") (let ((destination (org-export-resolve-fuzzy-link link info))) - ;; Ignore invisible "#+TARGET: path". - (unless (eq (org-element-type destination) 'keyword) - (if (org-string-nw-p contents) contents - (when destination - (let ((number (org-export-get-ordinal destination info))) - (when number - (if (atom number) (number-to-string number) - (mapconcat 'number-to-string number "."))))))))) + (if (org-string-nw-p contents) contents + (when destination + (let ((number (org-export-get-ordinal destination info))) + (when number + (if (atom number) (number-to-string number) + (mapconcat 'number-to-string number ".")))))))) (t (let* ((raw-path (org-element-property :path link)) (path (cond ((member type '("http" "https" "ftp")) (concat type ":" raw-path)) ((equal type "file") - ;; Extract just the file path and strip - ;; all other components. - (when (string-match "\\(.+\\)::.+" raw-path) - (setq raw-path (match-string 1 raw-path))) ;; Treat links to ".org" files as ".html", ;; if needed. (setq raw-path @@ -353,6 +363,8 @@ a communication channel." "Transcode a TEXT string into Markdown format. TEXT is the string to transcode. INFO is a plist holding contextual information." + (when (plist-get info :with-smart-quotes) + (setq text (org-export-activate-smart-quotes text :html info))) ;; Protect ambiguous #. This will protect # at the beginning of ;; a line, but not at the beginning of a paragraph. See ;; `org-md-paragraph'. @@ -360,12 +372,10 @@ contextual information." ;; Protect ambiguous ! (setq text (replace-regexp-in-string "\\(!\\)\\[" "\\\\!" text nil nil 1)) ;; Protect `, *, _ and \ - (setq text - (replace-regexp-in-string - "[`*_\\]" (lambda (rep) (concat "\\\\" (match-string 1 rep))) text)) + (setq text (replace-regexp-in-string "[`*_\\]" "\\\\\\&" text)) ;; Handle special strings, if required. (when (plist-get info :with-special-strings) - (setq text (org-e-html-convert-special-strings text))) + (setq text (org-html-convert-special-strings text))) ;; Handle break preservation, if required. (when (plist-get info :preserve-breaks) (setq text (replace-regexp-in-string "[ \t]*\n" " \n" text))) @@ -406,14 +416,18 @@ as a communication channel." ;;; Interactive function ;;;###autoload -(defun org-md-export-as-markdown (&optional subtreep visible-only) - "Export current buffer to a text buffer. +(defun org-md-export-as-markdown (&optional async subtreep visible-only) + "Export current buffer to a Markdown buffer. If narrowing is active in the current buffer, only export its narrowed part. If a region is active, export that region. +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + When optional argument SUBTREEP is non-nil, export the sub-tree at point, extracting information from the headline properties first. @@ -425,15 +439,34 @@ Export is done in a buffer named \"*Org MD Export*\", which will be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) - (let ((outbuf (org-export-to-buffer - 'md "*Org MD Export*" subtreep visible-only))) - (with-current-buffer outbuf (text-mode)) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window outbuf)))) + (if async + (org-export-async-start + (lambda (output) + (with-current-buffer (get-buffer-create "*Org MD Export*") + (erase-buffer) + (insert output) + (goto-char (point-min)) + (text-mode) + (org-export-add-to-stack (current-buffer) 'md))) + `(org-export-as 'md ,subtreep ,visible-only)) + (let ((outbuf (org-export-to-buffer + 'md "*Org MD Export*" subtreep visible-only))) + (with-current-buffer outbuf (text-mode)) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window outbuf))))) + +;;;###autoload +(defun org-md-convert-region-to-md () + "Assume the current region has org-mode syntax, and convert it to Markdown. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in a Markdown buffer and use +this command to convert it." + (interactive) + (org-export-replace-region-by 'md)) ;;;###autoload -(defun org-md-export-to-markdown (&optional subtreep visible-only pub-dir) +(defun org-md-export-to-markdown (&optional async subtreep visible-only) "Export current buffer to a Markdown file. If narrowing is active in the current buffer, only export its @@ -441,6 +474,10 @@ narrowed part. If a region is active, export that region. +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + When optional argument SUBTREEP is non-nil, export the sub-tree at point, extracting information from the headline properties first. @@ -448,14 +485,21 @@ first. When optional argument VISIBLE-ONLY is non-nil, don't export contents of hidden elements. -When optional argument PUB-DIR is set, use it as the publishing -directory. - Return output file's name." (interactive) - (let ((outfile (org-export-output-file-name ".md" subtreep pub-dir))) - (org-export-to-file 'md outfile subtreep visible-only))) + (let ((outfile (org-export-output-file-name ".md" subtreep))) + (if async + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'md)) + `(expand-file-name + (org-export-to-file 'md ,outfile ,subtreep ,visible-only))) + (org-export-to-file 'md outfile subtreep visible-only)))) -(provide 'org-md) -;;; org-md.el ends here +(provide 'ox-md) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-md.el ends here diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el new file mode 100644 index 000000000..7e1390ef0 --- /dev/null +++ b/lisp/ox-odt.el @@ -0,0 +1,4419 @@ +;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode + +;; Copyright (C) 2010-2013 Free Software Foundation, Inc. + +;; Author: Jambunathan K +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(eval-when-compile + (require 'cl) + (require 'table)) +(require 'format-spec) +(require 'ox) +(require 'org-compat) + +;;; Define Back-End + +(org-export-define-backend 'odt + '((bold . org-odt-bold) + (center-block . org-odt-center-block) + (clock . org-odt-clock) + (code . org-odt-code) + (drawer . org-odt-drawer) + (dynamic-block . org-odt-dynamic-block) + (entity . org-odt-entity) + (example-block . org-odt-example-block) + (export-block . org-odt-export-block) + (export-snippet . org-odt-export-snippet) + (fixed-width . org-odt-fixed-width) + (footnote-definition . org-odt-footnote-definition) + (footnote-reference . org-odt-footnote-reference) + (headline . org-odt-headline) + (horizontal-rule . org-odt-horizontal-rule) + (inline-src-block . org-odt-inline-src-block) + (inlinetask . org-odt-inlinetask) + (italic . org-odt-italic) + (item . org-odt-item) + (keyword . org-odt-keyword) + (latex-environment . org-odt-latex-environment) + (latex-fragment . org-odt-latex-fragment) + (line-break . org-odt-line-break) + (link . org-odt-link) + (paragraph . org-odt-paragraph) + (plain-list . org-odt-plain-list) + (plain-text . org-odt-plain-text) + (planning . org-odt-planning) + (property-drawer . org-odt-property-drawer) + (quote-block . org-odt-quote-block) + (quote-section . org-odt-quote-section) + (radio-target . org-odt-radio-target) + (section . org-odt-section) + (special-block . org-odt-special-block) + (src-block . org-odt-src-block) + (statistics-cookie . org-odt-statistics-cookie) + (strike-through . org-odt-strike-through) + (subscript . org-odt-subscript) + (superscript . org-odt-superscript) + (table . org-odt-table) + (table-cell . org-odt-table-cell) + (table-row . org-odt-table-row) + (target . org-odt-target) + (template . org-odt-template) + (timestamp . org-odt-timestamp) + (underline . org-odt-underline) + (verbatim . org-odt-verbatim) + (verse-block . org-odt-verse-block)) + :export-block "ODT" + :filters-alist '((:filter-parse-tree + . (org-odt--translate-latex-fragments + org-odt--translate-description-lists + org-odt--translate-list-tables))) + :menu-entry + '(?o "Export to ODT" + ((?o "As ODT file" org-odt-export-to-odt) + (?O "As ODT file and open" + (lambda (a s v b) + (if a (org-odt-export-to-odt t s v) + (org-open-file (org-odt-export-to-odt nil s v) 'system)))))) + :options-alist + '((:odt-styles-file "ODT_STYLES_FILE" nil nil t) + ;; Redefine regular option. + (:with-latex nil "tex" org-odt-with-latex))) + + +;;; Dependencies + +;;; Hooks + +;;; Function Declarations + +(declare-function org-id-find-id-file "org-id" (id)) +(declare-function hfy-face-to-style "htmlfontify" (fn)) +(declare-function hfy-face-or-def-to-name "htmlfontify" (fn)) +(declare-function archive-zip-extract "arc-mode" (archive name)) +(declare-function org-create-math-formula "org" (latex-frag &optional mathml-file)) +(declare-function browse-url-file-url "browse-url" (file)) + + + +;;; Internal Variables + +(defconst org-odt-lib-dir + (file-name-directory load-file-name) + "Location of ODT exporter. +Use this to infer values of `org-odt-styles-dir' and +`org-odt-schema-dir'.") + +(defvar org-odt-data-dir + (expand-file-name "../../etc/" org-odt-lib-dir) + "Data directory for ODT exporter. +Use this to infer values of `org-odt-styles-dir' and +`org-odt-schema-dir'.") + +(defconst org-odt-special-string-regexps + '(("\\\\-" . "­\\1") ; shy + ("---\\([^-]\\)" . "—\\1") ; mdash + ("--\\([^-]\\)" . "–\\1") ; ndash + ("\\.\\.\\." . "…")) ; hellip + "Regular expressions for special string conversion.") + +(defconst org-odt-schema-dir-list + (list + (and org-odt-data-dir + (expand-file-name "./schema/" org-odt-data-dir)) ; bail out + (eval-when-compile + (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install + (expand-file-name "./schema/" org-odt-data-dir)))) + "List of directories to search for OpenDocument schema files. +Use this list to set the default value of +`org-odt-schema-dir'. The entries in this list are +populated heuristically based on the values of `org-odt-lib-dir' +and `org-odt-data-dir'.") + +(defconst org-odt-styles-dir-list + (list + (and org-odt-data-dir + (expand-file-name "./styles/" org-odt-data-dir)) ; bail out + (eval-when-compile + (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install + (expand-file-name "./styles/" org-odt-data-dir))) + (expand-file-name "../../etc/styles/" org-odt-lib-dir) ; git + (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa + (expand-file-name "./org/" data-directory) ; system + ) + "List of directories to search for OpenDocument styles files. +See `org-odt-styles-dir'. The entries in this list are populated +heuristically based on the values of `org-odt-lib-dir' and +`org-odt-data-dir'.") + +(defconst org-odt-styles-dir + (let* ((styles-dir + (catch 'styles-dir + (message "Debug (ox-odt): Searching for OpenDocument styles files...") + (mapc (lambda (styles-dir) + (when styles-dir + (message "Debug (ox-odt): Trying %s..." styles-dir) + (when (and (file-readable-p + (expand-file-name + "OrgOdtContentTemplate.xml" styles-dir)) + (file-readable-p + (expand-file-name + "OrgOdtStyles.xml" styles-dir))) + (message "Debug (ox-odt): Using styles under %s" + styles-dir) + (throw 'styles-dir styles-dir)))) + org-odt-styles-dir-list) + nil))) + (unless styles-dir + (error "Error (ox-odt): Cannot find factory styles files, aborting")) + styles-dir) + "Directory that holds auxiliary XML files used by the ODT exporter. + +This directory contains the following XML files - + \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These + XML files are used as the default values of + `org-odt-styles-file' and + `org-odt-content-template-file'. + +The default value of this variable varies depending on the +version of org in use and is initialized from +`org-odt-styles-dir-list'. Note that the user could be using org +from one of: org's own private git repository, GNU ELPA tar or +standard Emacs.") + +(defconst org-odt-bookmark-prefix "OrgXref.") + +(defconst org-odt-manifest-file-entry-tag + "\n") + +(defconst org-odt-file-extensions + '(("odt" . "OpenDocument Text") + ("ott" . "OpenDocument Text Template") + ("odm" . "OpenDocument Master Document") + ("ods" . "OpenDocument Spreadsheet") + ("ots" . "OpenDocument Spreadsheet Template") + ("odg" . "OpenDocument Drawing (Graphics)") + ("otg" . "OpenDocument Drawing Template") + ("odp" . "OpenDocument Presentation") + ("otp" . "OpenDocument Presentation Template") + ("odi" . "OpenDocument Image") + ("odf" . "OpenDocument Formula") + ("odc" . "OpenDocument Chart"))) + +(defconst org-odt-table-style-format + " + + + +" + "Template for auto-generated Table styles.") + +(defvar org-odt-automatic-styles '() + "Registry of automatic styles for various OBJECT-TYPEs. +The variable has the following form: +\(\(OBJECT-TYPE-A + \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\) + \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\) + \(OBJECT-TYPE-B + \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\) + \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\) + ...\). + +OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc. +OBJECT-PROPS is (typically) a plist created by passing +\"#+ATTR_ODT: \" option to `org-odt-parse-block-attributes'. + +Use `org-odt-add-automatic-style' to add update this variable.'") + +(defvar org-odt-object-counters nil + "Running counters for various OBJECT-TYPEs. +Use this to generate automatic names and style-names. See +`org-odt-add-automatic-style'.") + +(defvar org-odt-src-block-paragraph-format + " + + + + + " + "Custom paragraph style for colorized source and example blocks. +This style is much the same as that of \"OrgFixedWidthBlock\" +except that the foreground and background colors are set +according to the default face identified by the `htmlfontify'.") + +(defvar hfy-optimisations) +(defvar org-odt-embedded-formulas-count 0) +(defvar org-odt-embedded-images-count 0) +(defvar org-odt-image-size-probe-method + (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675 + '(emacs fixed)) + "Ordered list of methods for determining image sizes.") + +(defvar org-odt-default-image-sizes-alist + '(("as-char" . (5 . 0.4)) + ("paragraph" . (5 . 5))) + "Hardcoded image dimensions one for each of the anchor + methods.") + +;; A4 page size is 21.0 by 29.7 cms +;; The default page settings has 2cm margin on each of the sides. So +;; the effective text area is 17.0 by 25.7 cm +(defvar org-odt-max-image-size '(17.0 . 20.0) + "Limiting dimensions for an embedded image.") + +(defconst org-odt-label-styles + '(("math-formula" "%c" "text" "(%n)") + ("math-label" "(%n)" "text" "(%n)") + ("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 +\" SEQNO \". %c is replaced +with CAPTION. See `org-odt-format-label-definition'. + +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 +specifiers - %e and %n. %e is replaced with the CATEGORY-NAME. +%n is replaced with SEQNO. See +`org-odt-format-label-reference'.") + +(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") + ) + "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\\). + +CATEGORY_HANDLE identifies the captionable entity in question. + +OD-VARIABLE is the OpenDocument sequence counter associated with +the entity. These counters are declared within +\"...\" block of +`org-odt-content-template-file'. + +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'. + +ENUMERATOR-PREDICATE is used for assigning a sequence number to +the entity. See `org-odt--enumerate'.") + +(defvar org-odt-manifest-file-entries nil) +(defvar hfy-user-sheet-assoc) + +(defvar org-odt-zip-dir nil + "Temporary work directory for OpenDocument exporter.") + + + +;;; User Configuration Variables + +(defgroup org-export-odt nil + "Options for exporting Org mode files to ODT." + :tag "Org Export ODT" + :group 'org-export) + + +;;;; Debugging + +(defcustom org-odt-prettify-xml nil + "Specify whether or not the xml output should be prettified. +When this option is turned on, `indent-region' is run on all +component xml buffers before they are saved. Turn this off for +regular use. Turn this on if you need to examine the xml +visually." + :group 'org-export-odt + :version "24.1" + :type 'boolean) + + +;;;; Document schema + +(defcustom org-odt-schema-dir + (let* ((schema-dir + (catch 'schema-dir + (message "Debug (ox-odt): Searching for OpenDocument schema files...") + (mapc + (lambda (schema-dir) + (when schema-dir + (message "Debug (ox-odt): Trying %s..." schema-dir) + (when (and (file-expand-wildcards + (expand-file-name "od-manifest-schema*.rnc" + schema-dir)) + (file-expand-wildcards + (expand-file-name "od-schema*.rnc" + schema-dir)) + (file-readable-p + (expand-file-name "schemas.xml" schema-dir))) + (message "Debug (ox-odt): Using schema files under %s" + schema-dir) + (throw 'schema-dir schema-dir)))) + org-odt-schema-dir-list) + (message "Debug (ox-odt): No OpenDocument schema files installed") + nil))) + schema-dir) + "Directory that contains OpenDocument schema files. + +This directory contains: +1. rnc files for OpenDocument schema +2. a \"schemas.xml\" file that specifies locating rules needed + for auto validation of OpenDocument XML files. + +Use the customize interface to set this variable. This ensures +that `rng-schema-locating-files' is updated and auto-validation +of OpenDocument XML takes place based on the value +`rng-nxml-auto-validate-flag'. + +The default value of this variable varies depending on the +version of org in use and is initialized from +`org-odt-schema-dir-list'. The OASIS schema files are available +only in the org's private git repository. It is *not* bundled +with GNU ELPA tar or standard Emacs distribution." + :type '(choice + (const :tag "Not set" nil) + (directory :tag "Schema directory")) + :group 'org-export-odt + :version "24.1" + :set + (lambda (var value) + "Set `org-odt-schema-dir'. +Also add it to `rng-schema-locating-files'." + (let ((schema-dir value)) + (set var + (if (and + (file-expand-wildcards + (expand-file-name "od-manifest-schema*.rnc" schema-dir)) + (file-expand-wildcards + (expand-file-name "od-schema*.rnc" schema-dir)) + (file-readable-p + (expand-file-name "schemas.xml" schema-dir))) + schema-dir + (when value + (message "Error (ox-odt): %s has no OpenDocument schema files" + value)) + nil))) + (when org-odt-schema-dir + (eval-after-load 'rng-loc + '(add-to-list 'rng-schema-locating-files + (expand-file-name "schemas.xml" + org-odt-schema-dir)))))) + + +;;;; Document styles + +(defcustom org-odt-content-template-file nil + "Template file for \"content.xml\". +The exporter embeds the exported content just before +\"\" element. + +If unspecified, the file named \"OrgOdtContentTemplate.xml\" +under `org-odt-styles-dir' is used." + :type 'file + :group 'org-export-odt + :version "24.1") + +(defcustom org-odt-styles-file nil + "Default styles file for use with ODT export. +Valid values are one of: +1. nil +2. path to a styles.xml file +3. path to a *.odt or a *.ott file +4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2 +...)) + +In case of option 1, an in-built styles.xml is used. See +`org-odt-styles-dir' for more information. + +In case of option 3, the specified file is unzipped and the +styles.xml embedded therein is used. + +In case of option 4, the specified ODT-OR-OTT-FILE is unzipped +and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the +generated odt file. Use relative path for specifying the +FILE-MEMBERS. styles.xml must be specified as one of the +FILE-MEMBERS. + +Use options 1, 2 or 3 only if styles.xml alone suffices for +achieving the desired formatting. Use option 4, if the styles.xml +references additional files like header and footer images for +achieving the desired formatting. + +Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on +a per-file basis. For example, + +#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or +#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))." + :group 'org-export-odt + :version "24.1" + :type + '(choice + (const :tag "Factory settings" nil) + (file :must-match t :tag "styles.xml") + (file :must-match t :tag "ODT or OTT file") + (list :tag "ODT or OTT file + Members" + (file :must-match t :tag "ODF Text or Text Template file") + (cons :tag "Members" + (file :tag " Member" "styles.xml") + (repeat (file :tag "Member")))))) + +(defcustom org-odt-display-outline-level 2 + "Outline levels considered for enumerating captioned entities." + :group 'org-export-odt + :version "24.2" + :type 'integer) + +;;;; Document conversion + +(defcustom org-odt-convert-processes + '(("LibreOffice" + "soffice --headless --convert-to %f%x --outdir %d %i") + ("unoconv" + "unoconv -f %f -o %d %i")) + "Specify a list of document converters and their usage. +The converters in this list are offered as choices while +customizing `org-odt-convert-process'. + +This variable is a list where each element is of the +form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name +of the converter. CONVERTER-CMD is the shell command for the +converter and can contain format specifiers. These format +specifiers are interpreted as below: + +%i input file name in full +%I input file name as a URL +%f format of the output file +%o output file name in full +%O output file name as a URL +%d output dir in full +%D output dir as a URL. +%x extra options as set in `org-odt-convert-capabilities'." + :group 'org-export-odt + :version "24.1" + :type + '(choice + (const :tag "None" nil) + (alist :tag "Converters" + :key-type (string :tag "Converter Name") + :value-type (group (string :tag "Command line"))))) + +(defcustom org-odt-convert-process "LibreOffice" + "Use this converter to convert from \"odt\" format to other formats. +During customization, the list of converter names are populated +from `org-odt-convert-processes'." + :group 'org-export-odt + :version "24.1" + :type '(choice :convert-widget + (lambda (w) + (apply 'widget-convert (widget-type w) + (eval (car (widget-get w :args))))) + `((const :tag "None" nil) + ,@(mapcar (lambda (c) + `(const :tag ,(car c) ,(car c))) + org-odt-convert-processes)))) + +(defcustom org-odt-convert-capabilities + '(("Text" + ("odt" "ott" "doc" "rtf" "docx") + (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott") + ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html"))) + ("Web" + ("html") + (("pdf" "pdf") ("odt" "odt") ("html" "html"))) + ("Spreadsheet" + ("ods" "ots" "xls" "csv" "xlsx") + (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods") + ("xls" "xls") ("xlsx" "xlsx"))) + ("Presentation" + ("odp" "otp" "ppt" "pptx") + (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt") + ("pptx" "pptx") ("odg" "odg")))) + "Specify input and output formats of `org-odt-convert-process'. +More correctly, specify the set of input and output formats that +the user is actually interested in. + +This variable is an alist where each element is of the +form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST). +INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an +alist where each element is of the form (OUTPUT-FMT +OUTPUT-FILE-EXTENSION EXTRA-OPTIONS). + +The variable is interpreted as follows: +`org-odt-convert-process' can take any document that is in +INPUT-FMT-LIST and produce any document that is in the +OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have +OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT +serves dual purposes: +- It is used for populating completion candidates during + `org-odt-convert' commands. +- It is used as the value of \"%f\" specifier in + `org-odt-convert-process'. + +EXTRA-OPTIONS is used as the value of \"%x\" specifier in +`org-odt-convert-process'. + +DOCUMENT-CLASS is used to group a set of file formats in +INPUT-FMT-LIST in to a single class. + +Note that this variable inherently captures how LibreOffice based +converters work. LibreOffice maps documents of various formats +to classes like Text, Web, Spreadsheet, Presentation etc and +allow document of a given class (irrespective of it's source +format) to be converted to any of the export formats associated +with that class. + +See default setting of this variable for an typical +configuration." + :group 'org-export-odt + :version "24.1" + :type + '(choice + (const :tag "None" nil) + (alist :tag "Capabilities" + :key-type (string :tag "Document Class") + :value-type + (group (repeat :tag "Input formats" (string :tag "Input format")) + (alist :tag "Output formats" + :key-type (string :tag "Output format") + :value-type + (group (string :tag "Output file extension") + (choice + (const :tag "None" nil) + (string :tag "Extra options")))))))) + +(defcustom org-odt-preferred-output-format nil + "Automatically post-process to this format after exporting to \"odt\". +Command `org-odt-export-to-odt' exports first to \"odt\" format +and then uses `org-odt-convert-process' to convert the +resulting document to this format. During customization of this +variable, the list of valid values are populated based on +`org-odt-convert-capabilities'. + +You can set this option on per-file basis using file local +values. See Info node `(emacs) File Variables'." + :group 'org-export-odt + :version "24.1" + :type '(choice :convert-widget + (lambda (w) + (apply 'widget-convert (widget-type w) + (eval (car (widget-get w :args))))) + `((const :tag "None" nil) + ,@(mapcar (lambda (c) + `(const :tag ,c ,c)) + (org-odt-reachable-formats "odt"))))) +;;;###autoload +(put 'org-odt-preferred-output-format 'safe-local-variable 'stringp) + + +;;;; Drawers + +(defcustom org-odt-format-drawer-function nil + "Function called to format a drawer in ODT code. + +The function must accept two parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + +The function should return the string to be exported. + +For example, the variable could be set to the following function +in order to mimic default behaviour: + +\(defun org-odt-format-drawer-default \(name contents\) + \"Format a drawer element for ODT export.\" + contents\)" + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + + +;;;; Headline + +(defcustom org-odt-format-headline-function nil + "Function to format headline text. + +This function will be called with 5 arguments: +TODO the todo keyword \(string or nil\). +TODO-TYPE the type of todo \(symbol: `todo', `done', nil\) +PRIORITY the priority of the headline \(integer or nil\) +TEXT the main headline text \(string\). +TAGS the tags string, separated with colons \(string or nil\). + +The function result will be used as headline text." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + + +;;;; Inlinetasks + +(defcustom org-odt-format-inlinetask-function nil + "Function called to format an inlinetask in ODT code. + +The function must accept six parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a string. + CONTENTS the contents of the inlinetask, as a string. + +The function should return the string to be exported." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + + +;;;; LaTeX + +(defcustom org-odt-with-latex org-export-with-latex + "Non-nil means process LaTeX math snippets. + +When set, the exporter will process LaTeX environments and +fragments. + +This option can also be set with the +OPTIONS line, +e.g. \"tex:mathjax\". Allowed values are: + +nil Ignore math snippets. +`verbatim' Keep everything in verbatim +`dvipng' Process the LaTeX fragments to images. This will also + include processing of non-math environments. +`imagemagick' Convert the LaTeX fragments to pdf files and use + imagemagick to convert pdf files to png files. +`mathjax' Do MathJax preprocessing and arrange for MathJax.js to + be loaded. +t Synonym for `mathjax'." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not process math in any way" nil) + (const :tag "Use dvipng to make images" dvipng) + (const :tag "Use imagemagick to make images" imagemagick) + (const :tag "Use MathJax to display math" mathjax) + (const :tag "Leave math verbatim" verbatim))) + + +;;;; Links + +(defcustom org-odt-inline-formula-rules + '(("file" . "\\.\\(mathml\\|mml\\|odf\\)\\'")) + "Rules characterizing formula files that can be inlined into ODT. + +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path." + :group 'org-export-odt + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +(defcustom org-odt-inline-image-rules + '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\)\\'")) + "Rules characterizing image files that can be inlined into ODT. + +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path." + :group 'org-export-odt + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +(defcustom org-odt-pixels-per-inch display-pixels-per-inch + "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") + + +;;;; Src Block + +(defcustom org-odt-create-custom-styles-for-srcblocks t + "Whether custom styles for colorized source blocks be automatically created. +When this option is turned on, the exporter creates custom styles +for source blocks based on the advice of `htmlfontify'. Creation +of custom styles happen as part of `org-odt-hfy-face-to-css'. + +When this option is turned off exporter does not create such +styles. + +Use the latter option if you do not want the custom styles to be +based on your current display settings. It is necessary that the +styles.xml already contains needed styles for colorizing to work. + +This variable is effective only if +`org-odt-fontify-srcblocks' is turned on." + :group 'org-export-odt + :version "24.1" + :type 'boolean) + +(defcustom org-odt-fontify-srcblocks t + "Specify whether or not source blocks need to be fontified. +Turn this option on if you want to colorize the source code +blocks in the exported file. For colorization to work, you need +to make available an enhanced version of `htmlfontify' library." + :type 'boolean + :group 'org-export-odt + :version "24.1") + + +;;;; Table + +(defcustom org-odt-table-styles + '(("OrgEquation" "OrgEquation" + ((use-first-column-styles . t) + (use-last-column-styles . t))) + ("TableWithHeaderRowAndColumn" "Custom" + ((use-first-row-styles . t) + (use-first-column-styles . t))) + ("TableWithFirstRowandLastRow" "Custom" + ((use-first-row-styles . t) + (use-last-row-styles . t))) + ("GriddedTable" "Custom" nil)) + "Specify how Table Styles should be derived from a Table Template. +This is a list where each element is of the +form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS). + +TABLE-STYLE-NAME is the style associated with the table through +\"#+ATTR_ODT: :style TABLE-STYLE-NAME\" line. + +TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic +TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined +below) that is included in +`org-odt-content-template-file'. + +TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + + \"TableCell\" +PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + + \"TableParagraph\" +TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" | + \"FirstRow\" | \"LastRow\" | + \"EvenRow\" | \"OddRow\" | + \"EvenColumn\" | \"OddColumn\" | \"\" +where \"+\" above denotes string concatenation. + +TABLE-CELL-OPTIONS is an alist where each element is of the +form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF). +TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' | + `use-last-row-styles' | + `use-first-column-styles' | + `use-last-column-styles' | + `use-banding-rows-styles' | + `use-banding-columns-styles' | + `use-first-row-styles' +ON-OR-OFF := `t' | `nil' + +For example, with the following configuration + +\(setq org-odt-table-styles + '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\" + \(\(use-first-row-styles . t\) + \(use-first-column-styles . t\)\)\) + \(\"TableWithHeaderColumns\" \"Custom\" + \(\(use-first-column-styles . t\)\)\)\)\) + +1. A table associated with \"TableWithHeaderRowsAndColumns\" + style will use the following table-cell styles - + \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\", + \"CustomTableCell\" and the following paragraph styles + \"CustomFirstRowTableParagraph\", + \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" + as appropriate. + +2. A table associated with \"TableWithHeaderColumns\" style will + use the following table-cell styles - + \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the + following paragraph styles + \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" + as appropriate.. + +Note that TABLE-TEMPLATE-NAME corresponds to the +\"\" elements contained within +\"\". The entries (TABLE-STYLE-NAME +TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to +\"table:template-name\" and \"table:use-first-row-styles\" etc +attributes of \"\" element. Refer ODF-1.2 +specification for more information. Also consult the +implementation filed under `org-odt-get-table-cell-styles'. + +The TABLE-STYLE-NAME \"OrgEquation\" is used internally for +formatting of numbered display equations. Do not delete this +style from the list." + :group 'org-export-odt + :version "24.1" + :type '(choice + (const :tag "None" nil) + (repeat :tag "Table Styles" + (list :tag "Table Style Specification" + (string :tag "Table Style Name") + (string :tag "Table Template Name") + (alist :options (use-first-row-styles + use-last-row-styles + use-first-column-styles + use-last-column-styles + use-banding-rows-styles + use-banding-columns-styles) + :key-type symbol + :value-type (const :tag "True" t)))))) + +;;;; Timestamps + +(defcustom org-odt-use-date-fields nil + "Non-nil, if timestamps should be exported as date fields. + +When nil, export timestamps as plain text. + +When non-nil, map `org-time-stamp-custom-formats' to a pair of +OpenDocument date-styles with names \"OrgDate1\" and \"OrgDate2\" +respectively. A timestamp with no time component is formatted +with style \"OrgDate1\" while one with explicit hour and minutes +is formatted with style \"OrgDate2\". + +This feature is experimental. Most (but not all) of the common +%-specifiers in `format-time-string' are supported. +Specifically, locale-dependent specifiers like \"%c\", \"%x\" are +formatted as canonical Org timestamps. For finer control, avoid +these %-specifiers. + +Textutal specifiers like \"%b\", \"%h\", \"%B\", \"%a\", \"%A\" +etc., are displayed by the application in the default language +and country specified in `org-odt-styles-file'. Note that the +default styles file uses language \"en\" and country \"GB\". You +can localize the week day and month strings in the exported +document by setting the default language and country either using +the application UI or through a custom styles file. + +See `org-odt--build-date-styles' for implementation details." + :group 'org-export-odt + :type 'boolean) + + + +;;; Internal functions + +;;;; Date + +(defun org-odt--format-timestamp (timestamp &optional end iso-date-p) + (let* ((format-timestamp + (lambda (timestamp format &optional end utc) + (if timestamp + (org-timestamp-format timestamp format end utc) + (format-time-string format nil utc)))) + (has-time-p (or (not timestamp) + (org-timestamp-has-time-p timestamp))) + (iso-date (let ((format (if has-time-p "%Y-%m-%dT%H:%M:%S" + "%Y-%m-%dT%H:%M:%S"))) + (funcall format-timestamp timestamp format end)))) + (if iso-date-p iso-date + (let* ((style (if has-time-p "OrgDate2" "OrgDate1")) + ;; LibreOffice does not care about end goes as content + ;; within the "..." field. The + ;; displayed date is automagically corrected to match the + ;; format requested by "style:data-style-name" attribute. So + ;; don't bother about formatting the date contents to be + ;; compatible with "OrgDate1" and "OrgDateTime" styles. A + ;; simple Org-style date should suffice. + (date (let* ((formats + (if org-display-custom-times + (cons (substring + (car org-time-stamp-custom-formats) 1 -1) + (substring + (cdr org-time-stamp-custom-formats) 1 -1)) + '("%Y-%m-%d %a" . "%Y-%m-%d %a %H:%M"))) + (format (if has-time-p (cdr formats) (car formats)))) + (funcall format-timestamp timestamp format end))) + (repeater (let ((repeater-type (org-element-property + :repeater-type timestamp)) + (repeater-value (org-element-property + :repeater-value timestamp)) + (repeater-unit (org-element-property + :repeater-unit timestamp))) + (concat + (case repeater-type + (catchup "++") (restart ".+") (cumulate "+")) + (when repeater-value + (number-to-string repeater-value)) + (case repeater-unit + (hour "h") (day "d") (week "w") (month "m") + (year "y")))))) + (concat + (format "%s" + iso-date style date) + (and (not (string= repeater "")) " ") + repeater))))) + +;;;; Frame + +(defun org-odt--frame (text width height style &optional extra + anchor-type &rest title-and-desc) + (let ((frame-attrs + (concat + (if width (format " svg:width=\"%0.2fcm\"" width) "") + (if height (format " svg:height=\"%0.2fcm\"" height) "") + extra + (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph"))))) + (format + "\n\n%s\n" + style frame-attrs + (concat text + (let ((title (car title-and-desc)) + (desc (cadr title-and-desc))) + (concat (when title + (format "%s" + (org-odt--encode-plain-text title t))) + (when desc + (format "%s" + (org-odt--encode-plain-text desc t))))))))) + + +;;;; Library wrappers + +(defun org-odt--zip-extract (archive members target) + (when (atom members) (setq members (list members))) + (mapc (lambda (member) + (require 'arc-mode) + (let* ((--quote-file-name + ;; This is shamelessly stolen from `archive-zip-extract'. + (lambda (name) + (if (or (not (memq system-type '(windows-nt ms-dos))) + (and (boundp 'w32-quote-process-args) + (null w32-quote-process-args))) + (shell-quote-argument name) + name))) + (target (funcall --quote-file-name target)) + (archive (expand-file-name archive)) + (archive-zip-extract + (list "unzip" "-qq" "-o" "-d" target)) + exit-code command-output) + (setq command-output + (with-temp-buffer + (setq exit-code (archive-zip-extract archive member)) + (buffer-string))) + (unless (zerop exit-code) + (message command-output) + (error "Extraction failed")))) + members)) + +(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) + (if (not id) text + (concat + (format "\n" id) + (format "\n" id) text + (format "\n" id)))) + +;;;; Textbox + +(defun org-odt--textbox (text width height style &optional + extra anchor-type) + (org-odt--frame + (format "\n%s\n" + (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2)) + (and (not width) + (format " fo:min-width=\"%0.2fcm\"" (or width .2)))) + text) + width nil style extra anchor-type)) + + + +;;;; Table of Contents + +(defun org-odt-begin-toc (index-title depth) + (concat + (format " + + + %s +" depth index-title) + + (let ((levels (number-sequence 1 10))) + (mapconcat + (lambda (level) + (format + " + + + + + + +" level level)) levels "")) + + (format " + + + + + %s + + " index-title))) + +(defun org-odt-end-toc () + (format " + + +")) + +(defun* org-odt-format-toc-headline + (todo todo-type priority text tags + &key level section-number headline-label &allow-other-keys) + (setq text + (concat + ;; Section number. + (when section-number (concat section-number ". ")) + ;; Todo. + (when todo + (let ((style (if (member todo org-done-keywords) + "OrgDone" "OrgTodo"))) + (format "%s " + style todo))) + (when priority + (let* ((style (format "OrgPriority-%s" priority)) + (priority (format "[#%c]" priority))) + (format "%s " + style priority))) + ;; Title. + text + ;; Tags. + (when tags + (concat + (format " [%s]" + "OrgTags" + (mapconcat + (lambda (tag) + (format + "%s" + "OrgTag" tag)) tags " : ")))))) + (format "%s" + headline-label text)) + +(defun org-odt-toc (depth info) + (assert (wholenump depth)) + ;; When a headline is marked as a radio target, as in the example below: + ;; + ;; ** <<>> + ;; Some text. + ;; + ;; suppress generation of radio targets. i.e., Radio targets are to + ;; be marked as targets within /document body/ and *not* within + ;; /TOC/, as otherwise there will be duplicated anchors one in TOC + ;; and one in the document body. + ;; + ;; FIXME-1: Currently exported headings are memoized. `org-export.el' + ;; doesn't provide a way to disable memoization. So this doesn't + ;; work. + ;; + ;; FIXME-2: Are there any other objects that need to be suppressed + ;; within TOC? + (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)))) + (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)) + (level (org-export-get-relative-level headline info)) + (style (format "Contents_20_%d" level))) + (format "\n%s" + style entry))) + headlines "\n") + (org-odt-end-toc))))) + + +;;;; Document styles + +(defun org-odt-add-automatic-style (object-type &optional object-props) + "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS. +OBJECT-PROPS is (typically) a plist created by passing +\"#+ATTR_ODT: \" option of the object in question to +`org-odt-parse-block-attributes'. + +Use `org-odt-object-counters' to generate an automatic +OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a +new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME +. STYLE-NAME)." + (assert (stringp object-type)) + (let* ((object (intern object-type)) + (seqvar object) + (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0))) + (object-name (format "%s%d" object-type seqno)) style-name) + (setq org-odt-object-counters + (plist-put org-odt-object-counters seqvar seqno)) + (when object-props + (setq style-name (format "Org%s" object-name)) + (setq org-odt-automatic-styles + (plist-put org-odt-automatic-styles object + (append (list (list style-name object-props)) + (plist-get org-odt-automatic-styles object))))) + (cons object-name style-name))) + +;;;; Checkbox + +(defun org-odt--checkbox (item) + "Return check-box string associated to ITEM." + (let ((checkbox (org-element-property :checkbox item))) + (if (not checkbox) "" + (format "%s" + "OrgCode" (case checkbox + (on "[✓] ") ; CHECK MARK + (off "[ ] ") + (trans "[-] ")))))) + +;;; Template + +(defun org-odt--build-date-styles (fmt style) + ;; In LibreOffice 3.4.6, there doesn't seem to be a convenient way + ;; to modify the date fields. A date could be modified by + ;; offsetting in days. That's about it. Also, date and time may + ;; have to be emitted as two fields - a date field and a time field + ;; - separately. + + ;; One can add Form Controls to date and time fields so that they + ;; can be easily modified. But then, the exported document will + ;; become tightly coupled with LibreOffice and may not function + ;; properly with other OpenDocument applications. + + ;; I have a strange feeling that Date styles are a bit flaky at the + ;; moment. + + ;; The feature is experimental. + (when (and fmt style) + (let* ((fmt-alist + '(("%A" . "") + ("%B" . "") + ("%H" . "") + ("%M" . "") + ("%S" . "") + ("%V" . "") + ("%Y" . "") + ("%a" . "") + ("%b" . "") + ("%d" . "") + ("%e" . "") + ("%h" . "") + ("%k" . "") + ("%m" . "") + ("%p" . "") + ("%y" . ""))) + (case-fold-search nil) + (re (mapconcat 'identity (mapcar 'car fmt-alist) "\\|")) + match rpl (start 0) (filler-beg 0) filler-end filler output) + (mapc + (lambda (pair) + (setq fmt (replace-regexp-in-string (car pair) (cdr pair) fmt t t))) + '(("\\(?:%[[:digit:]]*N\\)" . "") ; strip ns, us and ns + ("%C" . "Y") ; replace century with year + ("%D" . "%m/%d/%y") + ("%G" . "Y") ; year corresponding to iso week + ("%I" . "%H") ; hour on a 12-hour clock + ("%R" . "%H:%M") + ("%T" . "%H:%M:%S") + ("%U\\|%W" . "%V") ; week no. starting on Sun./Mon. + ("%Z" . "") ; time zone name + ("%c" . "%Y-%M-%d %a %H:%M" ) ; locale's date and time format + ("%g" . "%y") + ("%X" . "%x" ) ; locale's pref. time format + ("%j" . "") ; day of the year + ("%l" . "%k") ; like %I blank-padded + ("%s" . "") ; no. of secs since 1970-01-01 00:00:00 +0000 + ("%n" . "") + ("%r" . "%I:%M:%S %p") + ("%t" . "") + ("%u\\|%w" . "") ; numeric day of week - Mon (1-7), Sun(0-6) + ("%x" . "%Y-%M-%d %a") ; locale's pref. time format + ("%z" . "") ; time zone in numeric form + )) + (while (string-match re fmt start) + (setq match (match-string 0 fmt)) + (setq rpl (assoc-default match fmt-alist)) + (setq start (match-end 0)) + (setq filler-end (match-beginning 0)) + (setq filler (substring fmt (prog1 filler-beg + (setq filler-beg (match-end 0))) + filler-end)) + (setq filler (and (not (string= filler "")) + (format "%s" + (org-odt--encode-plain-text filler)))) + (setq output (concat output "\n" filler "\n" rpl))) + (setq filler (substring fmt filler-beg)) + (unless (string= filler "") + (setq output (concat output + (format "\n%s" + (org-odt--encode-plain-text filler))))) + (format "\n%s\n" + style + (concat " number:automatic-order=\"true\"" + " number:format-source=\"fixed\"") + output )))) + +(defun org-odt-template (contents info) + "Return complete document string after ODT conversion. +CONTENTS is the transcoded contents string. RAW-DATA is the +original parsed data. INFO is a plist holding export options." + ;; Write meta file. + (let ((title (org-export-data (plist-get info :title) info)) + (author (let ((author (plist-get info :author))) + (if (not author) "" (org-export-data author info)))) + (email (plist-get info :email)) + (keywords (plist-get info :keywords)) + (description (plist-get info :description))) + (write-region + (concat + " + + \n" + (format "%s\n" author) + (format "%s\n" author) + ;; Date, if required. + (when (plist-get info :with-date) + ;; Check if DATE is specified as an Org-timestamp. If yes, + ;; include it as meta information. Otherwise, just use + ;; today's date. + (let* ((date (let ((date (plist-get info :date))) + (and (not (cdr date)) + (eq (org-element-type (car date)) 'timestamp) + (car date))))) + (let ((iso-date (org-odt--format-timestamp date nil 'iso-date))) + (concat + (format "%s\n" iso-date) + (format "%s\n" + iso-date))))) + (format "%s\n" + (let ((creator-info (plist-get info :with-creator))) + (if (or (not creator-info) (eq creator-info 'comment)) "" + (plist-get info :creator)))) + (format "%s\n" keywords) + (format "%s\n" description) + (format "%s\n" title) + "\n" + " \n" "") + nil (concat org-odt-zip-dir "meta.xml")) + ;; Add meta.xml in to manifest. + (org-odt-create-manifest-file-entry "text/xml" "meta.xml")) + + ;; Update styles file. + ;; Copy styles.xml. Also dump htmlfontify styles, if there is any. + ;; Write styles file. + (let* ((styles-file (plist-get info :odt-styles-file)) + (styles-file (and styles-file (read (org-trim styles-file)))) + ;; Non-availability of styles.xml is not a critical + ;; error. For now, throw an error. + (styles-file (or styles-file + org-odt-styles-file + (expand-file-name "OrgOdtStyles.xml" + org-odt-styles-dir) + (error "org-odt: Missing styles file?")))) + (cond + ((listp styles-file) + (let ((archive (nth 0 styles-file)) + (members (nth 1 styles-file))) + (org-odt--zip-extract archive members org-odt-zip-dir) + (mapc + (lambda (member) + (when (org-file-image-p member) + (let* ((image-type (file-name-extension member)) + (media-type (format "image/%s" image-type))) + (org-odt-create-manifest-file-entry media-type member)))) + members))) + ((and (stringp styles-file) (file-exists-p styles-file)) + (let ((styles-file-type (file-name-extension styles-file))) + (cond + ((string= styles-file-type "xml") + (copy-file styles-file (concat org-odt-zip-dir "styles.xml") t)) + ((member styles-file-type '("odt" "ott")) + (org-odt--zip-extract styles-file "styles.xml" org-odt-zip-dir))))) + (t + (error (format "Invalid specification of styles.xml file: %S" + org-odt-styles-file)))) + + ;; create a manifest entry for styles.xml + (org-odt-create-manifest-file-entry "text/xml" "styles.xml") + + ;; FIXME: Who is opening an empty styles.xml before this point? + (with-current-buffer + (find-file-noselect (concat org-odt-zip-dir "styles.xml") t) + (revert-buffer t t) + + ;; Write custom styles for source blocks + ;; Save STYLES used for colorizing of source blocks. + ;; Update styles.xml with styles that were collected as part of + ;; `org-odt-hfy-face-to-css' callbacks. + (let ((styles (mapconcat (lambda (style) (format " %s\n" (cddr style))) + hfy-user-sheet-assoc ""))) + (when styles + (goto-char (point-min)) + (when (re-search-forward "" nil t) + (goto-char (match-beginning 0)) + (insert "\n\n" styles "\n")))) + + ;; Update styles.xml - take care of outline numbering + + ;; Don't make automatic backup of styles.xml file. This setting + ;; prevents the backed-up styles.xml file from being zipped in to + ;; odt file. This is more of a hackish fix. Better alternative + ;; would be to fix the zip command so that the output odt file + ;; includes only the needed files and excludes any auto-generated + ;; extra files like backups and auto-saves etc etc. Note that + ;; currently the zip command zips up the entire temp directory so + ;; that any auto-generated files created under the hood ends up in + ;; the resulting odt file. + (set (make-local-variable 'backup-inhibited) t) + + ;; Outline numbering is retained only upto LEVEL. + ;; To disable outline numbering pass a LEVEL of 0. + + (goto-char (point-min)) + (let ((regex + "]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>") + (replacement + "")) + (while (re-search-forward regex nil t) + (unless (let ((sec-num (plist-get info :section-numbers)) + (level (string-to-number (match-string 2)))) + (if (wholenump sec-num) (<= level sec-num) sec-num)) + (replace-match replacement t nil)))) + (save-buffer 0))) + ;; Update content.xml. + + (let* ( ;; `org-display-custom-times' should be accessed right + ;; within the context of the Org buffer. So obtain it's + ;; value before moving on to temp-buffer context down below. + (custom-time-fmts + (if org-display-custom-times + (cons (substring (car org-time-stamp-custom-formats) 1 -1) + (substring (cdr org-time-stamp-custom-formats) 1 -1)) + '("%Y-%M-%d %a" . "%Y-%M-%d %a %H:%M")))) + (with-temp-buffer + (insert-file-contents + (or org-odt-content-template-file + (expand-file-name "OrgOdtContentTemplate.xml" + org-odt-styles-dir))) + ;; Write automatic styles. + ;; - Position the cursor. + (goto-char (point-min)) + (re-search-forward " " nil t) + (goto-char (match-beginning 0)) + ;; - Dump automatic table styles. + (loop for (style-name props) in + (plist-get org-odt-automatic-styles 'Table) do + (when (setq props (or (plist-get props :rel-width) 96)) + (insert (format org-odt-table-style-format style-name props)))) + ;; - Dump date-styles. + (when org-odt-use-date-fields + (insert (org-odt--build-date-styles (car custom-time-fmts) + "OrgDate1") + (org-odt--build-date-styles (cdr custom-time-fmts) + "OrgDate2"))) + ;; Update display level. + ;; - Remove existing sequence decls. Also position the cursor. + (goto-char (point-min)) + (when (re-search-forward "" nil nil))) + ;; Update sequence decls according to user preference. + (insert + (format + "\n\n%s\n" + (mapconcat + (lambda (x) + (format + "" + org-odt-display-outline-level (nth 1 x))) + org-odt-category-map-alist "\n"))) + ;; Position the cursor to document body. + (goto-char (point-min)) + (re-search-forward "" nil nil) + (goto-char (match-beginning 0)) + + ;; Preamble - Title, Author, Date etc. + (insert + (let* ((title (org-export-data (plist-get info :title) info)) + (author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (plist-get info :email)) + ;; Switch on or off above vars based on user settings + (author (and (plist-get info :with-author) (or author email))) + (email (and (plist-get info :with-email) email))) + (concat + ;; Title. + (when title + (concat + (format "\n%s" + "OrgTitle" (format "\n%s" title)) + ;; Separator. + "\n")) + (cond + ((and author (not email)) + ;; Author only. + (concat + (format "\n%s" + "OrgSubtitle" + (format "%s" author)) + ;; Separator. + "\n")) + ((and author email) + ;; Author and E-mail. + (concat + (format + "\n%s" + "OrgSubtitle" + (format + "%s" + (concat "mailto:" email) + (format "%s" author))) + ;; Separator. + "\n"))) + ;; Date, if required. + (when (plist-get info :with-date) + (let* ((date (plist-get info :date)) + ;; Check if DATE is specified as a timestamp. + (timestamp (and (not (cdr date)) + (eq (org-element-type (car date)) 'timestamp) + (car date)))) + (concat + (format "\n%s" + "OrgSubtitle" + (if (and org-odt-use-date-fields timestamp) + (org-odt--format-timestamp (car date)) + (org-export-data (plist-get info :date) info))) + ;; Separator + "")))))) + ;; Table of Contents + (let* ((with-toc (plist-get info :with-toc)) + (depth (and with-toc (if (wholenump with-toc) + with-toc + (plist-get info :headline-levels))))) + (when depth (insert (or (org-odt-toc depth info) "")))) + ;; Contents. + (insert contents) + ;; Return contents. + (buffer-substring-no-properties (point-min) (point-max))))) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-odt-bold (bold contents info) + "Transcode BOLD from Org to ODT. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (format "%s" + "Bold" contents)) + + +;;;; Center Block + +(defun org-odt-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to ODT. +CONTENTS holds the contents of the center block. INFO is a plist +holding contextual information." + contents) + + +;;;; Clock + +(defun org-odt-clock (clock contents info) + "Transcode a CLOCK element from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((timestamp (org-element-property :value clock)) + (duration (org-element-property :duration clock))) + (format "\n%s" + (if (eq (org-element-type (org-export-get-next-element clock info)) + 'clock) "OrgClock" "OrgClockLastLine") + (concat + (format "%s" + "OrgClockKeyword" org-clock-string) + (org-odt-timestamp timestamp contents info) + (and duration (format " (%s)" duration)))))) + + +;;;; Code + +(defun org-odt-code (code contents info) + "Transcode a CODE object from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "%s" + "OrgCode" (org-odt--encode-plain-text + (org-element-property :value code)))) + + +;;;; Comment + +;; Comments are ignored. + + +;;;; Comment Block + +;; Comment Blocks are ignored. + + +;;;; Drawer + +(defun org-odt-drawer (drawer contents info) + "Transcode a DRAWER element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((name (org-element-property :drawer-name drawer)) + (output (if (functionp org-odt-format-drawer-function) + (funcall org-odt-format-drawer-function + name contents) + ;; If there's no user defined function: simply + ;; display contents of the drawer. + contents))) + output)) + + +;;;; Dynamic Block + +(defun org-odt-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + contents) + + +;;;; Entity + +(defun org-odt-entity (entity contents info) + "Transcode an ENTITY object from Org to ODT. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (org-element-property :utf-8 entity)) + + +;;;; Example Block + +(defun org-odt-example-block (example-block contents info) + "Transcode a EXAMPLE-BLOCK element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-odt-format-code example-block info)) + + +;;;; Export Snippet + +(defun org-odt-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'odt) + (org-element-property :value export-snippet))) + + +;;;; Export Block + +(defun org-odt-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "ODT") + (org-remove-indentation (org-element-property :value export-block)))) + + +;;;; Fixed Width + +(defun org-odt-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-odt-do-format-code (org-element-property :value fixed-width))) + + +;;;; Footnote Definition + +;; Footnote Definitions are ignored. + + +;;;; Footnote Reference + +(defun org-odt-footnote-reference (footnote-reference contents info) + "Transcode a FOOTNOTE-REFERENCE element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((--format-footnote-definition + (function + (lambda (n def) + (setq n (format "%d" n)) + (let ((id (concat "fn" n)) + (note-class "footnote") + (par-style "Footnote")) + (format + "%s" + id note-class + (concat + (format "%s" n) + (format "%s" def))))))) + (--format-footnote-reference + (function + (lambda (n) + (setq n (format "%d" n)) + (let ((note-class "footnote") + (ref-format "text") + (ref-name (concat "fn" n))) + (format + "%s" + "OrgSuperscript" + (format "%s" + note-class ref-format ref-name n))))))) + (concat + ;; Insert separator between two footnotes in a row. + (let ((prev (org-export-get-previous-element footnote-reference info))) + (and (eq (org-element-type prev) 'footnote-reference) + (format "%s" + "OrgSuperscript" ","))) + ;; Trancode footnote reference. + (let ((n (org-export-get-footnote-number footnote-reference info))) + (cond + ((not (org-export-footnote-first-reference-p footnote-reference info)) + (funcall --format-footnote-reference n)) + ;; Inline definitions are secondary strings. + ;; Non-inline footnotes definitions are full Org data. + (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))))) + (funcall --format-footnote-definition n def)))))))) + + +;;;; Headline + +(defun* org-odt-format-headline + (todo todo-type priority text tags + &key level section-number headline-label &allow-other-keys) + (concat + ;; Todo. + (when todo + (let ((style (if (member todo org-done-keywords) "OrgDone" "OrgTodo"))) + (format "%s " + style todo))) + (when priority + (let* ((style (format "OrgPriority-%s" priority)) + (priority (format "[#%c]" priority))) + (format "%s " + style priority))) + ;; Title. + text + ;; Tags. + (when tags + (concat + "" + (format "[%s]" + "OrgTags" (mapconcat + (lambda (tag) + (format + "%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))) + (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) + (mapconcat 'number-to-string + headline-number "."))) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data-with-translations + todo translations 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)) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (headline-label (concat "sec-" (mapconcat 'number-to-string + headline-number "-"))) + (format-function (cond + ((functionp format-function) format-function) + ((functionp org-odt-format-headline-function) + (function* + (lambda (todo todo-type priority text tags + &allow-other-keys) + (funcall org-odt-format-headline-function + todo todo-type priority text tags)))) + (t 'org-odt-format-headline)))) + (apply format-function + todo todo-type priority text tags + :headline-label headline-label :level level + :section-number section-number extra-keys))) + +(defun org-odt-headline (headline contents info) + "Transcode a HEADLINE element from Org to ODT. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + ;; Case 1: This is a footnote section: ignore it. + (unless (org-element-property :footnote-section-p headline) + (let* ((text (org-export-data (org-element-property :title headline) info)) + ;; Create the headline text. + (full-text (org-odt-format-headline--wrap headline nil info)) + ;; Get level relative to current parsed data. + (level (org-export-get-relative-level headline info)) + ;; Get canonical label for the headline. + (id (concat "sec-" (mapconcat 'number-to-string + (org-export-get-headline-number + headline info) "-"))) + ;; Get user-specified labels for the headline. + (extra-ids (list (org-element-property :CUSTOM_ID headline) + (org-element-property :ID headline))) + ;; Extra targets. + (extra-targets + (mapconcat (lambda (x) + (when x + (let ((x (if (org-uuidgen-p x) (concat "ID-" x) x))) + (org-odt--target + "" (org-export-solidify-link-text x))))) + extra-ids "")) + ;; Title. + (anchored-title (org-odt--target full-text id))) + (cond + ;; Case 2. This is a deep sub-tree: export it as a list item. + ;; Also export as items headlines for which no section + ;; format has been found. + ((org-export-low-level-p headline info) + ;; Build the real contents of the sub-tree. + (concat + (and (org-export-first-sibling-p headline info) + (format "\n" + ;; Choose style based on list type. + (if (org-export-numbered-headline-p headline info) + "OrgNumberedList" "OrgBulletedList") + ;; If top-level list, re-start numbering. Otherwise, + ;; continue numbering. + (format "text:continue-numbering=\"%s\"" + (let* ((parent (org-export-get-parent-headline + headline))) + (if (and parent + (org-export-low-level-p parent info)) + "true" "false"))))) + (let ((headline-has-table-p + (let ((section (assq 'section (org-element-contents headline)))) + (assq 'table (and section (org-element-contents section)))))) + (format "\n\n%s\n%s" + (concat + (format "\n%s" + "Text_20_body" + (concat extra-targets anchored-title)) + contents) + (if headline-has-table-p + "" + ""))) + (and (org-export-last-sibling-p headline info) + ""))) + ;; Case 3. Standard headline. Export it as a section. + (t + (concat + (format + "\n%s" + (format "Heading_20_%s" level) + level + (concat extra-targets anchored-title)) + contents)))))) + + +;;;; Horizontal Rule + +(defun org-odt-horizontal-rule (horizontal-rule contents info) + "Transcode an HORIZONTAL-RULE object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (format "\n%s" + "Horizontal_20_Line" "")) + + +;;;; Inline Babel Call + +;; Inline Babel Calls are ignored. + + +;;;; Inline Src Block + +(defun org-odt--find-verb-separator (s) + "Return a character not used in string S. +This is used to choose a separator for constructs like \\verb." + (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) + (loop for c across ll + when (not (string-match (regexp-quote (char-to-string c)) s)) + return (char-to-string c)))) + +(defun org-odt-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to ODT. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((org-lang (org-element-property :language inline-src-block)) + (code (org-element-property :value inline-src-block)) + (separator (org-odt--find-verb-separator code))) + (error "FIXME"))) + + +;;;; Inlinetask + +(defun org-odt-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (cond + ;; If `org-odt-format-inlinetask-function' is provided, call it + ;; with appropriate arguments. + ((functionp org-odt-format-inlinetask-function) + (let ((format-function + (function* + (lambda (todo todo-type priority text tags + &key contents &allow-other-keys) + (funcall org-odt-format-inlinetask-function + todo todo-type priority text tags contents))))) + (org-odt-format-headline--wrap + inlinetask nil info format-function :contents contents))) + ;; Otherwise, use a default template. + (t + (format "\n%s" + "Text_20_body" + (org-odt--textbox + (concat + (format "\n%s" + "OrgInlineTaskHeading" + (org-odt-format-headline--wrap inlinetask nil info)) + contents) + nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\""))))) + +;;;; Italic + +(defun org-odt-italic (italic contents info) + "Transcode ITALIC from Org to ODT. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (format "%s" + "Emphasis" contents)) + + +;;;; Item + +(defun org-odt-item (item contents info) + "Transcode an ITEM element from Org to ODT. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((plain-list (org-export-get-parent item)) + (type (org-element-property :type plain-list)) + (counter (org-element-property :counter item)) + (tag (let ((tag (org-element-property :tag item))) + (and tag + (concat (org-odt--checkbox item) + (org-export-data tag info)))))) + (case type + ((ordered unordered descriptive-1 descriptive-2) + (format "\n\n%s\n%s" + contents + (let* ((--element-has-a-table-p + (function + (lambda (element info) + (loop for el in (org-element-contents element) + thereis (eq (org-element-type el) 'table)))))) + (cond + ((funcall --element-has-a-table-p item info) + "") + (t ""))))) + (t (error "Unknown list type: %S" type))))) + +;;;; Keyword + +(defun org-odt-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "ODT") value) + ((string= key "INDEX") + ;; FIXME + (ignore)) + ((string= key "TOC") + (let ((value (downcase value))) + (cond + ((string-match "\\" value) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc)))) + (when (wholenump depth) (org-odt-toc depth info)))) + ((member value '("tables" "figures" "listings")) + ;; FIXME + (ignore)))))))) + + +;;;; Latex Environment + + +;; (eval-after-load 'ox-odt '(ad-deactivate 'org-format-latex-as-mathml)) +;; (defadvice org-format-latex-as-mathml ; FIXME +;; (after org-odt-protect-latex-fragment activate) +;; "Encode LaTeX fragment as XML. +;; Do this when translation to MathML fails." +;; (unless (> (length ad-return-value) 0) +;; (setq ad-return-value (org-odt--encode-plain-text (ad-get-arg 0))))) + +(defun org-odt-latex-environment (latex-environment contents info) + "Transcode a LATEX-ENVIRONMENT element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let* ((latex-frag (org-remove-indentation + (org-element-property :value latex-environment)))) + (org-odt-do-format-code latex-frag))) + + +;;;; Latex Fragment + +;; (when latex-frag ; FIXME +;; (setq href (org-propertize href :title "LaTeX Fragment" +;; :description latex-frag))) +;; handle verbatim +;; provide descriptions + +(defun org-odt-latex-fragment (latex-fragment contents info) + "Transcode a LATEX-FRAGMENT object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let* ((latex-frag (org-element-property :value latex-fragment)) + (processing-type (plist-get info :with-latex))) + (format "%s" + "OrgCode" (org-odt--encode-plain-text latex-frag t)))) + + +;;;; Line Break + +(defun org-odt-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + "\n") + + +;;;; Link + +;;;; Links :: Label references + +(defun org-odt--enumerate (element info &optional predicate n) + (when predicate (assert (funcall predicate element info))) + (let* ((--numbered-parent-headline-at-<=-n + (function + (lambda (element n info) + (loop for x in (org-export-get-genealogy element) + thereis (and (eq (org-element-type x) 'headline) + (<= (org-export-get-relative-level x info) n) + (org-export-numbered-headline-p x info) + x))))) + (--enumerate + (function + (lambda (element scope info &optional predicate) + (let ((counter 0)) + (org-element-map (or scope (plist-get info :parse-tree)) + (org-element-type element) + (lambda (el) + (and (or (not predicate) (funcall predicate el info)) + (incf counter) + (eq element el) + counter)) + info 'first-match))))) + (scope (funcall --numbered-parent-headline-at-<=-n + element (or n org-odt-display-outline-level) info)) + (ordinal (funcall --enumerate element scope info predicate)) + (tag + (concat + ;; Section number. + (and scope + (mapconcat 'number-to-string + (org-export-get-headline-number scope info) ".")) + ;; Separator. + (and scope ".") + ;; Ordinal. + (number-to-string ordinal)))) + tag)) + +(defun org-odt-format-label (element info op) + (assert (memq (org-element-type element) '(link table src-block paragraph))) + (let* ((caption-from + (case (org-element-type element) + (link (org-export-get-parent-element element)) + (t element))) + ;; Get label and caption. + (label (org-element-property :name caption-from)) + (caption (org-export-get-caption caption-from)) + (short-caption (org-export-get-caption caption-from t)) + ;; Transcode captions. + (caption (and caption (org-export-data caption info))) + ;; Currently short caption are sneaked in as object names. + ;; + ;; The advantages are: + ;; + ;; - Table Of Contents: Currently, there is no support for + ;; building TOC for figures, listings and tables. See + ;; `org-odt-keyword'. User instead has to rely on + ;; external application for building such indices. Within + ;; LibreOffice, building an "Illustration Index" or "Index + ;; of Tables" will create a table with long captions (only) + ;; and building a table with "Object names" will create a + ;; table with short captions. + ;; + ;; - Easy navigation: In LibreOffice, object names are + ;; offered via the navigation bar. This way one can + ;; quickly locate and jump to object of his choice in the + ;; exported document. + ;; + ;; The main disadvantage is that there cannot be any markups + ;; within object names i.e., one cannot embolden, italicize + ;; or underline text within short caption. So suppress + ;; generation of ... and other + ;; markups by overriding the default translators. We + ;; probably shouldn't be suppressing translators for all + ;; elements in `org-element-all-objects', but for now this + ;; 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)))) + (when short-caption + (org-export-data-with-translations short-caption + translations info))))) + (when (or label caption) + (let* ((default-category + (case (org-element-type element) + (table "__Table__") + (src-block "__Listing__") + ((link paragraph) + (cond + ((org-odt--enumerable-latex-image-p element info) + "__DvipngImage__") + ((org-odt--enumerable-image-p element info) + "__Figure__") + ((org-odt--enumerable-formula-p element info) + "__MathFormula__") + (t (error "Don't know how to format label for link: %S" + element)))) + (t (error "Don't know how to format label for element type: %s" + (org-element-type element))))) + seqno) + (assert default-category) + (destructuring-bind (counter label-style category predicate) + (assoc-default default-category org-odt-category-map-alist) + ;; Compute sequence number of the element. + (setq seqno (org-odt--enumerate element info predicate)) + ;; Localize category string. + (setq category (org-export-translate category :utf-8 info)) + (case op + ;; 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)) + (cons + (concat + ;; Sneak in a bookmark. The bookmark is used when the + ;; labeled element is referenced with a link that + ;; provides it's own description. + (format "\n" label) + ;; Label definition: Typically formatted as below: + ;; CATEGORY SEQ-NO: LONG CAPTION + (format-spec + (cadr (assoc-string label-style org-odt-label-styles t)) + `((?e . ,category) + (?n . ,(format + "%s" + label counter counter seqno)) + (?c . ,(or caption ""))))) + short-caption)) + ;; Case 2: Handle Label reference. + (reference + (assert label) + (setq label (org-export-solidify-link-text label)) + (let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t))) + (fmt1 (car fmt)) + (fmt2 (cadr fmt))) + (format "%s" + fmt1 label (format-spec fmt2 `((?e . ,category) + (?n . ,seqno)))))) + (t (error "Unknown %S on label" op)))))))) + + +;;;; Links :: Inline Images + +(defun org-odt--copy-image-file (path) + "Returns the internal name of the file" + (let* ((image-type (file-name-extension path)) + (media-type (format "image/%s" image-type)) + (target-dir "Images/") + (target-file + (format "%s%04d.%s" target-dir + (incf org-odt-embedded-images-count) image-type))) + (message "Embedding %s as %s..." + (substring-no-properties path) target-file) + + (when (= 1 org-odt-embedded-images-count) + (make-directory (concat org-odt-zip-dir target-dir)) + (org-odt-create-manifest-file-entry "" target-dir)) + + (copy-file path (concat org-odt-zip-dir target-file) 'overwrite) + (org-odt-create-manifest-file-entry media-type target-file) + target-file)) + +(defun org-odt--image-size (file &optional user-width + user-height scale dpi embed-as) + (let* ((--pixels-to-cms + (function (lambda (pixels dpi) + (let ((cms-per-inch 2.54) + (inches (/ pixels dpi))) + (* cms-per-inch inches))))) + (--size-in-cms + (function + (lambda (size-in-pixels dpi) + (and size-in-pixels + (cons (funcall --pixels-to-cms (car size-in-pixels) dpi) + (funcall --pixels-to-cms (cdr size-in-pixels) dpi)))))) + (dpi (or dpi org-odt-pixels-per-inch)) + (anchor-type (or embed-as "paragraph")) + (user-width (and (not scale) user-width)) + (user-height (and (not scale) user-height)) + (size + (and + (not (and user-height user-width)) + (or + ;; Use Imagemagick. + (and (executable-find "identify") + (let ((size-in-pixels + (let ((dim (shell-command-to-string + (format "identify -format \"%%w:%%h\" \"%s\"" + file)))) + (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim) + (cons (string-to-number (match-string 1 dim)) + (string-to-number (match-string 2 dim))))))) + (funcall --size-in-cms size-in-pixels dpi))) + ;; Use Emacs. + (let ((size-in-pixels + (ignore-errors ; Emacs could be in batch mode + (clear-image-cache) + (image-size (create-image file) 'pixels)))) + (funcall --size-in-cms size-in-pixels dpi)) + ;; Use hard-coded values. + (cdr (assoc-string anchor-type + org-odt-default-image-sizes-alist)) + ;; Error out. + (error "Cannot determine image size, aborting")))) + (width (car size)) (height (cdr size))) + (cond + (scale + (setq width (* width scale) height (* height scale))) + ((and user-height user-width) + (setq width user-width height user-height)) + (user-height + (setq width (* user-height (/ width height)) height user-height)) + (user-width + (setq height (* user-width (/ height width)) width user-width)) + (t (ignore))) + ;; ensure that an embedded image fits comfortably within a page + (let ((max-width (car org-odt-max-image-size)) + (max-height (cdr org-odt-max-image-size))) + (when (or (> width max-width) (> height max-height)) + (let* ((scale1 (/ max-width width)) + (scale2 (/ max-height height)) + (scale (min scale1 scale2))) + (setq width (* scale width) height (* scale height))))) + (cons width height))) + +(defun org-odt-link--inline-image (element info) + "Return ODT code for an inline image. +LINK is the link pointing to the inline image. INFO is a plist +used as a communication channel." + (assert (eq (org-element-type element) 'link)) + (let* ((src (let* ((type (org-element-property :type element)) + (raw-path (org-element-property :path element))) + (cond ((member type '("http" "https")) + (concat type ":" raw-path)) + ((file-name-absolute-p raw-path) + (expand-file-name raw-path)) + (t raw-path)))) + (src-expanded (if (file-name-absolute-p src) src + (expand-file-name src (file-name-directory + (plist-get info :input-file))))) + (href (format + "\n" + (org-odt--copy-image-file src-expanded))) + ;; Extract attributes from #+ATTR_ODT line. + (attr-from (case (org-element-type element) + (link (org-export-get-parent-element element)) + (t element))) + ;; Convert attributes to a plist. + (attr-plist (org-export-read-attribute :attr_odt attr-from)) + ;; Handle `:anchor', `:style' and `:attributes' properties. + (user-frame-anchor + (car (assoc-string (plist-get attr-plist :anchor) + '(("as-char") ("paragraph") ("page")) t))) + (user-frame-style + (and user-frame-anchor (plist-get attr-plist :style))) + (user-frame-attrs + (and user-frame-anchor (plist-get attr-plist :attributes))) + (user-frame-params + (list user-frame-style user-frame-attrs user-frame-anchor)) + ;; (embed-as (or embed-as user-frame-anchor "paragraph")) + ;; extrac + ;; + ;; Handle `:width', `:height' and `:scale' properties. Read + ;; them as numbers since we need them for computations. + (size (org-odt--image-size + src-expanded + (let ((width (plist-get attr-plist :width))) + (and width (read width))) + (let ((length (plist-get attr-plist :length))) + (and length (read length))) + (let ((scale (plist-get attr-plist :scale))) + (and scale (read scale))) + nil ; embed-as + "paragraph" ; FIXME + )) + (width (car size)) (height (cdr size)) + (standalone-link-p (org-odt--standalone-link-p element info)) + (embed-as (if standalone-link-p "paragraph" "as-char")) + (captions (org-odt-format-label element info 'definition)) + (caption (car captions)) (short-caption (cdr captions)) + (entity (concat (and caption "Captioned") embed-as "Image")) + ;; Check if this link was created by LaTeX-to-PNG converter. + (replaces (org-element-property + :replaces (if (not standalone-link-p) element + (org-export-get-parent-element element)))) + ;; If yes, note down the type of the element - LaTeX Fragment + ;; or LaTeX environment. It will go in to frame title. + (title (and replaces (capitalize + (symbol-name (org-element-type replaces))))) + + ;; If yes, note down it's contents. It will go in to frame + ;; description. This quite useful for debugging. + (desc (and replaces (org-element-property :value replaces)))) + (org-odt--render-image/formula entity href width height + captions user-frame-params title desc))) + + +;;;; Links :: Math formula + +(defun org-odt-link--inline-formula (element info) + (let* ((src (let* ((type (org-element-property :type element)) + (raw-path (org-element-property :path element))) + (cond + ((file-name-absolute-p raw-path) + (expand-file-name raw-path)) + (t raw-path)))) + (src-expanded (if (file-name-absolute-p src) src + (expand-file-name src (file-name-directory + (plist-get info :input-file))))) + (href + (format + "\n" + " xlink:show=\"embed\" xlink:actuate=\"onLoad\"" + (file-name-directory (org-odt--copy-formula-file src-expanded)))) + (standalone-link-p (org-odt--standalone-link-p element info)) + (embed-as (if standalone-link-p 'paragraph 'character)) + (captions (org-odt-format-label element info 'definition)) + (caption (car captions)) (short-caption (cdr captions)) + ;; Check if this link was created by LaTeX-to-MathML + ;; converter. + (replaces (org-element-property + :replaces (if (not standalone-link-p) element + (org-export-get-parent-element element)))) + ;; If yes, note down the type of the element - LaTeX Fragment + ;; or LaTeX environment. It will go in to frame title. + (title (and replaces (capitalize + (symbol-name (org-element-type replaces))))) + + ;; If yes, note down it's contents. It will go in to frame + ;; description. This quite useful for debugging. + (desc (and replaces (org-element-property :value replaces))) + width height) + (cond + ((eq embed-as 'character) + (org-odt--render-image/formula "InlineFormula" href width height + nil nil title desc)) + (t + (let* ((equation (org-odt--render-image/formula + "CaptionedDisplayFormula" href width height + captions nil title desc)) + (label + (let* ((org-odt-category-map-alist + '(("__MathFormula__" "Text" "math-label" "Equation" + org-odt--enumerable-formula-p)))) + (car (org-odt-format-label element info 'definition))))) + (concat equation "" label)))))) + +(defun org-odt--copy-formula-file (src-file) + "Returns the internal name of the file" + (let* ((target-dir (format "Formula-%04d/" + (incf org-odt-embedded-formulas-count))) + (target-file (concat target-dir "content.xml"))) + ;; Create a directory for holding formula file. Also enter it in + ;; to manifest. + (make-directory (concat org-odt-zip-dir target-dir)) + (org-odt-create-manifest-file-entry + "application/vnd.oasis.opendocument.formula" target-dir "1.2") + ;; Copy over the formula file from user directory to zip + ;; directory. + (message "Embedding %s as %s..." src-file target-file) + (let ((case-fold-search nil)) + (cond + ;; Case 1: Mathml. + ((string-match "\\.\\(mathml\\|mml\\)\\'" src-file) + (copy-file src-file (concat org-odt-zip-dir target-file) 'overwrite)) + ;; Case 2: OpenDocument formula. + ((string-match "\\.odf\\'" src-file) + (org-odt--zip-extract src-file "content.xml" + (concat org-odt-zip-dir target-dir))) + (t (error "%s is not a formula file" src-file)))) + ;; Enter the formula file in to manifest. + (org-odt-create-manifest-file-entry "text/xml" target-file) + target-file)) + +;;;; Targets + +(defun org-odt--render-image/formula (cfg-key href width height &optional + captions user-frame-params + &rest title-and-desc) + (let* ((frame-cfg-alist + ;; Each element of this alist is of the form (CFG-HANDLE + ;; INNER-FRAME-PARAMS OUTER-FRAME-PARAMS). + + ;; CFG-HANDLE is the key to the alist. + + ;; INNER-FRAME-PARAMS and OUTER-FRAME-PARAMS specify the + ;; frame params for INNER-FRAME and OUTER-FRAME + ;; respectively. See below. + + ;; Configurations that are meant to be applied to + ;; non-captioned image/formula specifies no + ;; OUTER-FRAME-PARAMS. + + ;; TERMINOLOGY + ;; =========== + ;; INNER-FRAME :: Frame that directly surrounds an + ;; image/formula. + + ;; OUTER-FRAME :: Frame that encloses the INNER-FRAME. This + ;; frame also contains the caption, if any. + + ;; FRAME-PARAMS :: List of the form (FRAME-STYLE-NAME + ;; FRAME-ATTRIBUTES FRAME-ANCHOR). Note + ;; that these are the last three arguments + ;; to `org-odt--frame'. + + ;; Note that an un-captioned image/formula requires just an + ;; INNER-FRAME, while a captioned image/formula requires + ;; both an INNER and an OUTER-FRAME. + '(("As-CharImage" ("OrgInlineImage" nil "as-char")) + ("ParagraphImage" ("OrgDisplayImage" nil "paragraph")) + ("PageImage" ("OrgPageImage" nil "page")) + ("CaptionedAs-CharImage" + ("OrgCaptionedImage" + " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") + ("OrgInlineImage" nil "as-char")) + ("CaptionedParagraphImage" + ("OrgCaptionedImage" + " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") + ("OrgImageCaptionFrame" nil "paragraph")) + ("CaptionedPageImage" + ("OrgCaptionedImage" + " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") + ("OrgPageImageCaptionFrame" nil "page")) + ("InlineFormula" ("OrgInlineFormula" nil "as-char")) + ("DisplayFormula" ("OrgDisplayFormula" nil "as-char")) + ("CaptionedDisplayFormula" + ("OrgCaptionedFormula" nil "paragraph") + ("OrgFormulaCaptionFrame" nil "paragraph")))) + (caption (car captions)) (short-caption (cdr captions)) + ;; Retrieve inner and outer frame params, from configuration. + (frame-cfg (assoc-string cfg-key frame-cfg-alist t)) + (inner (nth 1 frame-cfg)) + (outer (nth 2 frame-cfg)) + ;; User-specified frame params (from #+ATTR_ODT spec) + (user user-frame-params) + (--merge-frame-params (function + (lambda (default user) + "Merge default and user frame params." + (if (not user) default + (assert (= (length default) 3)) + (assert (= (length user) 3)) + (loop for u in user + for d in default + collect (or u d))))))) + (cond + ;; Case 1: Image/Formula has no caption. + ;; There is only one frame, one that surrounds the image + ;; or formula. + ((not caption) + ;; Merge user frame params with that from configuration. + (setq inner (funcall --merge-frame-params inner user)) + (apply 'org-odt--frame href width height + (append inner title-and-desc))) + ;; Case 2: Image/Formula is captioned or labeled. + ;; There are two frames: The inner one surrounds the + ;; image or formula. The outer one contains the + ;; caption/sequence number. + (t + ;; Merge user frame params with outer frame params. + (setq outer (funcall --merge-frame-params outer user)) + ;; Short caption, if specified, goes as part of inner frame. + (setq inner (let ((frame-params (copy-sequence inner))) + (setcar (cdr frame-params) + (concat + (cadr frame-params) + (when short-caption + (format " draw:name=\"%s\" " short-caption)))) + frame-params)) + (apply 'org-odt--textbox + (format "\n%s" + "Illustration" + (concat + (apply 'org-odt--frame href width height + (append inner title-and-desc)) + caption)) + width height outer))))) + +(defun org-odt--enumerable-p (element info) + ;; Element should have a caption or label. + (or (org-element-property :caption element) + (org-element-property :name element))) + +(defun org-odt--enumerable-image-p (element info) + (org-odt--standalone-link-p + element info + ;; Paragraph should have a caption or label. It SHOULD NOT be a + ;; replacement element. (i.e., It SHOULD NOT be a result of LaTeX + ;; processing.) + (lambda (p) + (and (not (org-element-property :replaces p)) + (or (org-element-property :caption p) + (org-element-property :name p)))) + ;; Link should point to an image file. + (lambda (l) + (assert (eq (org-element-type l) 'link)) + (org-export-inline-image-p l org-odt-inline-image-rules)))) + +(defun org-odt--enumerable-latex-image-p (element info) + (org-odt--standalone-link-p + element info + ;; Paragraph should have a caption or label. It SHOULD also be a + ;; replacement element. (i.e., It SHOULD be a result of LaTeX + ;; processing.) + (lambda (p) + (and (org-element-property :replaces p) + (or (org-element-property :caption p) + (org-element-property :name p)))) + ;; Link should point to an image file. + (lambda (l) + (assert (eq (org-element-type l) 'link)) + (org-export-inline-image-p l org-odt-inline-image-rules)))) + +(defun org-odt--enumerable-formula-p (element info) + (org-odt--standalone-link-p + element info + ;; Paragraph should have a caption or label. + (lambda (p) + (or (org-element-property :caption p) + (org-element-property :name p))) + ;; Link should point to a MathML or ODF file. + (lambda (l) + (assert (eq (org-element-type l) 'link)) + (org-export-inline-image-p l org-odt-inline-formula-rules)))) + +(defun org-odt--standalone-link-p (element info &optional + paragraph-predicate + link-predicate) + "Test if ELEMENT is a standalone link for the purpose ODT export. +INFO is a plist holding contextual information. + +Return non-nil, if ELEMENT is of type paragraph satisfying +PARAGRAPH-PREDICATE and it's sole content, save for whitespaces, +is a link that satisfies LINK-PREDICATE. + +Return non-nil, if ELEMENT is of type link satisfying +LINK-PREDICATE and it's containing paragraph satisfies +PARAGRAPH-PREDICATE inaddtion to having no other content save for +leading and trailing whitespaces. + +Return nil, otherwise." + (let ((p (case (org-element-type element) + (paragraph element) + (link (and (or (not link-predicate) + (funcall link-predicate element)) + (org-export-get-parent element))) + (t nil)))) + (when (and p (eq (org-element-type p) 'paragraph)) + (when (or (not paragraph-predicate) + (funcall paragraph-predicate p)) + (let ((contents (org-element-contents p))) + (loop for x in contents + with inline-image-count = 0 + always (case (org-element-type x) + (plain-text + (not (org-string-nw-p x))) + (link + (and (or (not link-predicate) + (funcall link-predicate x)) + (= (incf inline-image-count) 1))) + (t nil)))))))) + +(defun org-odt-link--infer-description (destination info) + ;; DESTINATION is a HEADLINE, a "<>" or an element (like + ;; paragraph, verse-block etc) to which a "#+NAME: label" can be + ;; attached. Note that labels that are attached to captioned + ;; entities - inline images, math formulae and tables - get resolved + ;; as part of `org-odt-format-label' and `org-odt--enumerate'. + + ;; Create a cross-reference to DESTINATION but make best-efforts to + ;; create a *meaningful* description. Check item numbers, section + ;; number and section title in that order. + + ;; NOTE: Counterpart of `org-export-get-ordinal'. + ;; FIXME: Handle footnote-definition footnote-reference? + (let* ((genealogy (org-export-get-genealogy destination)) + (data (reverse genealogy)) + (label (case (org-element-type destination) + (headline + (format "sec-%s" (mapconcat 'number-to-string + (org-export-get-headline-number + destination info) "-"))) + (target + (org-element-property :value destination)) + (t (error "FIXME: Resolve %S" destination))))) + (or + (let* ( ;; Locate top-level list. + (top-level-list + (loop for x on data + when (eq (org-element-type (car x)) 'plain-list) + return x)) + ;; Get list item nos. + (item-numbers + (loop for (plain-list item . rest) on top-level-list by #'cddr + until (not (eq (org-element-type plain-list) 'plain-list)) + collect (when (eq (org-element-property :type + plain-list) + 'ordered) + (1+ (length (org-export-get-previous-element + item info t)))))) + ;; Locate top-most listified headline. + (listified-headlines + (loop for x on data + when (and (eq (org-element-type (car x)) 'headline) + (org-export-low-level-p (car x) info)) + return x)) + ;; Get listified headline numbers. + (listified-headline-nos + (loop for el in listified-headlines + when (eq (org-element-type el) 'headline) + collect (when (org-export-numbered-headline-p el info) + (1+ (length (org-export-get-previous-element + el info t))))))) + ;; Combine item numbers from both the listified headlines and + ;; regular list items. + + ;; Case 1: Check if all the parents of list item are numbered. + ;; If yes, link to the item proper. + (let ((item-numbers (append listified-headline-nos item-numbers))) + (when (and item-numbers (not (memq nil item-numbers))) + (format "%s" + (org-export-solidify-link-text label) + (mapconcat (lambda (n) (if (not n) " " + (concat (number-to-string n) "."))) + item-numbers ""))))) + ;; Case 2: Locate a regular and numbered headline in the + ;; hierarchy. Display it's section number. + (let ((headline (loop for el in (cons destination genealogy) + when (and (eq (org-element-type el) 'headline) + (not (org-export-low-level-p el info)) + (org-export-numbered-headline-p el info)) + return el))) + ;; We found one. + (when headline + (format "%s" + (org-export-solidify-link-text label) + (mapconcat 'number-to-string (org-export-get-headline-number + headline info) ".")))) + ;; Case 4: Locate a regular headline in the hierarchy. Display + ;; it's title. + (let ((headline (loop for el in (cons destination genealogy) + when (and (eq (org-element-type el) 'headline) + (not (org-export-low-level-p el info))) + return el))) + ;; We found one. + (when headline + (format "%s" + (org-export-solidify-link-text label) + (let ((title (org-element-property :title headline))) + (org-export-data title info))))) + (error "FIXME?")))) + +(defun org-odt-link (link desc info) + "Transcode a LINK object from Org to ODT. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (and (not (string= desc "")) desc)) + (imagep (org-export-inline-image-p + link org-odt-inline-image-rules)) + (path (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((string= type "file") + (if (file-name-absolute-p raw-path) + (concat "file://" (expand-file-name raw-path)) + (concat "file://" raw-path))) + (t raw-path))) + ;; Convert & to & for correct XML representation + (path (replace-regexp-in-string "&" "&" path)) + protocol) + (cond + ;; Image file. + ((and (not desc) (org-export-inline-image-p + link org-odt-inline-image-rules)) + (org-odt-link--inline-image link info)) + ;; Formula file. + ((and (not desc) (org-export-inline-image-p + link org-odt-inline-formula-rules)) + (org-odt-link--inline-formula link info)) + ;; Radio target: Transcode target's contents and use them as + ;; link's description. + ((string= type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (when destination + (let ((desc (org-export-data (org-element-contents destination) info)) + (href (org-export-solidify-link-text path))) + (format + "%s" + href desc))))) + ;; 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)) + (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 + (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)))) + ;; Coderef: replace link with the reference name or the + ;; equivalent line number. + ((string= type "coderef") + (let* ((line-no (format "%d" (org-export-resolve-coderef path info))) + (href (concat "coderef-" path))) + (format + (org-export-get-coderef-format path desc) + (format + "%s" + href line-no)))) + ;; Link type is handled by a special function. + ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) + (funcall protocol (org-link-unescape path) desc 'odt)) + ;; External link with a description part. + ((and path desc) + (let ((link-contents (org-element-contents link))) + ;; Check if description is a link to an inline image. + (if (and (not (cdr link-contents)) + (let ((desc-element (car link-contents))) + (and (eq (org-element-type desc-element) 'link) + (org-export-inline-image-p + desc-element org-odt-inline-image-rules)))) + ;; Format link as a clickable image. + (format "\n\n%s\n" + path desc) + ;; Otherwise, format it as a regular link. + (format "%s" + path desc)))) + ;; External link without a description part. + (path + (format "%s" + path path)) + ;; No path, only description. Try to do something useful. + (t (format "%s" + "Emphasis" desc))))) + + +;;;; Paragraph + +(defun org-odt--format-paragraph (paragraph contents default center quote) + "Format paragraph according to given styles. +PARAGRAPH is a paragraph type element. CONTENTS is the +transcoded contents of that paragraph, as a string. DEFAULT, +CENTER and QUOTE are, respectively, style to use when paragraph +belongs to no special environment, a center block, or a quote +block." + (let* ((parent (org-export-get-parent paragraph)) + (parent-type (org-element-type parent)) + (style (case parent-type + (quote-block quote) + (center-block center) + (t default)))) + ;; If this paragraph is a leading paragraph in an item and the + ;; item has a checkbox, splice the checkbox and paragraph contents + ;; together. + (when (and (eq (org-element-type parent) 'item) + (eq paragraph (car (org-element-contents parent)))) + (setq contents (concat (org-odt--checkbox parent) contents))) + (format "\n%s" style contents))) + +(defun org-odt-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to ODT. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + (org-odt--format-paragraph + paragraph contents + (or (org-element-property :style paragraph) "Text_20_body") + "OrgCenter" + "Quotations")) + + +;;;; Plain List + +(defun org-odt-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to ODT. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (format "\n\n%s" + ;; Choose style based on list type. + (case (org-element-property :type plain-list) + (ordered "OrgNumberedList") + (unordered "OrgBulletedList") + (descriptive-1 "OrgDescriptionList") + (descriptive-2 "OrgDescriptionList")) + ;; If top-level list, re-start numbering. Otherwise, + ;; continue numbering. + (format "text:continue-numbering=\"%s\"" + (let* ((parent (org-export-get-parent plain-list))) + (if (and parent (eq (org-element-type parent) 'item)) + "true" "false"))) + contents)) + +;;;; Plain Text + +(defun org-odt--encode-tabs-and-spaces (line) + (replace-regexp-in-string + "\\([\t]\\|\\([ ]+\\)\\)" + (lambda (s) + (cond + ((string= s "\t") "") + (t (let ((n (length s))) + (cond + ((= n 1) " ") + ((> n 1) (concat " " (format "" (1- n)))) + (t "")))))) + line)) + +(defun org-odt--encode-plain-text (text &optional no-whitespace-filling) + (mapc + (lambda (pair) + (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))) + '(("&" . "&") ("<" . "<") (">" . ">"))) + (if no-whitespace-filling text + (org-odt--encode-tabs-and-spaces text))) + +(defun org-odt-plain-text (text info) + "Transcode a TEXT string from Org to ODT. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (let ((output text)) + ;; Protect &, < and >. + (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)) + ;; Convert special strings. + (when (plist-get info :with-special-strings) + (mapc + (lambda (pair) + (setq output + (replace-regexp-in-string (car pair) (cdr pair) output t nil))) + org-odt-special-string-regexps)) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" "\n" output t))) + ;; Return value. + output)) + + +;;;; Planning + +(defun org-odt-planning (planning contents info) + "Transcode a PLANNING element from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "\n%s" + "OrgPlanning" + (concat + (let ((closed (org-element-property :closed planning))) + (when closed + (concat + (format "%s" + "OrgClosedKeyword" org-closed-string) + (org-odt-timestamp closed contents info)))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat + (format "%s" + "OrgDeadlineKeyword" org-deadline-string) + (org-odt-timestamp deadline contents info)))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat + (format "%s" + "OrgScheduledKeyword" org-deadline-string) + (org-odt-timestamp scheduled contents info))))))) + + +;;;; Property Drawer + +(defun org-odt-property-drawer (property-drawer contents info) + "Transcode a PROPERTY-DRAWER element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual +information." + ;; The property drawer isn't exported but we want separating blank + ;; lines nonetheless. + "") + + +;;;; Quote Block + +(defun org-odt-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + contents) + + +;;;; Quote Section + +(defun org-odt-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (org-odt-do-format-code value)))) + + +;;;; Section + +(defun org-odt-format-section (text style &optional name) + (let ((default-name (car (org-odt-add-automatic-style "Section")))) + (format "\n\n%s\n" + style + (format "text:name=\"%s\"" (or name default-name)) + text))) + + +(defun org-odt-section (section contents info) ; FIXME + "Transcode a SECTION element from Org to ODT. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + contents) + +;;;; Radio Target + +(defun org-odt-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to ODT. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (org-odt--target + text (org-export-solidify-link-text + (org-element-property :value radio-target)))) + + +;;;; Special Block + +(defun org-odt-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((type (downcase (org-element-property :type special-block))) + (attributes (org-export-read-attribute :attr_odt special-block))) + (cond + ;; Annotation. + ((string= type "annotation") + (let* ((author (or (plist-get attributes :author) + (let ((author (plist-get info :author))) + (and author (org-export-data author info))))) + (date (or (plist-get attributes :date) + ;; FIXME: Is `car' right thing to do below? + (car (plist-get info :date))))) + (format "\n%s" + (format "\n%s\n" + (concat + (and author + (format "%s" author)) + (and date + (format "%s" + (org-odt--format-timestamp date nil 'iso-date))) + contents))))) + ;; Textbox. + ((string= type "textbox") + (let ((width (plist-get attributes :width)) + (height (plist-get attributes :height)) + (style (plist-get attributes :style)) + (extra (plist-get attributes :extra)) + (anchor (plist-get attributes :anchor))) + (format "\n%s" + "Text_20_body" (org-odt--textbox contents width height + style extra anchor)))) + (t contents)))) + + +;;;; Src Block + +(defun org-odt-hfy-face-to-css (fn) + "Create custom style for face FN. +When FN is the default face, use it's foreground and background +properties to create \"OrgSrcBlock\" paragraph style. Otherwise +use it's color attribute to create a character style whose name +is obtained from FN. Currently all attributes of FN other than +color are ignored. + +The style name for a face FN is derived using the following +operations on the face name in that order - de-dash, CamelCase +and prefix with \"OrgSrc\". For example, +`font-lock-function-name-face' is associated with +\"OrgSrcFontLockFunctionNameFace\"." + (let* ((css-list (hfy-face-to-style fn)) + (style-name ((lambda (fn) + (concat "OrgSrc" + (mapconcat + 'capitalize (split-string + (hfy-face-or-def-to-name fn) "-") + ""))) fn)) + (color-val (cdr (assoc "color" css-list))) + (background-color-val (cdr (assoc "background" css-list))) + (style (and org-odt-create-custom-styles-for-srcblocks + (cond + ((eq fn 'default) + (format org-odt-src-block-paragraph-format + background-color-val color-val)) + (t + (format + " + + + " style-name color-val)))))) + (cons style-name style))) + +(defun org-odt-htmlfontify-string (line) + (let* ((hfy-html-quote-regex "\\([<\"&> ]\\)") + (hfy-html-quote-map '(("\"" """) + ("<" "<") + ("&" "&") + (">" ">") + (" " "") + (" " ""))) + (hfy-face-to-css 'org-odt-hfy-face-to-css) + (hfy-optimisations-1 (copy-sequence hfy-optimisations)) + (hfy-optimisations (add-to-list 'hfy-optimisations-1 + 'body-text-only)) + (hfy-begin-span-handler + (lambda (style text-block text-id text-begins-block-p) + (insert (format "" style)))) + (hfy-end-span-handler (lambda nil (insert "")))) + (org-no-warnings (htmlfontify-string line)))) + +(defun org-odt-do-format-code + (code &optional lang refs retain-labels num-start) + (let* ((lang (or (assoc-default lang org-src-lang-modes) lang)) + (lang-mode (and lang (intern (format "%s-mode" lang)))) + (code-lines (org-split-string code "\n")) + (code-length (length code-lines)) + (use-htmlfontify-p (and (functionp lang-mode) + org-odt-fontify-srcblocks + (require 'htmlfontify nil t) + (fboundp 'htmlfontify-string))) + (code (if (not use-htmlfontify-p) code + (with-temp-buffer + (insert code) + (funcall lang-mode) + (font-lock-fontify-buffer) + (buffer-string)))) + (fontifier (if use-htmlfontify-p 'org-odt-htmlfontify-string + 'org-odt--encode-plain-text)) + (par-style (if use-htmlfontify-p "OrgSrcBlock" + "OrgFixedWidthBlock")) + (i 0)) + (assert (= code-length (length (org-split-string code "\n")))) + (setq code + (org-export-format-code + code + (lambda (loc line-num ref) + (setq par-style + (concat par-style (and (= (incf i) code-length) "LastLine"))) + + (setq loc (concat loc (and ref retain-labels (format " (%s)" ref)))) + (setq loc (funcall fontifier loc)) + (when ref + (setq loc (org-odt--target loc (concat "coderef-" ref)))) + (assert par-style) + (setq loc (format "\n%s" + par-style loc)) + (if (not line-num) loc + (format "\n%s\n" loc))) + num-start refs)) + (cond + ((not num-start) code) + ((= num-start 0) + (format + "\n%s" + " text:continue-numbering=\"false\"" code)) + (t + (format + "\n%s" + " text:continue-numbering=\"true\"" code))))) + +(defun org-odt-format-code (element info) + (let* ((lang (org-element-property :language element)) + ;; Extract code and references. + (code-info (org-export-unravel-code element)) + (code (car code-info)) + (refs (cdr code-info)) + ;; Does the src block contain labels? + (retain-labels (org-element-property :retain-labels element)) + ;; Does it have line numbers? + (num-start (case (org-element-property :number-lines element) + (continued (org-export-get-loc element info)) + (new 0)))) + (org-odt-do-format-code code lang refs retain-labels num-start))) + +(defun org-odt-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to ODT. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((lang (org-element-property :language src-block)) + (attributes (org-export-read-attribute :attr_odt src-block)) + (captions (org-odt-format-label src-block info 'definition)) + (caption (car captions)) (short-caption (cdr captions))) + (concat + (and caption + (format "\n%s" + "Listing" caption)) + (let ((--src-block (org-odt-format-code src-block info))) + (if (not (plist-get attributes :textbox)) --src-block + (format "\n%s" + "Text_20_body" + (org-odt--textbox --src-block nil nil nil))))))) + + +;;;; Statistics Cookie + +(defun org-odt-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((cookie-value (org-element-property :value statistics-cookie))) + (format "%s" + "OrgCode" cookie-value))) + + +;;;; Strike-Through + +(defun org-odt-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to ODT. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (format "%s" + "Strikethrough" contents)) + + +;;;; Subscript + +(defun org-odt-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to ODT. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "%s" + "OrgSubscript" contents)) + + +;;;; Superscript + +(defun org-odt-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to ODT. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "%s" + "OrgSuperscript" contents)) + + +;;;; Table Cell + +(defun org-odt-table-style-spec (element info) + (let* ((table (org-export-get-parent-table element)) + (table-attributes (org-export-read-attribute :attr_odt table)) + (table-style (plist-get table-attributes :style))) + (assoc table-style org-odt-table-styles))) + +(defun org-odt-get-table-cell-styles (table-cell info) + "Retrieve styles applicable to a table cell. +R and C are (zero-based) row and column numbers of the table +cell. STYLE-SPEC is an entry in `org-odt-table-styles' +applicable to the current table. It is `nil' if the table is not +associated with any style attributes. + +Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME). + +When STYLE-SPEC is nil, style the table cell the conventional way +- choose cell borders based on row and column groupings and +choose paragraph alignment based on `org-col-cookies' text +property. See also +`org-odt-get-paragraph-style-cookie-for-table-cell'. + +When STYLE-SPEC is non-nil, ignore the above cookie and return +styles congruent with the ODF-1.2 specification." + (let* ((table-cell-address (org-export-table-cell-address table-cell info)) + (r (car table-cell-address)) (c (cdr table-cell-address)) + (style-spec (org-odt-table-style-spec table-cell info)) + (table-dimensions (org-export-table-dimensions + (org-export-get-parent-table table-cell) + info))) + (when style-spec + ;; LibreOffice - particularly the Writer - honors neither table + ;; templates nor custom table-cell styles. Inorder to retain + ;; inter-operability with LibreOffice, only automatic styles are + ;; used for styling of table-cells. The current implementation is + ;; congruent with ODF-1.2 specification and hence is + ;; future-compatible. + + ;; Additional Note: LibreOffice's AutoFormat facility for tables - + ;; which recognizes as many as 16 different cell types - is much + ;; richer. Unfortunately it is NOT amenable to easy configuration + ;; by hand. + (let* ((template-name (nth 1 style-spec)) + (cell-style-selectors (nth 2 style-spec)) + (cell-type + (cond + ((and (cdr (assoc 'use-first-column-styles cell-style-selectors)) + (= c 0)) "FirstColumn") + ((and (cdr (assoc 'use-last-column-styles cell-style-selectors)) + (= (1+ c) (cdr table-dimensions))) + "LastColumn") + ((and (cdr (assoc 'use-first-row-styles cell-style-selectors)) + (= r 0)) "FirstRow") + ((and (cdr (assoc 'use-last-row-styles cell-style-selectors)) + (= (1+ r) (car table-dimensions))) + "LastRow") + ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) + (= (% r 2) 1)) "EvenRow") + ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) + (= (% r 2) 0)) "OddRow") + ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) + (= (% c 2) 1)) "EvenColumn") + ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) + (= (% c 2) 0)) "OddColumn") + (t "")))) + (concat template-name cell-type))))) + +(defun org-odt-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let* ((table-cell-address (org-export-table-cell-address table-cell info)) + (r (car table-cell-address)) + (c (cdr table-cell-address)) + (horiz-span (or (org-export-table-cell-width table-cell info) 0)) + (table-row (org-export-get-parent table-cell)) + (custom-style-prefix (org-odt-get-table-cell-styles + table-cell info)) + (paragraph-style + (or + (and custom-style-prefix + (format "%sTableParagraph" custom-style-prefix)) + (concat + (cond + ((and (= 1 (org-export-table-row-group table-row info)) + (org-export-table-has-header-p + (org-export-get-parent-table table-row) info)) + "OrgTableHeading") + ((let* ((table (org-export-get-parent-table table-cell)) + (table-attrs (org-export-read-attribute :attr_odt table)) + (table-header-columns + (let ((cols (plist-get table-attrs :header-columns))) + (and cols (read cols))))) + (<= c (cond ((wholenump table-header-columns) + (- table-header-columns 1)) + (table-header-columns 0) + (t -1)))) + "OrgTableHeading") + (t "OrgTableContents")) + (capitalize (symbol-name (org-export-table-cell-alignment + table-cell info)))))) + (cell-style-name + (or + (and custom-style-prefix (format "%sTableCell" + custom-style-prefix)) + (concat + "OrgTblCell" + (when (or (org-export-table-row-starts-rowgroup-p table-row info) + (zerop r)) "T") + (when (org-export-table-row-ends-rowgroup-p table-row info) "B") + (when (and (org-export-table-cell-starts-colgroup-p table-cell info) + (not (zerop c)) ) "L")))) + (cell-attributes + (concat + (format " table:style-name=\"%s\"" cell-style-name) + (and (> horiz-span 0) + (format " table:number-columns-spanned=\"%d\"" + (1+ horiz-span)))))) + (unless contents (setq contents "")) + (concat + (assert paragraph-style) + (format "\n\n%s\n" + cell-attributes + (let ((table-cell-contents (org-element-contents table-cell))) + (if (memq (org-element-type (car table-cell-contents)) + org-element-all-elements) + contents + (format "\n%s" + paragraph-style contents)))) + (let (s) + (dotimes (i horiz-span s) + (setq s (concat s "\n")))) + "\n"))) + + +;;;; Table Row + +(defun org-odt-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to ODT. +CONTENTS is the contents of the row. INFO is a plist used as a +communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let* ((rowgroup-tags + (if (and (= 1 (org-export-table-row-group table-row info)) + (org-export-table-has-header-p + (org-export-get-parent-table table-row) info)) + ;; If the row belongs to the first rowgroup and the + ;; table has more than one row groups, then this row + ;; belongs to the header row group. + '("\n" . "\n") + ;; Otherwise, it belongs to non-header row group. + '("\n" . "\n")))) + (concat + ;; Does this row begin a rowgroup? + (when (org-export-table-row-starts-rowgroup-p table-row info) + (car rowgroup-tags)) + ;; Actual table row + (format "\n\n%s\n" contents) + ;; Does this row end a rowgroup? + (when (org-export-table-row-ends-rowgroup-p table-row info) + (cdr rowgroup-tags)))))) + + +;;;; Table + +(defun org-odt-table-first-row-data-cells (table info) + (let ((table-row + (org-element-map table 'table-row + (lambda (row) + (unless (eq (org-element-property :type row) 'rule) row)) + info 'first-match)) + (special-column-p (org-export-table-has-special-column-p table))) + (if (not special-column-p) (org-element-contents table-row) + (cdr (org-element-contents table-row))))) + +(defun org-odt--table (table contents info) + "Transcode a TABLE element from Org to ODT. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (case (org-element-property :type table) + ;; Case 1: table.el doesn't support export to OD format. Strip + ;; such tables from export. + (table.el + (prog1 nil + (message + (concat + "(ox-odt): Found table.el-type table in the source Org file." + " table.el doesn't support export to ODT format." + " Stripping the table from export.")))) + ;; Case 2: Native Org tables. + (otherwise + (let* ((captions (org-odt-format-label table info 'definition)) + (caption (car captions)) (short-caption (cdr captions)) + (attributes (org-export-read-attribute :attr_odt table)) + (custom-table-style (nth 1 (org-odt-table-style-spec table info))) + (table-column-specs + (function + (lambda (table info) + (let* ((table-style (or custom-table-style "OrgTable")) + (column-style (format "%sColumn" table-style))) + (mapconcat + (lambda (table-cell) + (let ((width (1+ (or (org-export-table-cell-width + table-cell info) 0))) + (s (format + "\n" + column-style)) + out) + (dotimes (i width out) (setq out (concat s out))))) + (org-odt-table-first-row-data-cells table info) "\n")))))) + (concat + ;; caption. + (when caption + (format "\n%s" + "Table" caption)) + ;; begin table. + (let* ((automatic-name + (org-odt-add-automatic-style "Table" attributes))) + (format + "\n" + (or custom-table-style (cdr automatic-name) "OrgTable") + (concat (when short-caption + (format " table:name=\"%s\"" short-caption))))) + ;; column specification. + (funcall table-column-specs table info) + ;; actual contents. + "\n" contents + ;; end table. + ""))))) + +(defun org-odt-table (table contents info) + "Transcode a TABLE element from Org to ODT. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information. + +Use `org-odt--table' to typeset the table. Handle details +pertaining to indentation here." + (let* ((--element-preceded-by-table-p + (function + (lambda (element info) + (loop for el in (org-export-get-previous-element element info t) + thereis (eq (org-element-type el) 'table))))) + (--walk-list-genealogy-and-collect-tags + (function + (lambda (table info) + (let* ((genealogy (org-export-get-genealogy table)) + (list-genealogy + (when (eq (org-element-type (car genealogy)) 'item) + (loop for el in genealogy + when (memq (org-element-type el) + '(item plain-list)) + collect el))) + (llh-genealogy + (apply 'nconc + (loop for el in genealogy + when (and (eq (org-element-type el) 'headline) + (org-export-low-level-p el info)) + collect + (list el + (assq 'headline + (org-element-contents + (org-export-get-parent el))))))) + parent-list) + (nconc + ;; Handle list genealogy. + (loop for el in list-genealogy collect + (case (org-element-type el) + (plain-list + (setq parent-list el) + (cons "" + (format "\n" + (case (org-element-property :type el) + (ordered "OrgNumberedList") + (unordered "OrgBulletedList") + (descriptive-1 "OrgDescriptionList") + (descriptive-2 "OrgDescriptionList")) + "text:continue-numbering=\"true\""))) + (item + (cond + ((not parent-list) + (if (funcall --element-preceded-by-table-p table info) + '("" . "") + '("" . ""))) + ((funcall --element-preceded-by-table-p + parent-list info) + '("" . "")) + (t '("" . "")))))) + ;; Handle low-level headlines. + (loop for el in llh-genealogy + with step = 'item collect + (case step + (plain-list + (setq step 'item) ; Flip-flop + (setq parent-list el) + (cons "" + (format "\n" + (if (org-export-numbered-headline-p + el info) + "OrgNumberedList" + "OrgBulletedList") + "text:continue-numbering=\"true\""))) + (item + (setq step 'plain-list) ; Flip-flop + (cond + ((not parent-list) + (if (funcall --element-preceded-by-table-p table info) + '("" . "") + '("" . ""))) + ((let ((section? (org-export-get-previous-element + parent-list info))) + (and section? + (eq (org-element-type section?) 'section) + (assq 'table (org-element-contents section?)))) + '("" . "")) + (t + '("" . ""))))))))))) + (close-open-tags (funcall --walk-list-genealogy-and-collect-tags + table info))) + ;; OpenDocument schema does not permit table to occur within a + ;; list item. + + ;; One solution - the easiest and lightweight, in terms of + ;; implementation - is to put the table in an indented text box + ;; and make the text box part of the list-item. Unfortunately if + ;; the table is big and spans multiple pages, the text box could + ;; overflow. In this case, the following attribute will come + ;; handy. + + ;; ,---- From OpenDocument-v1.1.pdf + ;; | 15.27.28 Overflow behavior + ;; | + ;; | For text boxes contained within text document, the + ;; | style:overflow-behavior property specifies the behavior of text + ;; | boxes where the containing text does not fit into the text + ;; | box. + ;; | + ;; | If the attribute's value is clip, the text that does not fit + ;; | into the text box is not displayed. + ;; | + ;; | If the attribute value is auto-create-new-frame, a new frame + ;; | will be created on the next page, with the same position and + ;; | dimensions of the original frame. + ;; | + ;; | If the style:overflow-behavior property's value is + ;; | auto-create-new-frame and the text box has a minimum width or + ;; | height specified, then the text box will grow until the page + ;; | bounds are reached before a new frame is created. + ;; `---- + + ;; Unfortunately, LibreOffice-3.4.6 doesn't honor + ;; auto-create-new-frame property and always resorts to clipping + ;; the text box. This results in table being truncated. + + ;; So we solve the problem the hard (and fun) way using list + ;; continuations. + + ;; The problem only becomes more interesting if you take in to + ;; account the following facts: + ;; + ;; - Description lists are simulated as plain lists. + ;; - Low-level headlines can be listified. + ;; - In Org-mode, a table can occur not only as a regular list + ;; item, but also within description lists and low-level + ;; headlines. + + ;; See `org-odt-translate-description-lists' and + ;; `org-odt-translate-low-level-headlines' for how this is + ;; tackled. + + (concat "\n" + ;; Discontinue the list. + (mapconcat 'car close-open-tags "\n") + ;; Put the table in an indented section. + (let* ((table (org-odt--table table contents info)) + (level (/ (length (mapcar 'car close-open-tags)) 2)) + (style (format "OrgIndentedSection-Level-%d" level))) + (when table (org-odt-format-section table style))) + ;; Continue the list. + (mapconcat 'cdr (nreverse close-open-tags) "\n")))) + + +;;;; Target + +(defun org-odt-target (target contents info) + "Transcode a TARGET object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-element-property :value target))) + (org-odt--target "" (org-export-solidify-link-text value)))) + + +;;;; Timestamp + +(defun org-odt-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let* ((raw-value (org-element-property :raw-value timestamp)) + (type (org-element-property :type timestamp))) + (if (not org-odt-use-date-fields) + (let ((value (org-odt-plain-text + (org-timestamp-translate timestamp) info))) + (case (org-element-property :type timestamp) + ((active active-range) + (format "%s" + "OrgActiveTimestamp" value)) + ((inactive inactive-range) + (format "%s" + "OrgInactiveTimestamp" value)) + (otherwise value))) + (case type + (active + (format "%s" + "OrgActiveTimestamp" + (format "<%s>" (org-odt--format-timestamp timestamp)))) + (inactive + (format "%s" + "OrgInactiveTimestamp" + (format "[%s]" (org-odt--format-timestamp timestamp)))) + (active-range + (format "%s" + "OrgActiveTimestamp" + (format "<%s>–<%s>" + (org-odt--format-timestamp timestamp) + (org-odt--format-timestamp timestamp 'end)))) + (inactive-range + (format "%s" + "OrgInactiveTimestamp" + (format "[%s]–[%s]" + (org-odt--format-timestamp timestamp) + (org-odt--format-timestamp timestamp 'end)))) + (otherwise + (format "%s" + "OrgDiaryTimestamp" + (org-odt-plain-text (org-timestamp-translate timestamp) + info))))))) + + +;;;; Underline + +(defun org-odt-underline (underline contents info) + "Transcode UNDERLINE from Org to ODT. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (format "%s" + "Underline" contents)) + + +;;;; Verbatim + +(defun org-odt-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "%s" + "OrgCode" (org-odt--encode-plain-text + (org-element-property :value verbatim)))) + + +;;;; Verse Block + +(defun org-odt-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to ODT. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + ;; Add line breaks to each line of verse. + (setq contents (replace-regexp-in-string + "\\(\\)?[ \t]*\n" + "" contents)) + ;; Replace tabs and spaces. + (setq contents (org-odt--encode-tabs-and-spaces contents)) + ;; Surround it in a verse environment. + (format "\n%s" + "OrgVerse" contents)) + + + +;;; Filters + +;;;; LaTeX fragments + +(defun org-odt--translate-latex-fragments (tree backend info) + (let ((processing-type (plist-get info :with-latex)) + (count 0)) + ;; Normalize processing-type to one of dvipng, mathml or verbatim. + ;; If the desired converter is not available, force verbatim + ;; processing. + (case processing-type + ((t mathml) + (if (and (fboundp 'org-format-latex-mathml-available-p) + (org-format-latex-mathml-available-p)) + (setq processing-type 'mathml) + (message "LaTeX to MathML converter not available.") + (setq processing-type 'verbatim))) + (dvipng + (unless (and (org-check-external-command "latex" "" t) + (org-check-external-command "dvipng" "" t)) + (message "LaTeX to PNG converter not available.") + (setq processing-type 'verbatim))) + (otherwise + (message "Unknown LaTeX option. Forcing verbatim.") + (setq processing-type 'verbatim))) + + ;; Store normalized value for later use. + (when (plist-get info :with-latex) + (plist-put info :with-latex processing-type)) + (message "Formatting LaTeX using %s" processing-type) + + ;; Convert `latex-fragment's and `latex-environment's. + (when (memq processing-type '(mathml dvipng)) + (org-element-map tree '(latex-fragment latex-environment) + (lambda (latex-*) + (incf count) + (let* ((latex-frag (org-element-property :value latex-*)) + (input-file (plist-get info :input-file)) + (cache-dir (file-name-directory input-file)) + (cache-subdir (concat + (case processing-type + (dvipng "ltxpng/") + (mathml "ltxmathml/")) + (file-name-sans-extension + (file-name-nondirectory input-file)))) + (display-msg + (case processing-type + (dvipng (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. + (org-link + (let ((link (with-temp-buffer + (insert latex-frag) + (org-format-latex cache-subdir cache-dir + nil display-msg + nil nil processing-type) + (buffer-substring-no-properties + (point-min) (point-max))))) + (if (not (string-match "file:\\([^]]*\\)" link)) + (prog1 nil (message "LaTeX Conversion failed.")) + link)))) + (when org-link + ;; Conversion succeeded. Parse above Org-style link to a + ;; `link' object. + (let* ((link (car (org-element-map (with-temp-buffer + (org-mode) + (insert org-link) + (org-element-parse-buffer)) + 'link 'identity)))) + ;; Orphan the link. + (org-element-put-property link :parent nil) + (let* ( + (replacement + (case (org-element-type latex-*) + ;; Case 1: LaTeX environment. + ;; Mimic a "standalone image or formula" by + ;; enclosing the `link' in a `paragraph'. + ;; Copy over original attributes, captions to + ;; the enclosing paragraph. + (latex-environment + (org-element-adopt-elements + (list 'paragraph + (list :style "OrgFormula" + :name (org-element-property :name + latex-*) + :caption (org-element-property :caption + latex-*))) + link)) + ;; Case 2: LaTeX fragment. + ;; No special action. + (latex-fragment link)))) + ;; Note down the object that link replaces. + (org-element-put-property replacement :replaces + (list (org-element-type latex-*) + (list :value latex-frag))) + ;; Replace now. + (org-element-set-element latex-* replacement)))))) + info))) + tree) + + +;;;; Description lists + +;; This translator is necessary to handle indented tables in a uniform +;; manner. See comment in `org-odt--table'. + +(defun org-odt--translate-description-lists (tree backend info) + ;; OpenDocument has no notion of a description list. So simulate it + ;; using plain lists. Description lists in the exported document + ;; are typeset in the same manner as they are in a typical HTML + ;; document. + ;; + ;; Specifically, a description list like this: + ;; + ;; ,---- + ;; | - term-1 :: definition-1 + ;; | - term-2 :: definition-2 + ;; `---- + ;; + ;; gets translated in to the following form: + ;; + ;; ,---- + ;; | - term-1 + ;; | - definition-1 + ;; | - term-2 + ;; | - definition-2 + ;; `---- + ;; + ;; Further effect is achieved by fixing the OD styles as below: + ;; + ;; 1. Set the :type property of the simulated lists to + ;; `descriptive-1' and `descriptive-2'. Map these to list-styles + ;; that has *no* bullets whatsoever. + ;; + ;; 2. The paragraph containing the definition term is styled to be + ;; in bold. + ;; + (org-element-map tree 'plain-list + (lambda (el) + (when (equal (org-element-property :type el) 'descriptive) + (org-element-set-element + el + (apply 'org-element-adopt-elements + (list 'plain-list (list :type 'descriptive-1)) + (mapcar + (lambda (item) + (org-element-adopt-elements + (list 'item (list :checkbox (org-element-property + :checkbox item))) + (list 'paragraph (list :style "Text_20_body_20_bold") + (or (org-element-property :tag item) "(no term)")) + (org-element-adopt-elements + (list 'plain-list (list :type 'descriptive-2)) + (apply 'org-element-adopt-elements + (list 'item nil) + (org-element-contents item))))) + (org-element-contents el))))) + nil) + info) + tree) + +;;;; List tables + +;; Lists that are marked with attribute `:list-table' are called as +;; list tables. They will be rendered as a table within the exported +;; document. + +;; Consider an example. The following list table +;; +;; #+attr_odt :list-table t +;; - Row 1 +;; - 1.1 +;; - 1.2 +;; - 1.3 +;; - Row 2 +;; - 2.1 +;; - 2.2 +;; - 2.3 +;; +;; will be exported as though it were an Org table like the one show +;; below. +;; +;; | Row 1 | 1.1 | 1.2 | 1.3 | +;; | Row 2 | 2.1 | 2.2 | 2.3 | +;; +;; Note that org-tables are NOT multi-line and each line is mapped to +;; a unique row in the exported document. So if an exported table +;; needs to contain a single paragraph (with copious text) it needs to +;; be typed up in a single line. Editing such long lines using the +;; table editor will be a cumbersome task. Furthermore inclusion of +;; multi-paragraph text in a table cell is well-nigh impossible. +;; +;; A LIST-TABLE circumvents above problems. +;; +;; Note that in the example above the list items could be paragraphs +;; themselves and the list can be arbitrarily deep. +;; +;; Inspired by following thread: +;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html + +;; Translate lists to tables + +(defun org-odt--translate-list-tables (tree backend info) + (org-element-map tree 'plain-list + (lambda (l1-list) + (when (org-export-read-attribute :attr_odt l1-list :list-table) + ;; Replace list with table. + (org-element-set-element + l1-list + ;; Build replacement table. + (apply 'org-element-adopt-elements + (list 'table '(:type org :attr_odt (":style \"GriddedTable\""))) + (org-element-map l1-list 'item + (lambda (l1-item) + (let* ((l1-item-contents (org-element-contents l1-item)) + l1-item-leading-text l2-list) + ;; Remove Level-2 list from the Level-item. It + ;; will be subsequently attached as table-cells. + (let ((cur l1-item-contents) prev) + (while (and cur (not (eq (org-element-type (car cur)) + 'plain-list))) + (setq prev cur) + (setq cur (cdr cur))) + (when prev + (setcdr prev nil) + (setq l2-list (car cur))) + (setq l1-item-leading-text l1-item-contents)) + ;; Level-1 items start a table row. + (apply 'org-element-adopt-elements + (list 'table-row (list :type 'standard)) + ;; Leading text of level-1 item define + ;; the first table-cell. + (apply 'org-element-adopt-elements + (list 'table-cell nil) + l1-item-leading-text) + ;; Level-2 items define subsequent + ;; table-cells of the row. + (org-element-map l2-list 'item + (lambda (l2-item) + (apply 'org-element-adopt-elements + (list 'table-cell nil) + (org-element-contents l2-item))) + info nil 'item)))) + info nil 'item)))) + nil) + info) + tree) + + +;;; Interactive functions + +(defun org-odt-create-manifest-file-entry (&rest args) + (push args org-odt-manifest-file-entries)) + +(defun org-odt-write-manifest-file () + (make-directory (concat org-odt-zip-dir "META-INF")) + (let ((manifest-file (concat org-odt-zip-dir "META-INF/manifest.xml"))) + (with-current-buffer + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect manifest-file t)) + (insert + " + \n") + (mapc + (lambda (file-entry) + (let* ((version (nth 2 file-entry)) + (extra (if (not version) "" + (format " manifest:version=\"%s\"" version)))) + (insert + (format org-odt-manifest-file-entry-tag + (nth 0 file-entry) (nth 1 file-entry) extra)))) + org-odt-manifest-file-entries) + (insert "\n")))) + +(defmacro org-odt--export-wrap (out-file &rest body) + `(let* ((--out-file ,out-file) + (out-file-type (file-name-extension --out-file)) + (org-odt-xml-files '("META-INF/manifest.xml" "content.xml" + "meta.xml" "styles.xml")) + ;; Initialize temporary workarea. All files that end up in + ;; the exported document get parked/created here. + (org-odt-zip-dir (file-name-as-directory + (make-temp-file (format "%s-" out-file-type) t))) + (org-odt-manifest-file-entries nil) + (--cleanup-xml-buffers + (function + (lambda nil + ;; Kill all XML buffers. + (mapc (lambda (file) + (let ((buf (find-buffer-visiting + (concat org-odt-zip-dir file)))) + (when buf + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))))) + org-odt-xml-files) + ;; Delete temporary directory and also other embedded + ;; files that get copied there. + (delete-directory org-odt-zip-dir t))))) + (condition-case err + (progn + (unless (executable-find "zip") + ;; Not at all OSes ship with zip by default + (error "Executable \"zip\" needed for creating OpenDocument files")) + ;; Do export. This creates a bunch of xml files ready to be + ;; saved and zipped. + (progn ,@body) + ;; Create a manifest entry for content.xml. + (org-odt-create-manifest-file-entry "text/xml" "content.xml") + ;; Write mimetype file + (let* ((mimetypes + '(("odt" . "application/vnd.oasis.opendocument.text") + ("odf" . "application/vnd.oasis.opendocument.formula"))) + (mimetype (cdr (assoc-string out-file-type mimetypes t)))) + (unless mimetype + (error "Unknown OpenDocument backend %S" out-file-type)) + (write-region mimetype nil (concat org-odt-zip-dir "mimetype")) + (org-odt-create-manifest-file-entry mimetype "/" "1.2")) + ;; Write out the manifest entries before zipping + (org-odt-write-manifest-file) + ;; Save all XML files. + (mapc (lambda (file) + (let ((buf (find-buffer-visiting + (concat org-odt-zip-dir file)))) + (when buf + (with-current-buffer buf + ;; Prettify output if needed. + (when org-odt-prettify-xml + (indent-region (point-min) (point-max))) + (save-buffer 0))))) + org-odt-xml-files) + ;; Run zip. + (let* ((target --out-file) + (target-name (file-name-nondirectory target)) + (cmds `(("zip" "-mX0" ,target-name "mimetype") + ("zip" "-rmTq" ,target-name ".")))) + ;; If a file with same name as the desired output file + ;; exists, remove it. + (when (file-exists-p target) + (delete-file target)) + ;; Zip up the xml files. + (let ((coding-system-for-write 'no-conversion) exitcode err-string) + (message "Creating ODT file...") + ;; Switch temporarily to content.xml. This way Zip + ;; process will inherit `org-odt-zip-dir' as the current + ;; directory. + (with-current-buffer + (find-file-noselect (concat org-odt-zip-dir "content.xml") t) + (mapc + (lambda (cmd) + (message "Running %s" (mapconcat 'identity cmd " ")) + (setq err-string + (with-output-to-string + (setq exitcode + (apply 'call-process (car cmd) + nil standard-output nil (cdr cmd))))) + (or (zerop exitcode) + (error (concat "Unable to create OpenDocument file." + (format " Zip failed with error (%s)" + err-string))))) + cmds))) + ;; Move the zip file from temporary work directory to + ;; user-mandated location. + (rename-file (concat org-odt-zip-dir target-name) target) + (message "Created %s" (expand-file-name target)) + ;; Cleanup work directory and work files. + (funcall --cleanup-xml-buffers) + ;; Open the OpenDocument file in archive-mode for + ;; examination. + (find-file-noselect target t) + ;; Return exported file. + (cond + ;; Case 1: Conversion desired on exported file. Run the + ;; converter on the OpenDocument file. Return the + ;; converted file. + (org-odt-preferred-output-format + (or (org-odt-convert target org-odt-preferred-output-format) + target)) + ;; Case 2: No further conversion. Return exported + ;; OpenDocument file. + (t target)))) + (error + ;; Cleanup work directory and work files. + (funcall --cleanup-xml-buffers) + (message "OpenDocument export failed: %s" + (error-message-string err)))))) + + +;;;; Export to OpenDocument formula + +;;;###autoload +(defun org-odt-export-as-odf (latex-frag &optional odf-file) + "Export LATEX-FRAG as OpenDocument formula file ODF-FILE. +Use `org-create-math-formula' to convert LATEX-FRAG first to +MathML. When invoked as an interactive command, use +`org-latex-regexps' to infer LATEX-FRAG from currently active +region. If no LaTeX fragments are found, prompt for it. Push +MathML source to kill ring depending on the value of +`org-export-copy-to-kill-ring'." + (interactive + `(,(let (frag) + (setq frag (and (setq frag (and (region-active-p) + (buffer-substring (region-beginning) + (region-end)))) + (loop for e in org-latex-regexps + thereis (when (string-match (nth 1 e) frag) + (match-string (nth 2 e) frag))))) + (read-string "LaTeX Fragment: " frag nil frag)) + ,(let ((odf-filename (expand-file-name + (concat + (file-name-sans-extension + (or (file-name-nondirectory buffer-file-name))) + "." "odf") + (file-name-directory buffer-file-name)))) + (read-file-name "ODF filename: " nil odf-filename nil + (file-name-nondirectory odf-filename))))) + (let ((filename (or odf-file + (expand-file-name + (concat + (file-name-sans-extension + (or (file-name-nondirectory buffer-file-name))) + "." "odf") + (file-name-directory buffer-file-name))))) + (org-odt--export-wrap + filename + (let* ((buffer (progn + (require 'nxml-mode) + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect (concat org-odt-zip-dir + "content.xml") t)))) + (coding-system-for-write 'utf-8) + (save-buffer-coding-system 'utf-8)) + (set-buffer buffer) + (set-buffer-file-coding-system coding-system-for-write) + (let ((mathml (org-create-math-formula latex-frag))) + (unless mathml (error "No Math formula created")) + (insert mathml) + ;; Add MathML to kill ring, if needed. + (when (org-export--copy-to-kill-ring-p) + (org-kill-new (buffer-string)))))))) + +;;;###autoload +(defun org-odt-export-as-odf-and-open () + "Export LaTeX fragment as OpenDocument formula and immediately open it. +Use `org-odt-export-as-odf' to read LaTeX fragment and OpenDocument +formula file." + (interactive) + (org-open-file (call-interactively 'org-odt-export-as-odf) 'system)) + + +;;;; Export to OpenDocument Text + +;;;###autoload +(defun org-odt-export-to-odt (&optional async subtreep visible-only ext-plist) + "Export current buffer to a ODT file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".odt" subtreep))) + (if async + (org-export-async-start (lambda (f) (org-export-add-to-stack f 'odt)) + `(expand-file-name + (org-odt--export-wrap + ,outfile + (let* ((org-odt-embedded-images-count 0) + (org-odt-embedded-formulas-count 0) + (org-odt-automatic-styles nil) + (org-odt-object-counters nil) + ;; Let `htmlfontify' know that we are interested in + ;; collecting styles. + (hfy-user-sheet-assoc nil)) + ;; Initialize content.xml and kick-off the export + ;; process. + (let ((out-buf + (progn + (require 'nxml-mode) + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect + (concat org-odt-zip-dir "content.xml") t))))) + (org-export-to-buffer + 'odt out-buf ,subtreep ,visible-only nil ',ext-plist)))))) + (org-odt--export-wrap + outfile + (let* ((org-odt-embedded-images-count 0) + (org-odt-embedded-formulas-count 0) + (org-odt-automatic-styles nil) + (org-odt-object-counters nil) + ;; Let `htmlfontify' know that we are interested in collecting + ;; styles. + (hfy-user-sheet-assoc nil)) + ;; Initialize content.xml and kick-off the export process. + (let ((out-buf (progn + (require 'nxml-mode) + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect + (concat org-odt-zip-dir "content.xml") t))))) + (org-export-to-buffer + 'odt out-buf subtreep visible-only nil ext-plist))))))) + + +;;;; Convert between OpenDocument and other formats + +(defun org-odt-reachable-p (in-fmt out-fmt) + "Return non-nil if IN-FMT can be converted to OUT-FMT." + (catch 'done + (let ((reachable-formats (org-odt-do-reachable-formats in-fmt))) + (dolist (e reachable-formats) + (let ((out-fmt-spec (assoc out-fmt (cdr e)))) + (when out-fmt-spec + (throw 'done (cons (car e) out-fmt-spec)))))))) + +(defun org-odt-do-convert (in-file out-fmt &optional prefix-arg) + "Workhorse routine for `org-odt-convert'." + (require 'browse-url) + (let* ((in-file (expand-file-name (or in-file buffer-file-name))) + (dummy (or (file-readable-p in-file) + (error "Cannot read %s" in-file))) + (in-fmt (file-name-extension in-file)) + (out-fmt (or out-fmt (error "Output format unspecified"))) + (how (or (org-odt-reachable-p in-fmt out-fmt) + (error "Cannot convert from %s format to %s format?" + in-fmt out-fmt))) + (convert-process (car how)) + (out-file (concat (file-name-sans-extension in-file) "." + (nth 1 (or (cdr how) out-fmt)))) + (extra-options (or (nth 2 (cdr how)) "")) + (out-dir (file-name-directory in-file)) + (cmd (format-spec convert-process + `((?i . ,(shell-quote-argument in-file)) + (?I . ,(browse-url-file-url in-file)) + (?f . ,out-fmt) + (?o . ,out-file) + (?O . ,(browse-url-file-url out-file)) + (?d . , (shell-quote-argument out-dir)) + (?D . ,(browse-url-file-url out-dir)) + (?x . ,extra-options))))) + (when (file-exists-p out-file) + (delete-file out-file)) + + (message "Executing %s" cmd) + (let ((cmd-output (shell-command-to-string cmd))) + (message "%s" cmd-output)) + + (cond + ((file-exists-p out-file) + (message "Exported to %s" out-file) + (when prefix-arg + (message "Opening %s..." out-file) + (org-open-file out-file 'system)) + out-file) + (t + (message "Export to %s failed" out-file) + nil)))) + +(defun org-odt-do-reachable-formats (in-fmt) + "Return verbose info about formats to which IN-FMT can be converted. +Return a list where each element is of the +form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See +`org-odt-convert-processes' for CONVERTER-PROCESS and see +`org-odt-convert-capabilities' for OUTPUT-FMT-ALIST." + (let* ((converter + (and org-odt-convert-process + (cadr (assoc-string org-odt-convert-process + org-odt-convert-processes t)))) + (capabilities + (and org-odt-convert-process + (cadr (assoc-string org-odt-convert-process + org-odt-convert-processes t)) + org-odt-convert-capabilities)) + reachable-formats) + (when converter + (dolist (c capabilities) + (when (member in-fmt (nth 1 c)) + (push (cons converter (nth 2 c)) reachable-formats)))) + reachable-formats)) + +(defun org-odt-reachable-formats (in-fmt) + "Return list of formats to which IN-FMT can be converted. +The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)." + (let (l) + (mapc (lambda (e) (add-to-list 'l e)) + (apply 'append (mapcar + (lambda (e) (mapcar 'car (cdr e))) + (org-odt-do-reachable-formats in-fmt)))) + l)) + +(defun org-odt-convert-read-params () + "Return IN-FILE and OUT-FMT params for `org-odt-do-convert'. +This is a helper routine for interactive use." + (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read)) + (in-file (read-file-name "File to be converted: " + nil buffer-file-name t)) + (in-fmt (file-name-extension in-file)) + (out-fmt-choices (org-odt-reachable-formats in-fmt)) + (out-fmt + (or (and out-fmt-choices + (funcall input "Output format: " + out-fmt-choices nil nil nil)) + (error + "No known converter or no known output formats for %s files" + in-fmt)))) + (list in-file out-fmt))) + +;;;###autoload +(defun org-odt-convert (&optional in-file out-fmt prefix-arg) + "Convert IN-FILE to format OUT-FMT using a command line converter. +IN-FILE is the file to be converted. If unspecified, it defaults +to variable `buffer-file-name'. OUT-FMT is the desired output +format. Use `org-odt-convert-process' as the converter. +If PREFIX-ARG is non-nil then the newly converted file is opened +using `org-open-file'." + (interactive + (append (org-odt-convert-read-params) current-prefix-arg)) + (org-odt-do-convert in-file out-fmt prefix-arg)) + +;;; Library Initializations + +(mapc + (lambda (desc) + ;; Let Emacs open all OpenDocument files in archive mode + (add-to-list 'auto-mode-alist + (cons (concat "\\." (car desc) "\\'") 'archive-mode))) + org-odt-file-extensions) + +(provide 'ox-odt) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-odt.el ends here diff --git a/lisp/ox-org.el b/lisp/ox-org.el new file mode 100644 index 000000000..f55b5dc67 --- /dev/null +++ b/lisp/ox-org.el @@ -0,0 +1,270 @@ +;;; ox-org.el --- Org Back-End for Org Export Engine + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: org, wp + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This library implements an Org back-end for Org exporter. +;; +;; It introduces two interactive functions, `org-org-export-as-org' +;; and `org-org-export-to-org', which export, respectively, to +;; a temporary buffer and to a file. +;; +;; A publishing function is also provided: `org-org-publish-to-org'. + +;;; Code: +(require 'ox) +(declare-function htmlize-buffer "htmlize" (&optional buffer)) + +(defgroup org-export-org nil + "Options for exporting Org mode files to Org." + :tag "Org Export Org" + :group 'org-export + :version "24.4" + :package-version '(Org . "8.0")) + +(define-obsolete-variable-alias + 'org-export-htmlized-org-css-url 'org-org-htmlized-css-url "24.4") +(defcustom org-org-htmlized-css-url nil + "URL pointing to the CSS defining colors for htmlized Emacs buffers. +Normally when creating an htmlized version of an Org buffer, +htmlize will create the CSS to define the font colors. However, +this does not work when converting in batch mode, and it also can +look bad if different people with different fontification setup +work on the same website. When this variable is non-nil, +creating an htmlized version of an Org buffer using +`org-org-export-as-org' will include a link to this URL if the +setting of `org-html-htmlize-output-type' is 'css." + :group 'org-export-org + :type '(choice + (const :tag "Don't include external stylesheet link" nil) + (string :tag "URL or local href"))) + +(org-export-define-backend 'org + '((babel-call . org-org-identity) + (bold . org-org-identity) + (center-block . org-org-identity) + (clock . org-org-identity) + (code . org-org-identity) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (diary-sexp . org-org-identity) + (drawer . org-org-identity) + (dynamic-block . org-org-identity) + (entity . org-org-identity) + (example-block . org-org-identity) + (fixed-width . org-org-identity) + (footnote-definition . org-org-identity) + (footnote-reference . org-org-identity) + (headline . org-org-headline) + (horizontal-rule . org-org-identity) + (inline-babel-call . org-org-identity) + (inline-src-block . org-org-identity) + (inlinetask . org-org-identity) + (italic . org-org-identity) + (item . org-org-identity) + (keyword . org-org-keyword) + (latex-environment . org-org-identity) + (latex-fragment . org-org-identity) + (line-break . org-org-identity) + (link . org-org-identity) + (node-property . org-org-identity) + (paragraph . org-org-identity) + (plain-list . org-org-identity) + (planning . org-org-identity) + (property-drawer . org-org-identity) + (quote-block . org-org-identity) + (quote-section . org-org-identity) + (radio-target . org-org-identity) + (section . org-org-identity) + (special-block . org-org-identity) + (src-block . org-org-identity) + (statistics-cookie . org-org-identity) + (strike-through . org-org-identity) + (subscript . org-org-identity) + (superscript . org-org-identity) + (table . org-org-identity) + (table-cell . org-org-identity) + (table-row . org-org-identity) + (target . org-org-identity) + (timestamp . org-org-identity) + (underline . org-org-identity) + (verbatim . org-org-identity) + (verse-block . org-org-identity)) + :menu-entry + '(?O "Export to Org" + ((?O "As Org buffer" org-org-export-as-org) + (?o "As Org file" org-org-export-to-org) + (?v "As Org file and open" + (lambda (a s v b) + (if a (org-org-export-to-org t s v b) + (org-open-file (org-org-export-to-org nil s v b)))))))) + +(defun org-org-identity (blob contents info) + "Transcode BLOB element or object back into Org syntax. +CONTENTS is its contents, as a string or nil. INFO is ignored." + (org-export-expand blob contents)) + +(defun org-org-headline (headline contents info) + "Transcode HEADLINE element back into Org syntax. +CONTENTS is its contents, as a string or nil. INFO is ignored." + (unless (plist-get info :with-todo-keywords) + (org-element-put-property headline :todo-keyword nil)) + (unless (plist-get info :with-tags) + (org-element-put-property headline :tags nil)) + (unless (plist-get info :with-priority) + (org-element-put-property headline :priority nil)) + (org-element-headline-interpreter headline contents)) + +(defun org-org-keyword (keyword contents info) + "Transcode KEYWORD element back into Org syntax. +CONTENTS is nil. INFO is ignored. This function ignores +keywords targeted at other export back-ends." + (unless (member (org-element-property :key keyword) + (mapcar + (lambda (block-cons) + (and (eq (cdr block-cons) 'org-element-export-block-parser) + (car block-cons))) + org-element-block-name-alist)) + (org-element-keyword-interpreter keyword nil))) + +;;;###autoload +(defun org-org-export-as-org (&optional async subtreep visible-only ext-plist) + "Export current buffer to an Org buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org ORG Export*\", which will +be displayed when `org-export-show-temporary-export-buffer' is +non-nil." + (interactive) + (if async + (org-export-async-start + (lambda (output) + (with-current-buffer (get-buffer-create "*Org ORG Export*") + (erase-buffer) + (insert output) + (goto-char (point-min)) + (org-mode) + (org-export-add-to-stack (current-buffer) 'org))) + `(org-export-as 'org ,subtreep ,visible-only nil ',ext-plist)) + (let ((outbuf + (org-export-to-buffer + 'org "*Org ORG Export*" subtreep visible-only nil ext-plist))) + (with-current-buffer outbuf (org-mode)) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window outbuf))))) + +;;;###autoload +(defun org-org-export-to-org (&optional async subtreep visible-only ext-plist) + "Export current buffer to an org file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file name." + (interactive) + (let ((outfile (org-export-output-file-name ".org" subtreep))) + (if async + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'org)) + `(expand-file-name + (org-export-to-file + 'org ,outfile ,subtreep ,visible-only nil ',ext-plist))) + (org-export-to-file 'org outfile subtreep visible-only nil ext-plist)))) + +;;;###autoload +(defun org-org-publish-to-org (plist filename pub-dir) + "Publish an org file to org. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'org filename ".org" plist pub-dir) + (when (plist-get plist :htmlized-source) + (require 'htmlize) + (require 'ox-html) + (let* ((org-inhibit-startup t) + (htmlize-output-type 'css) + (html-ext (concat "." (or (plist-get plist :html-extension) + org-html-extension "html"))) + (visitingp (find-buffer-visiting filename)) + (work-buffer (or visitingp (find-file filename))) + newbuf) + (font-lock-fontify-buffer) + (setq newbuf (htmlize-buffer)) + (with-current-buffer newbuf + (when org-org-htmlized-css-url + (goto-char (point-min)) + (and (re-search-forward + ".*" nil t) + (replace-match + (format + "" + org-org-htmlized-css-url) t t))) + (write-file (concat pub-dir (file-name-nondirectory filename) html-ext))) + (kill-buffer newbuf) + (unless visitingp (kill-buffer work-buffer))) + (set-buffer-modified-p nil))) + + +(provide 'ox-org) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-org.el ends here diff --git a/contrib/lisp/org-e-publish.el b/lisp/ox-publish.el similarity index 56% rename from contrib/lisp/org-e-publish.el rename to lisp/ox-publish.el index b801e662f..194e16962 100644 --- a/contrib/lisp/org-e-publish.el +++ b/lisp/ox-publish.el @@ -1,11 +1,11 @@ -;;; org-e-publish.el --- publish related org-mode files as a website +;;; ox-publish.el --- Publish Related Org Mode Files as a Website ;; Copyright (C) 2006-2013 Free Software Foundation, Inc. ;; Author: David O'Toole ;; Maintainer: Carsten Dominik ;; Keywords: hypermedia, outlines, wp -;; This file is not part of GNU Emacs. +;; This file is part of GNU Emacs. ;; ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -25,9 +25,9 @@ ;; This program allow configurable publishing of related sets of ;; Org mode files as a complete website. ;; -;; org-e-publish.el can do the following: +;; ox-publish.el can do the following: ;; -;; + Publish all one's Org files to HTML or PDF +;; + Publish all one's Org files to a given export back-end ;; + Upload HTML, images, attachments and other files to a web server ;; + Exclude selected private pages from publishing ;; + Publish a clickable sitemap of pages @@ -40,30 +40,26 @@ (eval-when-compile (require 'cl)) (require 'format-spec) -(require 'org-export) - -(declare-function org-e-latex-compile "org-e-latex" (texfile)) +(require 'ox) ;;; Variables -(defvar org-e-publish-initial-buffer nil - "The buffer `org-e-publish' has been called from.") -(defvar org-e-publish-temp-files nil +(defvar org-publish-temp-files nil "Temporary list of files to be published.") ;; Here, so you find the variable right before it's used the first time: -(defvar org-e-publish-cache nil +(defvar org-publish-cache nil "This will cache timestamps and titles for files in publishing projects. Blocks could hash sha1 values here.") -(defgroup org-e-publish nil +(defgroup org-publish nil "Options for publishing a set of Org-mode and related files." :tag "Org Publishing" :group 'org) -(defcustom org-e-publish-project-alist nil +(defcustom org-publish-project-alist nil "Association list to control publishing behavior. Each element of the alist is a publishing 'project.' The CAR of each element is a string, uniquely identifying the project. The @@ -78,19 +74,18 @@ CDR of each element is in one of the following forms: 2. A meta-project definition, specifying of a list of sub-projects: - \(:components \(\"project-1\" \"project-2\" ...)) + \(:components (\"project-1\" \"project-2\" ...)) -When the CDR of an element of org-e-publish-project-alist is in +When the CDR of an element of org-publish-project-alist is in this second form, the elements of the list after `:components' are taken to be components of the project, which group together files requiring different publishing options. When you publish -such a project with \\[org-e-publish], the components all -publish. +such a project with \\[org-publish], the components all publish. -When a property is given a value in -`org-e-publish-project-alist', its setting overrides the value of -the corresponding user variable \(if any) during publishing. -However, options set within a file override everything. +When a property is given a value in `org-publish-project-alist', +its setting overrides the value of the corresponding user +variable (if any) during publishing. However, options set within +a file override everything. Most properties are optional, but some should always be set: @@ -100,13 +95,13 @@ Most properties are optional, but some should always be set: `:base-extension' - Extension \(without the dot!) of source files. This can be + Extension (without the dot!) of source files. This can be a regular expression. If not given, \"org\" will be used as default extension. `:publishing-directory' - Directory \(possibly remote) where output files will be + Directory (possibly remote) where output files will be published. The `:exclude' property may be used to prevent certain files from @@ -114,7 +109,7 @@ being published. Its value may be a string or regexp matching file names you don't want to be published. The `:include' property may be used to include extra files. Its -value may be a list of filenames to include. The filenames are +value may be a list of filenames to include. The filenames are considered relative to the base directory. When both `:include' and `:exclude' properties are given values, @@ -122,15 +117,15 @@ the exclusion step happens first. One special property controls which back-end function to use for publishing files in the project. This can be used to extend the -set of file types publishable by `org-e-publish', as well as the +set of file types publishable by `org-publish', as well as the set of output formats. `:publishing-function' - Function to publish file. The default is - `org-e-publish-org-to-ascii', but other values are possible. - May also be a list of functions, in which case each function - in the list is invoked in turn. + Function to publish file. Each back-end may define its + own (i.e. `org-latex-publish-to-pdf', + `org-html-publish-to-html'). May be a list of functions, in + which case each function in the list is invoked in turn. Another property allows you to insert code that prepares a project for publishing. For example, you could call GNU Make @@ -152,34 +147,40 @@ and are equivalent to the corresponding user variables listed in the right column. Back-end specific properties may also be included. See the back-end documentation for more information. - :author `user-full-name' - :creator `org-export-creator-string' - :email `user-mail-address' - :exclude-tags `org-export-exclude-tags' - :headline-levels `org-export-headline-levels' - :language `org-export-default-language' - :preserve-breaks `org-export-preserve-breaks' - :section-numbers `org-export-with-section-numbers' - :select-tags `org-export-select-tags' - :time-stamp-file `org-export-time-stamp-file' - :with-archived-trees `org-export-with-archived-trees' - :with-author `org-export-with-author' - :with-creator `org-export-with-creator' - :with-drawers `org-export-with-drawers' - :with-email `org-export-with-email' - :with-emphasize `org-export-with-emphasize' - :with-entities `org-export-with-entities' - :with-fixed-width `org-export-with-fixed-width' - :with-footnotes `org-export-with-footnotes' - :with-priority `org-export-with-priority' - :with-special-strings `org-export-with-special-strings' - :with-sub-superscript `org-export-with-sub-superscripts' - :with-toc `org-export-with-toc' - :with-tables `org-export-with-tables' - :with-tags `org-export-with-tags' - :with-tasks `org-export-with-tasks' - :with-timestamps `org-export-with-timestamps' - :with-todo-keywords `org-export-with-todo-keywords' + :author `user-full-name' + :creator `org-export-creator-string' + :email `user-mail-address' + :exclude-tags `org-export-exclude-tags' + :headline-levels `org-export-headline-levels' + :language `org-export-default-language' + :preserve-breaks `org-export-preserve-breaks' + :section-numbers `org-export-with-section-numbers' + :select-tags `org-export-select-tags' + :time-stamp-file `org-export-time-stamp-file' + :with-archived-trees `org-export-with-archived-trees' + :with-author `org-export-with-author' + :with-creator `org-export-with-creator' + :with-date `org-export-with-date' + :with-drawers `org-export-with-drawers' + :with-email `org-export-with-email' + :with-emphasize `org-export-with-emphasize' + :with-entities `org-export-with-entities' + :with-fixed-width `org-export-with-fixed-width' + :with-footnotes `org-export-with-footnotes' + :with-inlinetasks `org-export-with-inlinetasks' + :with-latex `org-export-with-latex' + :with-priority `org-export-with-priority' + :with-smart-quotes `org-export-with-smart-quotes' + :with-special-strings `org-export-with-special-strings' + :with-statistics-cookies' `org-export-with-statistics-cookies' + :with-sub-superscript `org-export-with-sub-superscripts' + :with-toc `org-export-with-toc' + :with-tables `org-export-with-tables' + :with-tags `org-export-with-tags' + :with-tasks `org-export-with-tasks' + :with-timestamps `org-export-with-timestamps' + :with-planning `org-export-with-planning' + :with-todo-keywords `org-export-with-todo-keywords' The following properties may be used to control publishing of a site-map of files or summary page for a given project. @@ -187,7 +188,7 @@ a site-map of files or summary page for a given project. `:auto-sitemap' Whether to publish a site-map during - `org-e-publish-current-project' or `org-e-publish-all'. + `org-publish-current-project' or `org-publish-all'. `:sitemap-filename' @@ -199,21 +200,21 @@ a site-map of files or summary page for a given project. `:sitemap-function' - Plugin function to use for generation of site-map. Defaults to - `org-e-publish-org-sitemap', which generates a plain list of + Plugin function to use for generation of site-map. Defaults + to `org-publish-org-sitemap', which generates a plain list of links to all files in the project. `:sitemap-style' - Can be `list' \(site-map is just an itemized list of the - titles of the files involved) or `tree' \(the directory + Can be `list' (site-map is just an itemized list of the + titles of the files involved) or `tree' (the directory structure of the source files is reflected in the site-map). Defaults to `tree'. `:sitemap-sans-extension' Remove extension from site-map's file-names. Useful to have - cool URIs \(see http://www.w3.org/Provider/Style/URI). + cool URIs (see http://www.w3.org/Provider/Style/URI). Defaults to nil. If you create a site-map file, adjust the sorting like this: @@ -221,9 +222,8 @@ If you create a site-map file, adjust the sorting like this: `:sitemap-sort-folders' Where folders should appear in the site-map. Set this to - `first' \(default) or `last' to display folders first or - last, respectively. Any other value will mix files and - folders. + `first' (default) or `last' to display folders first or last, + respectively. Any other value will mix files and folders. `:sitemap-sort-files' @@ -235,38 +235,42 @@ If you create a site-map file, adjust the sorting like this: Should sorting be case-sensitive? Default nil. -The following properties control the creation of a concept index. +The following property control the creation of a concept index. `:makeindex' - Create a concept index. + Create a concept index. The file containing the index has to + be called \"theindex.org\". If it doesn't exist in the + project, it will be generated. Contents of the index are + stored in the file \"theindex.inc\", which can be included in + \"theindex.org\". Other properties affecting publication. `:body-only' Set this to t to publish only the body of the documents." - :group 'org-e-publish + :group 'org-export-publish :type 'alist) -(defcustom org-e-publish-use-timestamps-flag t +(defcustom org-publish-use-timestamps-flag t "Non-nil means use timestamp checking to publish only changed files. When nil, do no timestamp checking and always publish all files." - :group 'org-e-publish + :group 'org-export-publish :type 'boolean) -(defcustom org-e-publish-timestamp-directory +(defcustom org-publish-timestamp-directory (convert-standard-filename "~/.org-timestamps/") "Name of directory in which to store publishing timestamps." - :group 'org-e-publish + :group 'org-export-publish :type 'directory) -(defcustom org-e-publish-list-skipped-files t +(defcustom org-publish-list-skipped-files t "Non-nil means show message about files *not* published." - :group 'org-e-publish + :group 'org-export-publish :type 'boolean) -(defcustom org-e-publish-sitemap-sort-files 'alphabetically +(defcustom org-publish-sitemap-sort-files 'alphabetically "Method to sort files in site-maps. Possible values are `alphabetically', `chronologically', `anti-chronologically' and nil. @@ -277,11 +281,11 @@ time first. If `anti-chronologically', files will be sorted with newer modification time first. nil won't sort files. You can overwrite this default per project in your -`org-e-publish-project-alist', using `:sitemap-sort-files'." - :group 'org-e-publish +`org-publish-project-alist', using `:sitemap-sort-files'." + :group 'org-export-publish :type 'symbol) -(defcustom org-e-publish-sitemap-sort-folders 'first +(defcustom org-publish-sitemap-sort-folders 'first "A symbol, denoting if folders are sorted first in sitemaps. Possible values are `first', `last', and nil. If `first', folders will be sorted before files. @@ -289,32 +293,32 @@ If `last', folders are sorted to the end after the files. Any other value will not mix files and folders. You can overwrite this default per project in your -`org-e-publish-project-alist', using `:sitemap-sort-folders'." - :group 'org-e-publish +`org-publish-project-alist', using `:sitemap-sort-folders'." + :group 'org-export-publish :type 'symbol) -(defcustom org-e-publish-sitemap-sort-ignore-case nil +(defcustom org-publish-sitemap-sort-ignore-case nil "Non-nil when site-map sorting should ignore case. You can overwrite this default per project in your -`org-e-publish-project-alist', using `:sitemap-ignore-case'." - :group 'org-e-publish +`org-publish-project-alist', using `:sitemap-ignore-case'." + :group 'org-export-publish :type 'boolean) -(defcustom org-e-publish-sitemap-date-format "%Y-%m-%d" - "Format for `format-time-string' which is used to print a date -in the sitemap." - :group 'org-e-publish +(defcustom org-publish-sitemap-date-format "%Y-%m-%d" + "Format for printing a date in the sitemap. +See `format-time-string' for allowed formatters." + :group 'org-export-publish :type 'string) -(defcustom org-e-publish-sitemap-file-entry-format "%t" +(defcustom org-publish-sitemap-file-entry-format "%t" "Format string for site-map file entry. You could use brackets to delimit on what part the link will be. %t is the title. %a is the author. -%d is the date formatted using `org-e-publish-sitemap-date-format'." - :group 'org-e-publish +%d is the date formatted using `org-publish-sitemap-date-format'." + :group 'org-export-publish :type 'string) @@ -322,13 +326,13 @@ You could use brackets to delimit on what part the link will be. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Timestamp-related functions -(defun org-e-publish-timestamp-filename (filename &optional pub-dir pub-func) +(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func) "Return path to timestamp file for filename FILENAME." (setq filename (concat filename "::" (or pub-dir "") "::" (format "%s" (or pub-func "")))) (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) -(defun org-e-publish-needed-p +(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir base-dir) "Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC. TRUE-PUB-DIR is where the file will truly end up. Currently we @@ -337,43 +341,43 @@ the file is present at the target location, and how old it is. Right now we cannot do this, because we do not know under what file name the file will be stored - the publishing function can still decide about that independently." - (let ((rtn (if (not org-e-publish-use-timestamps-flag) t - (org-e-publish-cache-file-needs-publishing + (let ((rtn (if (not org-publish-use-timestamps-flag) t + (org-publish-cache-file-needs-publishing filename pub-dir pub-func base-dir)))) (if rtn (message "Publishing file %s using `%s'" filename pub-func) - (when org-e-publish-list-skipped-files + (when org-publish-list-skipped-files (message "Skipping unmodified file %s" filename))) rtn)) -(defun org-e-publish-update-timestamp +(defun org-publish-update-timestamp (filename &optional pub-dir pub-func base-dir) "Update publishing timestamp for file FILENAME. If there is no timestamp, create one." - (let ((key (org-e-publish-timestamp-filename filename pub-dir pub-func)) - (stamp (org-e-publish-cache-ctime-of-src filename base-dir))) - (org-e-publish-cache-set key stamp))) + (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) + (stamp (org-publish-cache-ctime-of-src filename))) + (org-publish-cache-set key stamp))) -(defun org-e-publish-remove-all-timestamps () +(defun org-publish-remove-all-timestamps () "Remove all files in the timestamp directory." - (let ((dir org-e-publish-timestamp-directory) + (let ((dir org-publish-timestamp-directory) files) (when (and (file-exists-p dir) (file-directory-p dir)) (mapc 'delete-file (directory-files dir 'full "[^.]\\'")) - (org-e-publish-reset-cache)))) + (org-publish-reset-cache)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Getting project information out of `org-e-publish-project-alist' +;;; Getting project information out of `org-publish-project-alist' -(defun org-e-publish-expand-projects (projects-alist) +(defun org-publish-expand-projects (projects-alist) "Expand projects in PROJECTS-ALIST. This splices all the components into the list." (let ((rest projects-alist) rtn p components) (while (setq p (pop rest)) (if (setq components (plist-get (cdr p) :components)) (setq rest (append - (mapcar (lambda (x) (assoc x org-e-publish-project-alist)) + (mapcar (lambda (x) (assoc x org-publish-project-alist)) components) rest)) (push p rtn))) @@ -385,7 +389,7 @@ This splices all the components into the list." (defvar org-sitemap-requested) (defvar org-sitemap-date-format) (defvar org-sitemap-file-entry-format) -(defun org-e-publish-compare-directory-files (a b) +(defun org-publish-compare-directory-files (a b) "Predicate for `sort', that sorts folders and files for sitemap." (let ((retval t)) (when (or org-sitemap-sort-files org-sitemap-sort-folders) @@ -398,15 +402,15 @@ This splices all the components into the list." (bdir (file-directory-p b)) (borg (and (string-match "\\.org$" b) (not bdir))) (A (if aorg (concat (file-name-directory a) - (org-e-publish-find-title a)) a)) + (org-publish-find-title a)) a)) (B (if borg (concat (file-name-directory b) - (org-e-publish-find-title b)) b))) + (org-publish-find-title b)) b))) (setq retval (if org-sitemap-ignore-case (not (string-lessp (upcase B) (upcase A))) (not (string-lessp B A)))))) ((anti-chronologically chronologically) - (let* ((adate (org-e-publish-find-date a)) - (bdate (org-e-publish-find-date b)) + (let* ((adate (org-publish-find-date a)) + (bdate (org-publish-find-date b)) (A (+ (lsh (car adate) 16) (cadr adate))) (B (+ (lsh (car bdate) 16) (cadr bdate)))) (setq retval @@ -423,9 +427,9 @@ This splices all the components into the list." (setq retval (equal org-sitemap-sort-folders 'last)))))) retval)) -(defun org-e-publish-get-base-files-1 +(defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir) - "Set `org-e-publish-temp-files' with files from BASE-DIR directory. + "Set `org-publish-temp-files' with files from BASE-DIR directory. If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is non-nil, restrict this list to the files matching the regexp MATCH. If SKIP-FILE is non-nil, skip file matching the regexp @@ -437,20 +441,20 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR." (if (and fd-p recurse (not (string-match "^\\.+$" fnd)) (if skip-dir (not (string-match skip-dir fnd)) t)) - (org-e-publish-get-base-files-1 + (org-publish-get-base-files-1 f recurse match skip-file skip-dir) (unless (or fd-p ;; this is a directory (and skip-file (string-match skip-file fnd)) (not (file-exists-p (file-truename f))) (not (string-match match fnd))) - (pushnew f org-e-publish-temp-files))))) + (pushnew f org-publish-temp-files))))) (if org-sitemap-requested (sort (directory-files base-dir t (unless recurse match)) - 'org-e-publish-compare-directory-files) + 'org-publish-compare-directory-files) (directory-files base-dir t (unless recurse match))))) -(defun org-e-publish-get-base-files (project &optional exclude-regexp) +(defun org-publish-get-base-files (project &optional exclude-regexp) "Return a list of all files in PROJECT. If EXCLUDE-REGEXP is set, this will be used to filter out matching filenames." @@ -461,7 +465,7 @@ matching filenames." (recurse (plist-get project-plist :recursive)) (extension (or (plist-get project-plist :base-extension) "org")) ;; sitemap-... variables are dynamically scoped for - ;; org-e-publish-compare-directory-files: + ;; org-publish-compare-directory-files: (org-sitemap-requested (plist-get project-plist :auto-sitemap)) (sitemap-filename @@ -469,7 +473,7 @@ matching filenames." (org-sitemap-sort-folders (if (plist-member project-plist :sitemap-sort-folders) (plist-get project-plist :sitemap-sort-folders) - org-e-publish-sitemap-sort-folders)) + org-publish-sitemap-sort-folders)) (org-sitemap-sort-files (cond ((plist-member project-plist :sitemap-sort-files) (plist-get project-plist :sitemap-sort-files)) @@ -477,39 +481,39 @@ matching filenames." ((plist-member project-plist :sitemap-alphabetically) (if (plist-get project-plist :sitemap-alphabetically) 'alphabetically nil)) - (t org-e-publish-sitemap-sort-files))) + (t org-publish-sitemap-sort-files))) (org-sitemap-ignore-case (if (plist-member project-plist :sitemap-ignore-case) (plist-get project-plist :sitemap-ignore-case) - org-e-publish-sitemap-sort-ignore-case)) + org-publish-sitemap-sort-ignore-case)) (match (if (eq extension 'any) "^[^\\.]" (concat "^[^\\.].*\\.\\(" extension "\\)$")))) ;; Make sure `org-sitemap-sort-folders' has an accepted value (unless (memq org-sitemap-sort-folders '(first last)) (setq org-sitemap-sort-folders nil)) - (setq org-e-publish-temp-files nil) + (setq org-publish-temp-files nil) (if org-sitemap-requested (pushnew (expand-file-name (concat base-dir sitemap-filename)) - org-e-publish-temp-files)) - (org-e-publish-get-base-files-1 base-dir recurse match + org-publish-temp-files)) + (org-publish-get-base-files-1 base-dir recurse match ;; FIXME distinguish exclude regexp ;; for skip-file and skip-dir? exclude-regexp exclude-regexp) (mapc (lambda (f) (pushnew (expand-file-name (concat base-dir f)) - org-e-publish-temp-files)) + org-publish-temp-files)) include-list) - org-e-publish-temp-files)) + org-publish-temp-files)) -(defun org-e-publish-get-project-from-filename (filename &optional up) +(defun org-publish-get-project-from-filename (filename &optional up) "Return the project that FILENAME belongs to." (let* ((filename (expand-file-name filename)) project-name) (catch 'p-found - (dolist (prj org-e-publish-project-alist) + (dolist (prj org-publish-project-alist) (unless (plist-get (cdr prj) :components) ;; [[info:org:Selecting%20files]] shows how this is supposed to work: (let* ((r (plist-get (cdr prj) :recursive)) @@ -530,29 +534,33 @@ matching filenames." (setq project-name (car prj)) (throw 'p-found project-name)))))) (when up - (dolist (prj org-e-publish-project-alist) + (dolist (prj org-publish-project-alist) (if (member project-name (plist-get (cdr prj) :components)) (setq project-name (car prj))))) - (assoc project-name org-e-publish-project-alist))) + (assoc project-name org-publish-project-alist))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Pluggable publishing back-end functions +;;; Tools for publishing functions in back-ends -(defun org-e-publish-org-to (backend filename extension plist pub-dir) +(defun org-publish-org-to (backend filename extension plist &optional pub-dir) "Publish an Org file to a specified back-end. BACKEND is a symbol representing the back-end used for transcoding. FILENAME is the filename of the Org file to be published. EXTENSION is the extension used for the output string, with the leading dot. PLIST is the property list for the -given project. PUB-DIR is the publishing directory. +given project. + +Optional argument PUB-DIR, when non-nil is the publishing +directory. Return output file name." - (unless (file-exists-p pub-dir) (make-directory pub-dir t)) + (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t)) ;; Check if a buffer visiting FILENAME is already open. - (let* ((visitingp (find-buffer-visiting filename)) + (let* ((org-inhibit-startup t) + (visitingp (find-buffer-visiting filename)) (work-buffer (or visitingp (find-file-noselect filename)))) (prog1 (with-current-buffer work-buffer (let ((output-file @@ -560,93 +568,23 @@ Return output file name." (body-p (plist-get plist :body-only))) (org-export-to-file backend output-file nil nil body-p - ;; Install `org-e-publish-collect-index' in parse tree - ;; filters. It isn't dependent on `:makeindex', since - ;; we want to keep it up-to-date in cache anyway. + ;; Add `org-publish-collect-numbering' and + ;; `org-publish-collect-index' to final output + ;; filters. The latter isn't dependent on + ;; `:makeindex', since we want to keep it up-to-date + ;; in cache anyway. (org-combine-plists - plist `(:filter-parse-tree - (org-e-publish-collect-index - ,@(plist-get plist :filter-parse-tree))))))) + plist + `(:filter-final-output + ,(cons 'org-publish-collect-numbering + (cons 'org-publish-collect-index + (plist-get plist :filter-final-output)))))))) ;; Remove opened buffer in the process. (unless visitingp (kill-buffer work-buffer))))) (defvar project-plist) -(defun org-e-publish-org-to-latex (plist filename pub-dir) - "Publish an Org file to LaTeX. -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-e-publish-org-to 'e-latex filename ".tex" plist pub-dir)) - -(defun org-e-publish-org-to-pdf (plist filename pub-dir) - "Publish an Org file to PDF \(via LaTeX). - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-e-latex-compile - (org-e-publish-org-to 'e-latex filename ".tex" plist pub-dir))) - -(defun org-e-publish-org-to-html (plist filename pub-dir) - "Publish an org file to HTML. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-e-publish-org-to 'e-html filename ".html" plist pub-dir)) - -;; TODO: Not implemented yet. -;; (defun org-e-publish-org-to-org (plist filename pub-dir) -;; "Publish an org file to HTML. -;; -;; FILENAME is the filename of the Org file to be published. PLIST -;; is the property list for the given project. PUB-DIR is the -;; publishing directory. -;; -;; Return output file name." -;; (org-e-publish-org-to "org" plist filename pub-dir)) - -(defun org-e-publish-org-to-ascii (plist filename pub-dir) - "Publish an Org file to ASCII. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-e-publish-org-to - 'e-ascii filename ".txt" `(:ascii-charset ascii ,@plist) pub-dir)) - -(defun org-e-publish-org-to-latin1 (plist filename pub-dir) - "Publish an Org file to Latin-1. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-e-publish-org-to - 'e-ascii filename ".txt" `(:ascii-charset latin1 ,@plist) pub-dir)) - -(defun org-e-publish-org-to-utf8 (plist filename pub-dir) - "Publish an org file to UTF-8. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-e-publish-org-to - 'e-ascii filename ".txt" `(:ascii-charset utf-8 ,@plist) pub-dir)) - -(defun org-e-publish-attachment (plist filename pub-dir) +(defun org-publish-attachment (plist filename pub-dir) "Publish a file with no transformation of any kind. FILENAME is the filename of the Org file to be published. PLIST @@ -667,22 +605,22 @@ Return output file name." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Publishing files, sets of files, and indices -(defun org-e-publish-file (filename &optional project no-cache) +(defun org-publish-file (filename &optional project no-cache) "Publish file FILENAME from PROJECT. -If NO-CACHE is not nil, do not initialize org-e-publish-cache and +If NO-CACHE is not nil, do not initialize org-publish-cache and write it to disk. This is needed, since this function is used to publish single files, when entire projects are published. -See `org-e-publish-projects'." +See `org-publish-projects'." (let* ((project (or project - (or (org-e-publish-get-project-from-filename filename) + (or (org-publish-get-project-from-filename filename) (error "File %s not part of any known project" (abbreviate-file-name filename))))) (project-plist (cdr project)) (ftname (expand-file-name filename)) (publishing-function (or (plist-get project-plist :publishing-function) - 'org-e-publish-org-to-ascii)) + (error "No publishing function chosen"))) (base-dir (file-name-as-directory (expand-file-name @@ -697,7 +635,7 @@ See `org-e-publish-projects'." (car project)))))) tmp-pub-dir) - (unless no-cache (org-e-publish-initialize-cache (car project))) + (unless no-cache (org-publish-initialize-cache (car project))) (setq tmp-pub-dir (file-name-directory @@ -707,58 +645,65 @@ See `org-e-publish-projects'." (if (listp publishing-function) ;; allow chain of publishing functions (mapc (lambda (f) - (when (org-e-publish-needed-p + (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir) (funcall f project-plist filename tmp-pub-dir) - (org-e-publish-update-timestamp filename pub-dir f base-dir))) + (org-publish-update-timestamp filename pub-dir f base-dir))) publishing-function) - (when (org-e-publish-needed-p + (when (org-publish-needed-p filename pub-dir publishing-function tmp-pub-dir base-dir) (funcall publishing-function project-plist filename tmp-pub-dir) - (org-e-publish-update-timestamp + (org-publish-update-timestamp filename pub-dir publishing-function base-dir))) - (unless no-cache (org-e-publish-write-cache-file)))) + (unless no-cache (org-publish-write-cache-file)))) -(defun org-e-publish-projects (projects) +(defun org-publish-projects (projects) "Publish all files belonging to the PROJECTS alist. If `:auto-sitemap' is set, publish the sitemap too. If `:makeindex' is set, also produce a file theindex.org." (mapc (lambda (project) ;; Each project uses its own cache file: - (org-e-publish-initialize-cache (car project)) + (org-publish-initialize-cache (car project)) (let* ((project-plist (cdr project)) (exclude-regexp (plist-get project-plist :exclude)) (sitemap-p (plist-get project-plist :auto-sitemap)) (sitemap-filename (or (plist-get project-plist :sitemap-filename) "sitemap.org")) (sitemap-function (or (plist-get project-plist :sitemap-function) - 'org-e-publish-org-sitemap)) + 'org-publish-org-sitemap)) (org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format) - org-e-publish-sitemap-date-format)) + org-publish-sitemap-date-format)) (org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format) - org-e-publish-sitemap-file-entry-format)) + org-publish-sitemap-file-entry-format)) (preparation-function (plist-get project-plist :preparation-function)) (completion-function (plist-get project-plist :completion-function)) - (files (org-e-publish-get-base-files project exclude-regexp)) file) + (files (org-publish-get-base-files project exclude-regexp)) + (theindex + (expand-file-name "theindex.org" + (plist-get project-plist :base-directory)))) (when preparation-function (run-hooks 'preparation-function)) (if sitemap-p (funcall sitemap-function project sitemap-filename)) - (dolist (file files) (org-e-publish-file file project t)) + ;; Publish all files from PROJECT excepted "theindex.org". Its + ;; publishing will be deferred until "theindex.inc" is + ;; populated. + (dolist (file files) + (unless (equal file theindex) + (org-publish-file file project t))) + ;; Populate "theindex.inc", if needed, and publish + ;; "theindex.org". (when (plist-get project-plist :makeindex) - (org-e-publish-index-generate-theindex + (org-publish-index-generate-theindex project (plist-get project-plist :base-directory)) - (org-e-publish-file - (expand-file-name - "theindex.org" (plist-get project-plist :base-directory)) - project t)) + (org-publish-file theindex project t)) (when completion-function (run-hooks 'completion-function)) - (org-e-publish-write-cache-file))) - (org-e-publish-expand-projects projects))) + (org-publish-write-cache-file))) + (org-publish-expand-projects projects))) -(defun org-e-publish-org-sitemap (project &optional sitemap-filename) +(defun org-publish-org-sitemap (project &optional sitemap-filename) "Create a sitemap of pages in set defined by PROJECT. Optionally set the filename of the sitemap with SITEMAP-FILENAME. Default for SITEMAP-FILENAME is 'sitemap.org'." @@ -769,7 +714,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (indent-str (make-string 2 ?\ )) (exclude-regexp (plist-get project-plist :exclude)) (files (nreverse - (org-e-publish-get-base-files project exclude-regexp))) + (org-publish-get-base-files project exclude-regexp))) (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) (sitemap-title (or (plist-get project-plist :sitemap-title) (concat "Sitemap for project " (car project)))) @@ -780,8 +725,10 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (visiting (find-buffer-visiting sitemap-filename)) (ifn (file-name-nondirectory sitemap-filename)) file sitemap-buffer) - (with-current-buffer (setq sitemap-buffer - (or visiting (find-file sitemap-filename))) + (with-current-buffer + (let ((org-inhibit-startup t)) + (setq sitemap-buffer + (or visiting (find-file sitemap-filename)))) (erase-buffer) (insert (concat "#+TITLE: " sitemap-title "\n\n")) (while (setq file (pop files)) @@ -821,7 +768,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (+ (length indent-str) 2) ?\ ))))))) ;; This is common to 'flat and 'tree (let ((entry - (org-e-publish-format-file-entry + (org-publish-format-file-entry org-sitemap-file-entry-format file project-plist)) (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) (cond ((string-match-p regexp entry) @@ -837,46 +784,54 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (save-buffer)) (or visiting (kill-buffer sitemap-buffer)))) -(defun org-e-publish-format-file-entry (fmt file project-plist) +(defun org-publish-format-file-entry (fmt file project-plist) (format-spec fmt - `((?t . ,(org-e-publish-find-title file t)) + `((?t . ,(org-publish-find-title file t)) (?d . ,(format-time-string org-sitemap-date-format - (org-e-publish-find-date file))) + (org-publish-find-date file))) (?a . ,(or (plist-get project-plist :author) user-full-name))))) -(defun org-e-publish-find-title (file &optional reset) +(defun org-publish-find-title (file &optional reset) "Find the title of FILE in project." (or - (and (not reset) (org-e-publish-cache-get-file-property file :title nil t)) - (let* ((visiting (find-buffer-visiting file)) + (and (not reset) (org-publish-cache-get-file-property file :title nil t)) + (let* ((org-inhibit-startup t) + (visiting (find-buffer-visiting file)) (buffer (or visiting (find-file-noselect file))) title) (with-current-buffer buffer (org-mode) (setq title - (or (plist-get (org-export-get-environment) :title) + (or (org-element-interpret-data + (plist-get (org-export-get-environment) :title)) (file-name-nondirectory (file-name-sans-extension file))))) (unless visiting (kill-buffer buffer)) - (org-e-publish-cache-set-file-property file :title title) + (org-publish-cache-set-file-property file :title title) title))) -(defun org-e-publish-find-date (file) +(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. - -It returns time in `current-time' format." - (let* ((visiting (find-buffer-visiting file)) +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-inbuffer-options)) + (org-export-get-environment)) :date))) (unless visiting (kill-buffer file-buf)) - (if date (org-time-string-to-time date) - (when (file-exists-p file) - (nth 5 (file-attributes file)))))) + ;; 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 (org-string-nw-p (org-element-interpret-data ts))))) + ((file-exists-p file) (nth 5 (file-attributes file))) + (t (error "No such file: \"%s\"" file))))) @@ -884,64 +839,88 @@ It returns time in `current-time' format." ;;; Interactive publishing functions ;;;###autoload -(defalias 'org-e-publish-project 'org-e-publish) +(defalias 'org-publish-project 'org-publish) ;;;###autoload -(defun org-e-publish (project &optional force) - "Publish PROJECT." +(defun org-publish (project &optional force async) + "Publish PROJECT. + +PROJECT is either a project name, as a string, or a project +alist (see `org-publish-project-alist' variable). + +When optional argument FORCE is non-nil, force publishing all +files in PROJECT. With a non-nil optional argument ASYNC, +publishing will be done asynchronously, in another process." (interactive (list (assoc (org-icompleting-read "Publish project: " - org-e-publish-project-alist nil t) - org-e-publish-project-alist) + org-publish-project-alist nil t) + org-publish-project-alist) current-prefix-arg)) - (setq org-e-publish-initial-buffer (current-buffer)) - (save-window-excursion - (let* ((org-e-publish-use-timestamps-flag - (if force nil org-e-publish-use-timestamps-flag))) - (org-e-publish-projects - (if (stringp project) - ;; If this function is called in batch mode, project is - ;; still a string here. - (list (assoc project org-e-publish-project-alist)) - (list project)))))) + (let ((project-alist (if (not (stringp project)) (list project) + ;; If this function is called in batch mode, + ;; project is still a string here. + (list (assoc project org-publish-project-alist))))) + (if async + (org-export-async-start 'ignore + `(let ((org-publish-use-timestamps-flag + (if ',force nil ,org-publish-use-timestamps-flag))) + (org-publish-projects ',project-alist))) + (save-window-excursion + (let* ((org-publish-use-timestamps-flag + (if force nil org-publish-use-timestamps-flag))) + (org-publish-projects project-alist)))))) ;;;###autoload -(defun org-e-publish-all (&optional force) +(defun org-publish-all (&optional force async) "Publish all projects. -With prefix argument, remove all files in the timestamp -directory and force publishing all files." +With prefix argument FORCE, remove all files in the timestamp +directory and force publishing all projects. With a non-nil +optional argument ASYNC, publishing will be done asynchronously, +in another process." (interactive "P") - (when force (org-e-publish-remove-all-timestamps)) - (save-window-excursion - (let ((org-e-publish-use-timestamps-flag - (if force nil org-e-publish-use-timestamps-flag))) - (org-e-publish-projects org-e-publish-project-alist)))) + (if async + (org-export-async-start 'ignore + `(when ',force (org-publish-remove-all-timestamps)) + `(let ((org-publish-use-timestamps-flag + (if ',force nil ,org-publish-use-timestamps-flag))) + (org-publish-projects ',org-publish-project-alist))) + (when force (org-publish-remove-all-timestamps)) + (save-window-excursion + (let ((org-publish-use-timestamps-flag + (if force nil org-publish-use-timestamps-flag))) + (org-publish-projects org-publish-project-alist))))) ;;;###autoload -(defun org-e-publish-current-file (&optional force) +(defun org-publish-current-file (&optional force async) "Publish the current file. -With prefix argument, force publish the file." +With prefix argument FORCE, force publish the file. When +optional argument ASYNC is non-nil, publishing will be done +asynchronously, in another process." (interactive "P") - (save-window-excursion - (let ((org-e-publish-use-timestamps-flag - (if force nil org-e-publish-use-timestamps-flag))) - (org-e-publish-file (buffer-file-name (buffer-base-buffer)))))) + (let ((file (buffer-file-name (buffer-base-buffer)))) + (if async + (org-export-async-start 'ignore + `(let ((org-publish-use-timestamps-flag + (if ',force nil ,org-publish-use-timestamps-flag))) + (org-publish-file ,file))) + (save-window-excursion + (let ((org-publish-use-timestamps-flag + (if force nil org-publish-use-timestamps-flag))) + (org-publish-file file)))))) ;;;###autoload -(defun org-e-publish-current-project (&optional force) +(defun org-publish-current-project (&optional force async) "Publish the project associated with the current file. With a prefix argument, force publishing of all files in the project." (interactive "P") (save-window-excursion - (let ((project (org-e-publish-get-project-from-filename - (buffer-file-name (buffer-base-buffer)) 'up)) - (org-e-publish-use-timestamps-flag - (if force nil org-e-publish-use-timestamps-flag))) - (if project (org-e-publish project) + (let ((project (org-publish-get-project-from-filename + (buffer-file-name (buffer-base-buffer)) 'up))) + (if project (org-publish project force async) (error "File %s is not part of any known project" (buffer-file-name (buffer-base-buffer))))))) @@ -949,54 +928,64 @@ the project." ;;; Index generation -(defun org-e-publish-collect-index (tree backend info) - "Update index for a file with TREE in cache. +(defun org-publish-collect-index (output backend info) + "Update index for a file in cache. -BACKEND is the back-end being used for transcoding. INFO is -a plist containing publishing options. +OUTPUT is the output from transcoding current file. BACKEND is +the back-end that was used for transcoding. INFO is a plist +containing publishing and export options. The index relative to current file is stored as an alist. An -association has the following shape: \(TERM FILE-NAME PARENT), +association has the following shape: (TERM FILE-NAME PARENT), where TERM is the indexed term, as a string, FILE-NAME is the original full path of the file where the term in encountered, and -PARENT is the headline element containing the original index -keyword." - (org-e-publish-cache-set-file-property - (plist-get info :input-file) :index - (delete-dups - (org-element-map - tree 'keyword - (lambda (k) - (when (string= (downcase (org-element-property :key k)) - "index") - (let ((index (org-element-property :value k)) - (parent (org-export-get-parent-headline k))) - (list index (plist-get info :input-file) parent)))) - info))) - ;; Return parse-tree to avoid altering output. - tree) +PARENT is a reference to the headline, if any, containing the +original index keyword. When non-nil, this reference is a cons +cell. Its CAR is a symbol among `id', `custom-id' and `name' and +its CDR is a string." + (let ((file (plist-get info :input-file))) + (org-publish-cache-set-file-property + file :index + (delete-dups + (org-element-map (plist-get info :parse-tree) 'keyword + (lambda (k) + (when (equal (org-element-property :key k) "INDEX") + (let ((parent (org-export-get-parent-headline k))) + (list (org-element-property :value k) + file + (cond + ((not parent) nil) + ((let ((id (org-element-property :ID parent))) + (and id (cons 'id id)))) + ((let ((id (org-element-property :CUSTOM_ID parent))) + (and id (cons 'custom-id id)))) + (t (cons 'name + ;; Remove statistics cookie. + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (org-element-property :raw-value parent))))))))) + info)))) + ;; Return output unchanged. + output) -(defun org-e-publish-index-generate-theindex (project directory) +(defun org-publish-index-generate-theindex (project directory) "Retrieve full index from cache and build \"theindex.org\". PROJECT is the project the index relates to. DIRECTORY is the publishing directory." - (let ((all-files (org-e-publish-get-base-files + (let ((all-files (org-publish-get-base-files project (plist-get (cdr project) :exclude))) full-index) - ;; Compile full index. - (mapc - (lambda (file) - (let ((index (org-e-publish-cache-get-file-property file :index))) - (dolist (term index) - (unless (member term full-index) (push term full-index))))) - all-files) - ;; Sort it alphabetically. - (setq full-index - (sort full-index (lambda (a b) (string< (downcase (car a)) - (downcase (car b)))))) - ;; Fill "theindex.org". - (with-temp-buffer - (insert "#+TITLE: Index\n#+OPTIONS: num:nil author:nil\n") + ;; Compile full index and sort it alphabetically. + (dolist (file all-files + (setq full-index + (sort (nreverse full-index) + (lambda (a b) (string< (downcase (car a)) + (downcase (car b))))))) + (let ((index (org-publish-cache-get-file-property file :index))) + (dolist (term index) + (unless (member term full-index) (push term full-index))))) + ;; Write "theindex.inc" in DIRECTORY. + (with-temp-file (expand-file-name "theindex.inc" directory) (let ((current-letter nil) (last-entry nil)) (dolist (idx full-index) (let* ((entry (org-split-string (car idx) "!")) @@ -1012,9 +1001,10 @@ publishing directory." ;; Compute the first difference between last entry and ;; current one: it tells the level at which new items ;; should be added. - (let* ((rank (loop for n from 0 to (length entry) - unless (equal (nth n entry) (nth n last-entry)) - return n)) + (let* ((rank (if (equal entry last-entry) (1- (length entry)) + (loop for n from 0 to (length entry) + unless (equal (nth n entry) (nth n last-entry)) + return n))) (len (length (nthcdr rank entry)))) ;; For each term after the first difference, create ;; a new sub-list with the term as body. Moreover, @@ -1029,95 +1019,130 @@ publishing directory." (format "[[%s][%s]]" ;; Destination. - (cond - ((not target) (format "file:%s" file)) - ((let ((id (org-element-property :id target))) - (and id (format "id:%s" id)))) - ((let ((id (org-element-property :custom-id target))) - (and id (format "file:%s::#%s" file id)))) - (t (format "file:%s::*%s" file - (org-element-property :raw-value target)))) + (case (car target) + ('nil (format "file:%s" file)) + (id (format "id:%s" (cdr target))) + (custom-id (format "file:%s::#%s" file (cdr target))) + (otherwise (format "file:%s::*%s" file (cdr target)))) ;; Description. (car (last entry))))) "\n")))) (setq current-letter letter last-entry entry)))) - ;; Write index. - (write-file (expand-file-name "theindex.org" directory))))) + ;; Create "theindex.org", if it doesn't exist yet, and provide + ;; a default index file. + (let ((index.org (expand-file-name "theindex.org" directory))) + (unless (file-exists-p index.org) + (with-temp-file index.org + (insert "#+TITLE: Index\n\n#+INCLUDE: \"theindex.inc\"\n\n"))))))) + + + +;;; External Fuzzy Links Resolution +;; +;; This part implements tools to resolve [[file.org::*Some headline]] +;; links, where "file.org" belongs to the current project. + +(defun org-publish-collect-numbering (output backend info) + (org-publish-cache-set-file-property + (plist-get info :input-file) :numbering + (mapcar (lambda (entry) + (cons (org-split-string + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (org-element-property :raw-value (car entry)))) + (cdr entry))) + (plist-get info :headline-numbering))) + ;; Return output unchanged. + output) + +(defun org-publish-resolve-external-fuzzy-link (file fuzzy) + "Return numbering for headline matching FUZZY search in FILE. + +Return value is a list of numbers, or nil. This function allows +to resolve external fuzzy links like: + + [[file.org::*fuzzy][description]" + (when org-publish-cache + (cdr (assoc (org-split-string + (if (eq (aref fuzzy 0) ?*) (substring fuzzy 1) fuzzy)) + (org-publish-cache-get-file-property + (expand-file-name file) :numbering nil t))))) ;;; Caching functions -(defun org-e-publish-write-cache-file (&optional free-cache) - "Write `org-e-publish-cache' to file. +(defun org-publish-write-cache-file (&optional free-cache) + "Write `org-publish-cache' to file. If FREE-CACHE, empty the cache." - (unless org-e-publish-cache - (error "`org-e-publish-write-cache-file' called, but no cache present")) + (unless org-publish-cache + (error "`org-publish-write-cache-file' called, but no cache present")) - (let ((cache-file (org-e-publish-cache-get ":cache-file:"))) + (let ((cache-file (org-publish-cache-get ":cache-file:"))) (unless cache-file - (error "Cannot find cache-file name in `org-e-publish-write-cache-file'")) + (error "Cannot find cache-file name in `org-publish-write-cache-file'")) (with-temp-file cache-file (let (print-level print-length) - (insert "(setq org-e-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n") + (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n") (maphash (lambda (k v) (insert (format (concat "(puthash %S " (if (or (listp v) (symbolp v)) "'" "") - "%S org-e-publish-cache)\n") k v))) - org-e-publish-cache))) - (when free-cache (org-e-publish-reset-cache)))) + "%S org-publish-cache)\n") k v))) + org-publish-cache))) + (when free-cache (org-publish-reset-cache)))) -(defun org-e-publish-initialize-cache (project-name) +(defun org-publish-initialize-cache (project-name) "Initialize the projects cache if not initialized yet and return it." (unless project-name - (error "Cannot initialize `org-e-publish-cache' without projects name in `org-e-publish-initialize-cache'")) + (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'")) - (unless (file-exists-p org-e-publish-timestamp-directory) - (make-directory org-e-publish-timestamp-directory t)) - (unless (file-directory-p org-e-publish-timestamp-directory) + (unless (file-exists-p org-publish-timestamp-directory) + (make-directory org-publish-timestamp-directory t)) + (unless (file-directory-p org-publish-timestamp-directory) (error "Org publish timestamp: %s is not a directory" - org-e-publish-timestamp-directory)) + org-publish-timestamp-directory)) - (unless (and org-e-publish-cache - (string= (org-e-publish-cache-get ":project:") project-name)) + (unless (and org-publish-cache + (string= (org-publish-cache-get ":project:") project-name)) (let* ((cache-file (concat - (expand-file-name org-e-publish-timestamp-directory) + (expand-file-name org-publish-timestamp-directory) project-name ".cache")) (cexists (file-exists-p cache-file))) - (when org-e-publish-cache (org-e-publish-reset-cache)) + (when org-publish-cache (org-publish-reset-cache)) (if cexists (load-file cache-file) - (setq org-e-publish-cache + (setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100)) - (org-e-publish-cache-set ":project:" project-name) - (org-e-publish-cache-set ":cache-file:" cache-file)) - (unless cexists (org-e-publish-write-cache-file nil)))) - org-e-publish-cache) + (org-publish-cache-set ":project:" project-name) + (org-publish-cache-set ":cache-file:" cache-file)) + (unless cexists (org-publish-write-cache-file nil)))) + org-publish-cache) -(defun org-e-publish-reset-cache () - "Empty org-e-publish-cache and reset it nil." - (message "%s" "Resetting org-e-publish-cache") - (when (hash-table-p org-e-publish-cache) - (clrhash org-e-publish-cache)) - (setq org-e-publish-cache nil)) +(defun org-publish-reset-cache () + "Empty org-publish-cache and reset it nil." + (message "%s" "Resetting org-publish-cache") + (when (hash-table-p org-publish-cache) + (clrhash org-publish-cache)) + (setq org-publish-cache nil)) -(defun org-e-publish-cache-file-needs-publishing +(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func base-dir) "Check the timestamp of the last publishing of FILENAME. -Non-nil if the file needs publishing. The function also checks -if any included files have been more recently published, so that +Return non-nil if the file needs publishing. Also check if +any included files have been more recently published, so that the file including them will be republished as well." - (unless org-e-publish-cache + (unless org-publish-cache (error - "`org-e-publish-cache-file-needs-publishing' called, but no cache present")) + "`org-publish-cache-file-needs-publishing' called, but no cache present")) (let* ((case-fold-search t) - (key (org-e-publish-timestamp-filename filename pub-dir pub-func)) - (pstamp (org-e-publish-cache-get key)) + (key (org-publish-timestamp-filename filename pub-dir pub-func)) + (pstamp (org-publish-cache-get key)) + (org-inhibit-startup t) (visiting (find-buffer-visiting filename)) included-files-ctime buf) @@ -1128,73 +1153,75 @@ the file including them will be republished as well." (while (re-search-forward "^#\\+INCLUDE:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t) (let* ((included-file (expand-file-name (match-string 1)))) - (add-to-list - 'included-files-ctime - (org-e-publish-cache-ctime-of-src included-file base-dir) - t)))) - ;; FIXME: don't kill current buffer. + (add-to-list 'included-files-ctime + (org-publish-cache-ctime-of-src included-file) t)))) (unless visiting (kill-buffer buf))) (if (null pstamp) t - (let ((ctime (org-e-publish-cache-ctime-of-src filename base-dir))) + (let ((ctime (org-publish-cache-ctime-of-src filename))) (or (< pstamp ctime) (when included-files-ctime (not (null (delq nil (mapcar (lambda(ct) (< ctime ct)) included-files-ctime)))))))))) -(defun org-e-publish-cache-set-file-property +(defun org-publish-cache-set-file-property (filename property value &optional project-name) "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE. Use cache file of PROJECT-NAME. If the entry does not exist, it will be created. Return VALUE." ;; Evtl. load the requested cache file: - (if project-name (org-e-publish-initialize-cache project-name)) - (let ((pl (org-e-publish-cache-get filename))) + (if project-name (org-publish-initialize-cache project-name)) + (let ((pl (org-publish-cache-get filename))) (if pl (progn (plist-put pl property value) value) - (org-e-publish-cache-get-file-property + (org-publish-cache-get-file-property filename property value nil project-name)))) -(defun org-e-publish-cache-get-file-property +(defun org-publish-cache-get-file-property (filename property &optional default no-create project-name) "Return the value for a PROPERTY of file FILENAME in publishing cache. Use cache file of PROJECT-NAME. Return the value of that PROPERTY or DEFAULT, if the value does not yet exist. If the entry will be created, unless NO-CREATE is not nil." ;; Evtl. load the requested cache file: - (if project-name (org-e-publish-initialize-cache project-name)) - (let ((pl (org-e-publish-cache-get filename)) retval) + (if project-name (org-publish-initialize-cache project-name)) + (let ((pl (org-publish-cache-get filename)) retval) (if pl (if (plist-member pl property) (setq retval (plist-get pl property)) (setq retval default)) ;; no pl yet: (unless no-create - (org-e-publish-cache-set filename (list property default))) + (org-publish-cache-set filename (list property default))) (setq retval default)) retval)) -(defun org-e-publish-cache-get (key) - "Return the value stored in `org-e-publish-cache' for key KEY. +(defun org-publish-cache-get (key) + "Return the value stored in `org-publish-cache' for key KEY. Returns nil, if no value or nil is found, or the cache does not exist." - (unless org-e-publish-cache - (error "`org-e-publish-cache-get' called, but no cache present")) - (gethash key org-e-publish-cache)) + (unless org-publish-cache + (error "`org-publish-cache-get' called, but no cache present")) + (gethash key org-publish-cache)) -(defun org-e-publish-cache-set (key value) - "Store KEY VALUE pair in `org-e-publish-cache'. +(defun org-publish-cache-set (key value) + "Store KEY VALUE pair in `org-publish-cache'. Returns value on success, else nil." - (unless org-e-publish-cache - (error "`org-e-publish-cache-set' called, but no cache present")) - (puthash key value org-e-publish-cache)) + (unless org-publish-cache + (error "`org-publish-cache-set' called, but no cache present")) + (puthash key value org-publish-cache)) -(defun org-e-publish-cache-ctime-of-src (f base-dir) - "Get the FILENAME ctime as an integer." +(defun org-publish-cache-ctime-of-src (file) + "Get the ctime of FILE as an integer." (let ((attr (file-attributes - (expand-file-name (or (file-symlink-p f) f) base-dir)))) + (expand-file-name (or (file-symlink-p file) file) + (file-name-directory file))))) (+ (lsh (car (nth 5 attr)) 16) (cadr (nth 5 attr))))) -(provide 'org-e-publish) +(provide 'ox-publish) -;;; org-e-publish.el ends here +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-publish.el ends here diff --git a/contrib/lisp/org-e-texinfo.el b/lisp/ox-texinfo.el similarity index 61% rename from contrib/lisp/org-e-texinfo.el rename to lisp/ox-texinfo.el index ac819a712..b5663240a 100644 --- a/contrib/lisp/org-e-texinfo.el +++ b/lisp/ox-texinfo.el @@ -1,23 +1,23 @@ -;;; org-e-texinfo.el --- Texinfo Back-End For Org Export Engine +;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine ;; Copyright (C) 2012, 2013 Jonathan Leech-Pepin ;; Author: Jonathan Leech-Pepin ;; Keywords: outlines, hypermedia, calendar, wp -;; -;; This file is not part of GNU Emacs. -;; -;; This program is free software; you can redistribute it and/or modify + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -26,149 +26,139 @@ ;; ;; To test it, run ;; -;; M-: (org-export-to-buffer 'e-texinfo "*Test e-texinfo*") RET +;; M-: (org-export-to-buffer 'texinfo "*Test Texinfo*") RET ;; -;; in an org-mode buffer then switch to the buffer to see the Texinfo -;; export. See contrib/lisp/org-export.el for more details on how -;; this exporter works. +;; in an Org mode buffer then switch to the buffer to see the Texinfo +;; export. See ox.el for more details on how this exporter works. ;; -;; It introduces eight new buffer keywords: "TEXINFO_CLASS", -;; "TEXINFO_FILENAME", "TEXINFO_HEADER", "TEXINFO_DIR_CATEGORY", -;; "TEXINFO_DIR_TITLE", "TEXINFO_DIR_DESC" "SUBTITLE" and "SUBAUTHOR". + +;; It introduces nine new buffer keywords: "TEXINFO_CLASS", +;; "TEXINFO_FILENAME", "TEXINFO_HEADER", "TEXINFO_POST_HEADER", +;; "TEXINFO_DIR_CATEGORY", "TEXINFO_DIR_TITLE", "TEXINFO_DIR_DESC" +;; "SUBTITLE" and "SUBAUTHOR". + +;; +;; It introduces 1 new headline property keywords: +;; "TEXINFO_MENU_TITLE" for optional menu titles. ;; ;; To include inline code snippets (for example for generating @kbd{} ;; and @key{} commands), the following export-snippet keys are ;; accepted: ;; +;; texinfo ;; info -;; e-info -;; e-texinfo ;; ;; You can add them for export snippets via any of the below: ;; ;; (add-to-list 'org-export-snippet-translation-alist -;; '("e-info" . "e-texinfo")) -;; (add-to-list 'org-export-snippet-translation-alist -;; '("e-texinfo" . "e-texinfo")) -;; (add-to-list 'org-export-snippet-translation-alist -;; '("info" . "e-texinfo")) +;; '("info" . "texinfo")) ;; ;;; Code: (eval-when-compile (require 'cl)) -(require 'org-export) +(require 'ox) (defvar orgtbl-exp-regexp) + ;;; Define Back-End -(defvar org-e-texinfo-translate-alist - '((babel-call . org-e-texinfo-babel-call) - (bold . org-e-texinfo-bold) - (center-block . org-e-texinfo-center-block) - (clock . org-e-texinfo-clock) - (code . org-e-texinfo-code) - (comment . org-e-texinfo-comment) - (comment-block . org-e-texinfo-comment-block) - (drawer . org-e-texinfo-drawer) - (dynamic-block . org-e-texinfo-dynamic-block) - (entity . org-e-texinfo-entity) - (example-block . org-e-texinfo-example-block) - (export-block . org-e-texinfo-export-block) - (export-snippet . org-e-texinfo-export-snippet) - (fixed-width . org-e-texinfo-fixed-width) - (footnote-definition . org-e-texinfo-footnote-definition) - (footnote-reference . org-e-texinfo-footnote-reference) - (headline . org-e-texinfo-headline) - (horizontal-rule . org-e-texinfo-horizontal-rule) - (inline-babel-call . org-e-texinfo-inline-babel-call) - (inline-src-block . org-e-texinfo-inline-src-block) - (inlinetask . org-e-texinfo-inlinetask) - (italic . org-e-texinfo-italic) - (item . org-e-texinfo-item) - (keyword . org-e-texinfo-keyword) - (latex-environment . org-e-texinfo-latex-environment) - (latex-fragment . org-e-texinfo-latex-fragment) - (line-break . org-e-texinfo-line-break) - (link . org-e-texinfo-link) - (macro . org-e-texinfo-macro) - (paragraph . org-e-texinfo-paragraph) - (plain-list . org-e-texinfo-plain-list) - (plain-text . org-e-texinfo-plain-text) - (planning . org-e-texinfo-planning) - (property-drawer . org-e-texinfo-property-drawer) - (quote-block . org-e-texinfo-quote-block) - (quote-section . org-e-texinfo-quote-section) - (radio-target . org-e-texinfo-radio-target) - (section . org-e-texinfo-section) - (special-block . org-e-texinfo-special-block) - (src-block . org-e-texinfo-src-block) - (statistics-cookie . org-e-texinfo-statistics-cookie) - (strike-through . org-e-texinfo-strike-through) - (subscript . org-e-texinfo-subscript) - (superscript . org-e-texinfo-superscript) - (table . org-e-texinfo-table) - (table-cell . org-e-texinfo-table-cell) - (table-row . org-e-texinfo-table-row) - (target . org-e-texinfo-target) - (template . org-e-texinfo-template) - (timestamp . org-e-texinfo-timestamp) - (underline . org-e-texinfo-underline) - (verbatim . org-e-texinfo-verbatim) - (verse-block . org-e-texinfo-verse-block)) - "Alist between element or object types and translators.") - -(defconst org-e-texinfo-options-alist - '((:texinfo-filename "TEXINFO_FILENAME" nil org-e-texinfo-filename t) - (:texinfo-class "TEXINFO_CLASS" nil org-e-texinfo-default-class t) +(org-export-define-backend 'texinfo + '((bold . org-texinfo-bold) + (center-block . org-texinfo-center-block) + (clock . org-texinfo-clock) + (code . org-texinfo-code) + (comment . org-texinfo-comment) + (comment-block . org-texinfo-comment-block) + (drawer . org-texinfo-drawer) + (dynamic-block . org-texinfo-dynamic-block) + (entity . org-texinfo-entity) + (example-block . org-texinfo-example-block) + (export-block . org-texinfo-export-block) + (export-snippet . org-texinfo-export-snippet) + (fixed-width . org-texinfo-fixed-width) + (footnote-definition . org-texinfo-footnote-definition) + (footnote-reference . org-texinfo-footnote-reference) + (headline . org-texinfo-headline) + (inline-src-block . org-texinfo-inline-src-block) + (inlinetask . org-texinfo-inlinetask) + (italic . org-texinfo-italic) + (item . org-texinfo-item) + (keyword . org-texinfo-keyword) + (line-break . org-texinfo-line-break) + (link . org-texinfo-link) + (paragraph . org-texinfo-paragraph) + (plain-list . org-texinfo-plain-list) + (plain-text . org-texinfo-plain-text) + (planning . org-texinfo-planning) + (property-drawer . org-texinfo-property-drawer) + (quote-block . org-texinfo-quote-block) + (quote-section . org-texinfo-quote-section) + (radio-target . org-texinfo-radio-target) + (section . org-texinfo-section) + (special-block . org-texinfo-special-block) + (src-block . org-texinfo-src-block) + (statistics-cookie . org-texinfo-statistics-cookie) + (subscript . org-texinfo-subscript) + (superscript . org-texinfo-superscript) + (table . org-texinfo-table) + (table-cell . org-texinfo-table-cell) + (table-row . org-texinfo-table-row) + (target . org-texinfo-target) + (template . org-texinfo-template) + (timestamp . org-texinfo-timestamp) + (verbatim . org-texinfo-verbatim) + (verse-block . org-texinfo-verse-block)) + :export-block "TEXINFO" + :filters-alist + '((:filter-headline . org-texinfo-filter-section-blank-lines) + (:filter-section . org-texinfo-filter-section-blank-lines)) + :menu-entry + '(?i "Export to Texinfo" + ((?t "As TEXI file" org-texinfo-export-to-texinfo) + (?i "As INFO file" org-texinfo-export-to-info))) + :options-alist + '((:texinfo-filename "TEXINFO_FILENAME" nil org-texinfo-filename t) + (:texinfo-class "TEXINFO_CLASS" nil org-texinfo-default-class t) (:texinfo-header "TEXINFO_HEADER" nil nil newline) + (:texinfo-post-header "TEXINFO_POST_HEADER" nil nil newline) (:subtitle "SUBTITLE" nil nil newline) (:subauthor "SUBAUTHOR" nil nil newline) (:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t) (:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t) - (:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t)) - "Alist between Texinfo export properties and ways to set them. -See `org-export-options-alist' for more information on the -structure of the values. + (:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t))) -SUBAUTHOR and SUBTITLE are for the inclusion of additional author -and title information beyond the initial variable.") -(defconst org-e-texinfo-filters-alist - '((:filter-headline . org-e-texinfo-filter-section-blank-lines) - (:filter-section . org-e-texinfo-filter-section-blank-lines)) - "Alist between filters keywords and back-end specific filters. - See `org-export-filters-alist' for more information") - - -;;; Internal Variables - -;; Add TEXINFO to the list of available of available export blocks. -(add-to-list 'org-element-block-name-alist - '("TEXINFO" . org-element-export-block-parser)) ;;; User Configurable Variables -(defgroup org-export-e-texinfo nil +(defgroup org-export-texinfo nil "Options for exporting Org mode files to Texinfo." :tag "Org Export Texinfo" + :version "24.4" + :package-version '(Org . "8.0") :group 'org-export) ;;; Preamble -(defcustom org-e-texinfo-filename nil - "Default filename for texinfo output." - :group 'org-export-e-texinfo +(defcustom org-texinfo-filename nil + "Default filename for Texinfo output." + :group 'org-export-texinfo :type '(string :tag "Export Filename")) -(defcustom org-e-texinfo-default-class "info" +(defcustom org-texinfo-coding-system nil + "Default document encoding for Texinfo output." + :group 'org-export-texinfo + :type 'coding-system) + +(defcustom org-texinfo-default-class "info" "The default Texinfo class." - :group 'org-export-e-texinfo + :group 'org-export-texinfo :type '(string :tag "Texinfo class")) -(defcustom org-e-texinfo-classes +(defcustom org-texinfo-classes '(("info" "\\input texinfo @c -*- texinfo -*-" ("@chapter %s" . "@unnumbered %s") @@ -197,7 +187,7 @@ a function name. That function will be called with two parameters, the \(reduced) level of the headline, and a predicate non-nil when the headline should be numbered. It must return a format string in which the section title will be added." - :group 'org-export-e-texinfo + :group 'org-export-texinfo :type '(repeat (list (string :tag "Texinfo class") (string :tag "Texinfo header") @@ -210,7 +200,7 @@ a format string in which the section title will be added." ;;; Headline -(defcustom org-e-texinfo-format-headline-function nil +(defcustom org-texinfo-format-headline-function nil "Function to format headline text. This function will be called with 5 arguments: @@ -225,8 +215,8 @@ The function result will be used in the section format string. As an example, one could set the variable to the following, in order to reproduce the default set-up: -\(defun org-e-texinfo-format-headline (todo todo-type priority text tags) - \"Default format function for an headline.\" +\(defun org-texinfo-format-headline (todo todo-type priority text tags) + \"Default format function for a headline.\" \(concat (when todo \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo)) \(when priority @@ -235,9 +225,19 @@ order to reproduce the default set-up: \(when tags \(format \"\\\\hfill{}\\\\textsc{%s}\" \(mapconcat 'identity tags \":\"))))" - :group 'org-export-e-texinfo + :group 'org-export-texinfo :type 'function) +;;; Node listing (menu) + +(defcustom org-texinfo-node-description-column 32 + "Column at which to start the description in the node + listings. + +If a node title is greater than this length, the description will +be placed after the end of the title." + :group 'org-export-texinfo + :type 'integer) ;;; Footnotes ;; @@ -245,56 +245,56 @@ order to reproduce the default set-up: ;;; Timestamps -(defcustom org-e-texinfo-active-timestamp-format "@emph{%s}" +(defcustom org-texinfo-active-timestamp-format "@emph{%s}" "A printf format string to be applied to active timestamps." - :group 'org-export-e-texinfo + :group 'org-export-texinfo :type 'string) -(defcustom org-e-texinfo-inactive-timestamp-format "@emph{%s}" +(defcustom org-texinfo-inactive-timestamp-format "@emph{%s}" "A printf format string to be applied to inactive timestamps." - :group 'org-export-e-texinfo + :group 'org-export-texinfo :type 'string) -(defcustom org-e-texinfo-diary-timestamp-format "@emph{%s}" +(defcustom org-texinfo-diary-timestamp-format "@emph{%s}" "A printf format string to be applied to diary timestamps." - :group 'org-export-e-texinfo + :group 'org-export-texinfo :type 'string) ;;; Links -(defcustom org-e-texinfo-link-with-unknown-path-format "@indicateurl{%s}" +(defcustom org-texinfo-link-with-unknown-path-format "@indicateurl{%s}" "Format string for links with unknown path type." - :group 'org-export-e-texinfo + :group 'org-export-texinfo :type 'string) ;;; Tables -(defcustom org-e-texinfo-tables-verbatim nil +(defcustom org-texinfo-tables-verbatim nil "When non-nil, tables are exported verbatim." - :group 'org-export-e-texinfo + :group 'org-export-texinfo :type 'boolean) -(defcustom org-e-texinfo-table-scientific-notation "%s\\,(%s)" +(defcustom org-texinfo-table-scientific-notation "%s\\,(%s)" "Format string to display numbers in scientific notation. The format should have \"%s\" twice, for mantissa and exponent \(i.e. \"%s\\\\times10^{%s}\"). When nil, no transformation is made." - :group 'org-export-e-texinfo + :group 'org-export-texinfo :type '(choice (string :tag "Format string") (const :tag "No formatting"))) -(defcustom org-e-texinfo-def-table-markup "@samp" +(defcustom org-texinfo-def-table-markup "@samp" "Default setting for @table environments.") ;;; Text markup -(defcustom org-e-texinfo-text-markup-alist '((bold . "@strong{%s}") - (code . code) - (italic . "@emph{%s}") - (verbatim . verb) - (comment . "@c %s")) +(defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}") + (code . code) + (italic . "@emph{%s}") + (verbatim . verb) + (comment . "@c %s")) "Alist of Texinfo expressions to convert text markup. The key must be a symbol among `bold', `italic' and `comment'. @@ -308,13 +308,13 @@ to typeset and try to protect special characters. If no association can be found for a given markup, text will be returned as-is." - :group 'org-export-e-texinfo + :group 'org-export-texinfo :type 'alist :options '(bold code italic verbatim comment)) ;;; Drawers -(defcustom org-e-texinfo-format-drawer-function nil +(defcustom org-texinfo-format-drawer-function nil "Function called to format a drawer in Texinfo code. The function must accept two parameters: @@ -326,15 +326,15 @@ The function should return the string to be exported. For example, the variable could be set to the following function in order to mimic default behaviour: -\(defun org-e-texinfo-format-drawer-default \(name contents\) +\(defun org-texinfo-format-drawer-default \(name contents\) \"Format a drawer element for Texinfo export.\" contents\)" - :group 'org-export-e-texinfo + :group 'org-export-texinfo :type 'function) ;;; Inlinetasks -(defcustom org-e-texinfo-format-inlinetask-function nil +(defcustom org-texinfo-format-inlinetask-function nil "Function called to format an inlinetask in Texinfo code. The function must accept six parameters: @@ -350,7 +350,7 @@ The function should return the string to be exported. For example, the variable could be set to the following function in order to mimic default behaviour: -\(defun org-e-texinfo-format-inlinetask \(todo type priority name tags contents\) +\(defun org-texinfo-format-inlinetask \(todo type priority name tags contents\) \"Format an inline task element for Texinfo export.\" \(let ((full-title \(concat @@ -365,48 +365,18 @@ in order to mimic default behaviour: \"%s\" \"\n\")) full-title contents))" - :group 'org-export-e-texinfo + :group 'org-export-texinfo :type 'function) ;;; Src blocks ;; ;; Src Blocks are example blocks, except for LISP -;;; Plain text - -(defcustom org-e-texinfo-quotes - '(("quotes" - ("\\(\\s-\\|[[(]\\|^\\)\"" . "``") - ("\\(\\S-\\)\"" . "''") - ("\\(\\s-\\|(\\|^\\)'" . "`"))) - "Alist for quotes to use when converting english double-quotes. - -The CAR of each item in this alist is the language code. -The CDR of each item in this alist is a list of three CONS: -- the first CONS defines the opening quote; -- the second CONS defines the closing quote; -- the last CONS defines single quotes. - -For each item in a CONS, the first string is a regexp -for allowed characters before/after the quote, the second -string defines the replacement string for this quote." - :group 'org-export-e-texinfo - :type '(list - (cons :tag "Opening quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")) - (cons :tag "Closing quote" - (string :tag "Regexp for char after ") - (string :tag "Replacement quote ")) - (cons :tag "Single quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")))) - ;;; Compilation -(defcustom org-e-texinfo-info-process +(defcustom org-texinfo-info-process '("makeinfo %f") - "Commands to process a texinfo file to an INFO file. + "Commands to process a Texinfo file to an INFO file. This is list of strings, each of them will be given to the shell as a command. %f in the command will be replaced by the full file name, %b by the file base name \(i.e without extension) and @@ -415,30 +385,38 @@ file name, %b by the file base name \(i.e without extension) and :type '(repeat :tag "Shell command sequence" (string :tag "Shell command"))) +(defcustom org-texinfo-logfiles-extensions + '("aux" "toc" "cp" "fn" "ky" "pg" "tp" "vr") + "The list of file extensions to consider as Texinfo logfiles. +The logfiles will be remove if `org-texinfo-remove-logfiles' is +non-nil." + :group 'org-export-texinfo + :type '(repeat (string :tag "Extension"))) + +(defcustom org-texinfo-remove-logfiles t + "Non-nil means remove the logfiles produced by compiling a Texinfo file. +By default, logfiles are files with these extensions: .aux, .toc, +.cp, .fn, .ky, .pg and .tp. To define the set of logfiles to remove, +set `org-texinfo-logfiles-extensions'." + :group 'org-export-latex + :type 'boolean) + + +;;; Constants +(defconst org-texinfo-max-toc-depth 4 + "Maximum depth for creation of detailed menu listings. Beyond + this depth Texinfo will not recognize the nodes and will cause + errors. Left as a constant in case this value ever changes.") + ;;; Internal Functions -(defun org-e-texinfo-filter-section-blank-lines (headline back-end info) +(defun org-texinfo-filter-section-blank-lines (headline back-end info) "Filter controlling number of blank lines after a section." (let ((blanks (make-string 2 ?\n))) (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline))) -(defun org-e-texinfo--find-copying (info) - "Retrieve the headline identified by the property :copying:. - -INFO is the plist containing the export options and tree. It is -used to find and extract the single desired headline. This -cannot be treated as a standard headline since it must be -inserted in a specific location." - (let (copying) - (org-element-map (plist-get info :parse-tree) 'headline - (lambda (copy) - (when (org-element-property :copying copy) - (push copy copying))) info 't) - ;; Retrieve the single entry - (car copying))) - -(defun org-e-texinfo--find-verb-separator (s) +(defun org-texinfo--find-verb-separator (s) "Return a character not used in string S. This is used to choose a separator for constructs like \\verb." (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) @@ -446,7 +424,7 @@ This is used to choose a separator for constructs like \\verb." when (not (string-match (regexp-quote (char-to-string c)) s)) return (char-to-string c)))) -(defun org-e-texinfo--make-option-string (options) +(defun org-texinfo--make-option-string (options) "Return a comma separated string of keywords and values. OPTIONS is an alist where the key is the options keyword as a string, and the value a list containing the keyword value, or @@ -458,27 +436,15 @@ nil." options ",")) -(defun org-e-texinfo--quotation-marks (text info) - "Export quotation marks using ` and ' as the markers. -TEXT is a string containing quotation marks to be replaced. INFO -is a plist used as a communication channel." - (mapc (lambda(l) - (let ((start 0)) - (while (setq start (string-match (car l) text start)) - (let ((new-quote (concat (match-string 1 text) (cdr l)))) - (setq text (replace-match new-quote t t text)))))) - (cdr org-e-texinfo-quotes)) - text) - -(defun org-e-texinfo--text-markup (text markup) +(defun org-texinfo--text-markup (text markup) "Format TEXT depending on MARKUP text markup. -See `org-e-texinfo-text-markup-alist' for details." - (let ((fmt (cdr (assq markup org-e-texinfo-text-markup-alist)))) +See `org-texinfo-text-markup-alist' for details." + (let ((fmt (cdr (assq markup org-texinfo-text-markup-alist)))) (cond ;; No format string: Return raw text. ((not fmt) text) ((eq 'verb fmt) - (let ((separator (org-e-texinfo--find-verb-separator text))) + (let ((separator (org-texinfo--find-verb-separator text))) (concat "@verb{" separator text separator "}"))) ((eq 'code fmt) (let ((start 0) @@ -497,15 +463,26 @@ See `org-e-texinfo-text-markup-alist' for details." ;; Else use format string. (t (format fmt text))))) +(defun org-texinfo--get-node (headline info) + "Return node entry associated to HEADLINE. +INFO is a plist used as a communication channel." + (let ((menu-title (org-export-get-alt-title headline info))) + (org-texinfo--sanitize-menu + (replace-regexp-in-string + "%" "%%" + (if menu-title (org-export-data menu-title info) + (org-texinfo--sanitize-headline + (org-element-property :title headline) info)))))) + ;;; Headline sanitizing -(defun org-e-texinfo--sanitize-headline (headline info) +(defun org-texinfo--sanitize-headline (headline info) "Remove all formatting from the text of a headline for use in node and menu listing." (mapconcat 'identity - (org-e-texinfo--sanitize-headline-contents headline info) " ")) + (org-texinfo--sanitize-headline-contents headline info) " ")) -(defun org-e-texinfo--sanitize-headline-contents (headline info) +(defun org-texinfo--sanitize-headline-contents (headline info) "Retrieve the content of the headline. Any content that can contain further formatting is checked @@ -518,26 +495,25 @@ retrieved." (list (replace-regexp-in-string " $" "" contents))) ;; Is exported as-is (value) ((org-element-map contents '(verbatim code) - (lambda (value) - (org-element-property :value value)))) + (lambda (value) (org-element-property :value value)) info)) ;; Has content and recurse into the content ((org-element-contents contents) - (org-e-texinfo--sanitize-headline-contents + (org-texinfo--sanitize-headline-contents (org-element-contents contents) info))))) ;;; Menu sanitizing -(defun org-e-texinfo--sanitize-menu (title) +(defun org-texinfo--sanitize-menu (title) "Remove invalid characters from TITLE for use in menus and nodes. -Based on TEXINFO specifications, the following must be removed: +Based on Texinfo specifications, the following must be removed: @ { } ( ) : . ," (replace-regexp-in-string "[@{}():,.]" "" title)) ;;; Content sanitizing -(defun org-e-texinfo--sanitize-content (text) +(defun org-texinfo--sanitize-content (text) "Ensure characters are properly escaped when used in headlines or blocks. Escape characters are: @ { }" @@ -545,7 +521,7 @@ Escape characters are: @ { }" ;;; Menu creation -(defun org-e-texinfo--build-menu (tree level info &optional detailed) +(defun org-texinfo--build-menu (tree level info &optional detailed) "Create the @menu/@end menu information from TREE at headline level LEVEL. @@ -556,65 +532,63 @@ a plist containing contextual information. Detailed determines whether to build a single level of menu, or recurse into all children as well." - (let ((menu (org-e-texinfo--generate-menu-list tree level info)) + (let ((menu (org-texinfo--generate-menu-list tree level info)) output text-menu) (cond (detailed ;; Looping is done within the menu generation. - (setq text-menu (org-e-texinfo--generate-detailed menu level info))) + (setq text-menu (org-texinfo--generate-detailed menu level info))) (t - (setq text-menu (org-e-texinfo--generate-menu-items menu info)))) + (setq text-menu (org-texinfo--generate-menu-items menu info)))) (when text-menu - (setq output (org-e-texinfo--format-menu text-menu)) + (setq output (org-texinfo--format-menu text-menu)) (mapconcat 'identity output "\n")))) -(defun org-e-texinfo--generate-detailed (menu level info) +(defun org-texinfo--generate-detailed (menu level info) "Generate a detailed listing of all subheadings within MENU starting at LEVEL. MENU is the parse-tree to work with. LEVEL is the starting level for the menu headlines and from which recursion occurs. INFO is a plist containing contextual information." (when level - (let ((max-depth (plist-get info :headline-levels))) + (let ((max-depth (min org-texinfo-max-toc-depth + (plist-get info :headline-levels)))) (when (> max-depth level) (loop for headline in menu append - (let* ((title (org-e-texinfo--menu-headlines headline info)) + (let* ((title (org-texinfo--menu-headlines headline info)) ;; Create list of menu entries for the next level - (sublist (org-e-texinfo--generate-menu-list + (sublist (org-texinfo--generate-menu-list headline (1+ level) info)) ;; Generate the menu items for that level. If ;; there are none omit that heading completely, ;; otherwise join the title to it's related entries. - (submenu (if (org-e-texinfo--generate-menu-items sublist info) + (submenu (if (org-texinfo--generate-menu-items sublist info) (append (list title) - (org-e-texinfo--generate-menu-items sublist info)) + (org-texinfo--generate-menu-items sublist info)) 'nil)) ;; Start the process over the next level down. - (recursion (org-e-texinfo--generate-detailed sublist (1+ level) info))) + (recursion (org-texinfo--generate-detailed sublist (1+ level) info))) (setq recursion (append submenu recursion)) recursion)))))) -(defun org-e-texinfo--generate-menu-list (tree level info) +(defun org-texinfo--generate-menu-list (tree level info) "Generate the list of headlines that are within a given level of the tree for further formatting. TREE is the parse-tree containing the headlines. LEVEL is the headline level to generate a list of. INFO is a plist holding contextual information." - (let (seq) - (org-element-map - tree 'headline - (lambda (head) - (when (org-element-property :level head) - (if (and (eq level (org-element-property :level head)) - ;; Do not take note of footnotes or copying headlines - (not (org-element-property :copying head)) - (not (org-element-property :footnote-section-p head))) - (push head seq))))) - ;; Return the list of headlines (reverse to have in actual order) - (reverse seq))) + (org-element-map tree 'headline + (lambda (head) + (and (= (org-export-get-relative-level head info) level) + ;; Do not take note of footnotes or copying headlines. + (not (org-element-property :COPYING head)) + (not (org-element-property :footnote-section-p head)) + ;; Collect headline. + head)) + info)) -(defun org-e-texinfo--generate-menu-items (items info) +(defun org-texinfo--generate-menu-items (items info) "Generate a list of headline information from the listing ITEMS. ITEMS is a list of the headlines to be converted into entries. @@ -622,31 +596,37 @@ INFO is a plist containing contextual information. Returns a list containing the following information from each headline: length, title, description. This is used to format the -menu using `org-e-texinfo--format-menu'." +menu using `org-texinfo--format-menu'." (loop for headline in items collect - (let* ((title (org-e-texinfo--sanitize-menu - (org-e-texinfo--sanitize-headline + (let* ((menu-title (org-texinfo--sanitize-menu + (org-export-data + (org-export-get-alt-title headline info) + info))) + (title (org-texinfo--sanitize-menu + (org-texinfo--sanitize-headline (org-element-property :title headline) info))) (descr (org-export-data - (org-element-property :description headline) info)) - (len (length title)) - (output (list len title descr))) + (org-element-property :DESCRIPTION headline) + info)) + (menu-entry (if (string= "" menu-title) title menu-title)) + (len (length menu-entry)) + (output (list len menu-entry descr))) output))) -(defun org-e-texinfo--menu-headlines (headline info) +(defun org-texinfo--menu-headlines (headline info) "Retrieve the title from HEADLINE. INFO is a plist holding contextual information. Return the headline as a list of (length title description) with length of -1 and nil description. This is used in -`org-e-texinfo--format-menu' to identify headlines as opposed to +`org-texinfo--format-menu' to identify headlines as opposed to entries." (let ((title (org-export-data (org-element-property :title headline) info))) (list -1 title 'nil))) -(defun org-e-texinfo--format-menu (text-menu) +(defun org-texinfo--format-menu (text-menu) "Format the TEXT-MENU items to be properly printed in the menu. Each entry in the menu should be provided as (length title @@ -662,19 +642,23 @@ Other menu items are output as: With the spacing between :: and description based on the length of the longest menu entry." - (let* ((lengths (mapcar 'car text-menu)) - (max-length (apply 'max lengths)) - output) + (let (output) (setq output (mapcar (lambda (name) - (let* ((title (nth 1 name)) - (desc (nth 2 name)) - (length (nth 0 name))) + (let* ((title (nth 1 name)) + (desc (nth 2 name)) + (length (nth 0 name)) + (column (max + ;;6 is "* " ":: " for inserted text + length + (- + org-texinfo-node-description-column + 6))) + (spacing (- column length) + )) (if (> length -1) - (concat "* " title ":: " - (make-string - (- (+ 3 max-length) length) - ?\s) + (concat "* " title ":: " + (make-string spacing ?\s) (if desc (concat desc))) (concat "\n" title "\n")))) @@ -683,7 +667,7 @@ of the longest menu entry." ;;; Template -(defun org-e-texinfo-template (contents info) +(defun org-texinfo-template (contents info) "Return complete document string after Texinfo conversion. CONTENTS is the transcoded contents string. INFO is a plist holding export options." @@ -692,20 +676,24 @@ holding export options." (file-name-nondirectory (org-export-output-file-name ".info")))) (author (org-export-data (plist-get info :author) info)) + (lang (org-export-data (plist-get info :language) info)) (texinfo-header (plist-get info :texinfo-header)) + (texinfo-post-header (plist-get info :texinfo-post-header)) (subtitle (plist-get info :subtitle)) (subauthor (plist-get info :subauthor)) (class (plist-get info :texinfo-class)) - (header (nth 1 (assoc class org-e-texinfo-classes))) - (copying (org-e-texinfo--find-copying info)) + (header (nth 1 (assoc class org-texinfo-classes))) + (copying + (org-element-map (plist-get info :parse-tree) 'headline + (lambda (hl) (and (org-element-property :COPYING hl) hl)) info t)) (dircat (plist-get info :texinfo-dircat)) (dirtitle (plist-get info :texinfo-dirtitle)) (dirdesc (plist-get info :texinfo-dirdesc)) ;; Spacing to align description (column 32 - 3 for `* ' and ;; `.' in text. (dirspacing (- 29 (length dirtitle))) - (menu (org-e-texinfo-make-menu info 'main)) - (detail-menu (org-e-texinfo-make-menu info 'detailed))) + (menu (org-texinfo-make-menu info 'main)) + (detail-menu (org-texinfo-make-menu info 'detailed))) (concat ;; Header header "\n" @@ -713,6 +701,10 @@ holding export options." ;; Filename and Title "@setfilename " info-filename "\n" "@settitle " title "\n" + (if org-texinfo-coding-system + (format "@documentencoding %s\n" + (upcase (symbol-name org-texinfo-coding-system))) "\n") + (format "@documentlanguage %s\n" lang) "\n\n" "@c Version and Contact Info\n" "@set AUTHOR " author "\n" @@ -727,6 +719,12 @@ holding export options." "@finalout\n" "\n\n" + ;; Additional Header Options set by #+TEXINFO_POST_HEADER + (if texinfo-post-header + (concat "\n" + texinfo-post-header + "\n")) + ;; Copying "@copying\n" ;; Only export the content of the headline, do not need the @@ -803,56 +801,58 @@ holding export options." ;;; Transcode Functions -;;; Babel Call -;; -;; Babel Calls are ignored. - ;;; Bold -(defun org-e-texinfo-bold (bold contents info) +(defun org-texinfo-bold (bold contents info) "Transcode BOLD from Org to Texinfo. CONTENTS is the text with bold markup. INFO is a plist holding contextual information." - (org-e-texinfo--text-markup contents 'bold)) + (org-texinfo--text-markup contents 'bold)) ;;; Center Block -;; -;; Center blocks are ignored + +(defun org-texinfo-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist used +as a communication channel." + contents) ;;; Clock -(defun org-e-texinfo-clock (clock contents info) +(defun org-texinfo-clock (clock contents info) "Transcode a CLOCK element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." (concat "@noindent" (format "@strong{%s} " org-clock-string) - (format org-e-texinfo-inactive-timestamp-format - (concat (org-translate-time (org-element-property :value clock)) - (let ((time (org-element-property :time clock))) + (format org-texinfo-inactive-timestamp-format + (concat (org-translate-time + (org-element-property :raw-value + (org-element-property :value clock))) + (let ((time (org-element-property :duration clock))) (and time (format " (%s)" time))))) "@*")) ;;; Code -(defun org-e-texinfo-code (code contents info) +(defun org-texinfo-code (code contents info) "Transcode a CODE object from Org to Texinfo. CONTENTS is nil. INFO is a plist used as a communication channel." - (org-e-texinfo--text-markup (org-element-property :value code) 'code)) + (org-texinfo--text-markup (org-element-property :value code) 'code)) ;;; Comment -(defun org-e-texinfo-comment (comment contents info) +(defun org-texinfo-comment (comment contents info) "Transcode a COMMENT object from Org to Texinfo. CONTENTS is the text in the comment. INFO is a plist holding contextual information." - (org-e-texinfo--text-markup (org-element-property :value comment) 'comment)) + (org-texinfo--text-markup (org-element-property :value comment) 'comment)) ;;; Comment Block -(defun org-e-texinfo-comment-block (comment-block contents info) +(defun org-texinfo-comment-block (comment-block contents info) "Transcode a COMMENT-BLOCK object from Org to Texinfo. CONTENTS is the text within the block. INFO is a plist holding contextual information." @@ -860,13 +860,13 @@ contextual information." ;;; Drawer -(defun org-e-texinfo-drawer (drawer contents info) +(defun org-texinfo-drawer (drawer contents info) "Transcode a DRAWER element from Org to Texinfo. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let* ((name (org-element-property :drawer-name drawer)) - (output (if (functionp org-e-texinfo-format-drawer-function) - (funcall org-e-texinfo-format-drawer-function + (output (if (functionp org-texinfo-format-drawer-function) + (funcall org-texinfo-format-drawer-function name contents) ;; If there's no user defined function: simply ;; display contents of the drawer. @@ -875,7 +875,7 @@ holding contextual information." ;;; Dynamic Block -(defun org-e-texinfo-dynamic-block (dynamic-block contents info) +(defun org-texinfo-dynamic-block (dynamic-block contents info) "Transcode a DYNAMIC-BLOCK element from Org to Texinfo. CONTENTS holds the contents of the block. INFO is a plist holding contextual information. See `org-export-data'." @@ -883,7 +883,7 @@ holding contextual information. See `org-export-data'." ;;; Entity -(defun org-e-texinfo-entity (entity contents info) +(defun org-texinfo-entity (entity contents info) "Transcode an ENTITY object from Org to Texinfo. CONTENTS are the definition itself. INFO is a plist holding contextual information." @@ -892,7 +892,7 @@ contextual information." ;;; Example Block -(defun org-e-texinfo-example-block (example-block contents info) +(defun org-texinfo-example-block (example-block contents info) "Transcode an EXAMPLE-BLOCK element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." @@ -901,7 +901,7 @@ information." ;;; Export Block -(defun org-e-texinfo-export-block (export-block contents info) +(defun org-texinfo-export-block (export-block contents info) "Transcode a EXPORT-BLOCK element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." (when (string= (org-element-property :type export-block) "TEXINFO") @@ -909,30 +909,26 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;; Export Snippet -(defun org-e-texinfo-export-snippet (export-snippet contents info) +(defun org-texinfo-export-snippet (export-snippet contents info) "Transcode a EXPORT-SNIPPET object from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." - (when (eq (org-export-snippet-backend export-snippet) 'e-texinfo) + (when (eq (org-export-snippet-backend export-snippet) 'texinfo) (org-element-property :value export-snippet))) ;;; Fixed Width -(defun org-e-texinfo-fixed-width (fixed-width contents info) +(defun org-texinfo-fixed-width (fixed-width contents info) "Transcode a FIXED-WIDTH element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." (format "@example\n%s\n@end example" (org-remove-indentation - (org-e-texinfo--sanitize-content + (org-texinfo--sanitize-content (org-element-property :value fixed-width))))) -;;; Footnote Definition -;; -;; Footnote Definitions are ignored. - ;;; Footnote Reference ;; -(defun org-e-texinfo-footnote-reference (footnote contents info) +(defun org-texinfo-footnote-reference (footnote contents info) "Create a footnote reference for FOOTNOTE. FOOTNOTE is the footnote to define. CONTENTS is nil. INFO is a @@ -943,46 +939,46 @@ plist holding contextual information." ;;; Headline -(defun org-e-texinfo-headline (headline contents info) - "Transcode an HEADLINE element from Org to Texinfo. +(defun org-texinfo-headline (headline contents info) + "Transcode a HEADLINE element from Org to Texinfo. CONTENTS holds the contents of the headline. INFO is a plist holding contextual information." (let* ((class (plist-get info :texinfo-class)) (level (org-export-get-relative-level headline info)) (numberedp (org-export-numbered-headline-p headline info)) - (class-sectionning (assoc class org-e-texinfo-classes)) + (class-sectionning (assoc class org-texinfo-classes)) ;; Find the index type, if any - (index (org-element-property :index headline)) + (index (org-element-property :INDEX headline)) + ;; Check if it is an appendix + (appendix (org-element-property :APPENDIX headline)) ;; Retrieve headline text - (text (org-e-texinfo--sanitize-headline + (text (org-texinfo--sanitize-headline (org-element-property :title headline) info)) ;; Create node info, to insert it before section formatting. - (node (format "@node %s\n" - (org-e-texinfo--sanitize-menu - (replace-regexp-in-string "%" "%%" text)))) + ;; Use custom menu title if present + (node (format "@node %s\n" (org-texinfo--get-node headline info))) ;; Menus must be generated with first child, otherwise they ;; will not nest properly (menu (let* ((first (org-export-first-sibling-p headline info)) (parent (org-export-get-parent-headline headline)) - (title (org-e-texinfo--sanitize-headline + (title (org-texinfo--sanitize-headline (org-element-property :title parent) info)) heading listing (tree (plist-get info :parse-tree))) (if first - (org-element-map - (plist-get info :parse-tree) 'headline - (lambda (ref) - (if (member title (org-element-property :title ref)) - (push ref heading))) - info 't)) - (setq listing (org-e-texinfo--build-menu + (org-element-map (plist-get info :parse-tree) 'headline + (lambda (ref) + (if (member title (org-element-property :title ref)) + (push ref heading))) + info t)) + (setq listing (org-texinfo--build-menu (car heading) level info)) - (if listing - (setq listing (replace-regexp-in-string + (if listing + (setq listing (replace-regexp-in-string "%" "%%" listing) listing (format "\n@menu\n%s\n@end menu\n\n" listing)) - 'nil))) + 'nil))) ;; Section formatting will set two placeholders: one for the ;; title and the other for the contents. (section-fmt @@ -997,13 +993,20 @@ holding contextual information." ((stringp sec) sec) ;; (numbered-section . unnumbered-section) ((not (consp (cdr sec))) - ;; If an index, always unnumbered - (if index - (concat menu node (cdr sec) "\n%s") + (cond + ;;If an index, always unnumbered + (index + (concat menu node (cdr sec) "\n%s")) + (appendix + (concat menu node (replace-regexp-in-string + "unnumbered" + "appendix" + (cdr sec)) "\n%s")) ;; Otherwise number as needed. + (t (concat menu node (funcall - (if numberedp #'car #'cdr) sec) "\n%s")))))) + (if numberedp #'car #'cdr) sec) "\n%s"))))))) (todo (and (plist-get info :with-todo-keywords) (let ((todo (org-element-property :todo-keyword headline))) @@ -1015,10 +1018,10 @@ holding contextual information." (org-element-property :priority headline))) ;; Create the headline text along with a no-tag version. The ;; latter is required to remove tags from table of contents. - (full-text (org-e-texinfo--sanitize-content - (if (functionp org-e-texinfo-format-headline-function) + (full-text (org-texinfo--sanitize-content + (if (functionp org-texinfo-format-headline-function) ;; User-defined formatting function. - (funcall org-e-texinfo-format-headline-function + (funcall org-texinfo-format-headline-function todo todo-type priority text tags) ;; Default formatting. (concat @@ -1027,13 +1030,13 @@ holding contextual information." (when priority (format "@emph{#%s} " priority)) text (when tags - (format ":%s:" + (format " :%s:" (mapconcat 'identity tags ":"))))))) (full-text-no-tag - (org-e-texinfo--sanitize-content - (if (functionp org-e-texinfo-format-headline-function) + (org-texinfo--sanitize-content + (if (functionp org-texinfo-format-headline-function) ;; User-defined formatting function. - (funcall org-e-texinfo-format-headline-function + (funcall org-texinfo-format-headline-function todo todo-type priority text nil) ;; Default formatting. (concat @@ -1047,7 +1050,7 @@ holding contextual information." ((org-element-property :footnote-section-p headline) nil) ;; Case 2: This is the `copying' section: ignore it ;; This is used elsewhere. - ((org-element-property :copying headline) nil) + ((org-element-property :COPYING headline) nil) ;; Case 3: An index. If it matches one of the known indexes, ;; print it as such following the contents, otherwise ;; print the contents and leave the index up to the user. @@ -1106,27 +1109,19 @@ holding contextual information." (format (replace-regexp-in-string "%]" "%%]" section-fmt) full-text (concat pre-blanks contents)))))))) -;;; Horizontal Rule -;; -;; Horizontal rules are ignored - -;;; Inline Babel Call -;; -;; Inline Babel Calls are ignored. - ;;; Inline Src Block -(defun org-e-texinfo-inline-src-block (inline-src-block contents info) +(defun org-texinfo-inline-src-block (inline-src-block contents info) "Transcode an INLINE-SRC-BLOCK element from Org to Texinfo. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let* ((code (org-element-property :value inline-src-block)) - (separator (org-e-texinfo--find-verb-separator code))) + (separator (org-texinfo--find-verb-separator code))) (concat "@verb{" separator code separator "}"))) ;;; Inlinetask -(defun org-e-texinfo-inlinetask (inlinetask contents info) +(defun org-texinfo-inlinetask (inlinetask contents info) "Transcode an INLINETASK element from Org to Texinfo. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -1139,10 +1134,10 @@ holding contextual information." (org-export-get-tags inlinetask info))) (priority (and (plist-get info :with-priority) (org-element-property :priority inlinetask)))) - ;; If `org-e-texinfo-format-inlinetask-function' is provided, call it + ;; If `org-texinfo-format-inlinetask-function' is provided, call it ;; with appropriate arguments. - (if (functionp org-e-texinfo-format-inlinetask-function) - (funcall org-e-texinfo-format-inlinetask-function + (if (functionp org-texinfo-format-inlinetask-function) + (funcall org-texinfo-format-inlinetask-function todo todo-type priority title tags contents) ;; Otherwise, use a default template. (let ((full-title @@ -1159,26 +1154,26 @@ holding contextual information." ;;; Italic -(defun org-e-texinfo-italic (italic contents info) +(defun org-texinfo-italic (italic contents info) "Transcode ITALIC from Org to Texinfo. CONTENTS is the text with italic markup. INFO is a plist holding contextual information." - (org-e-texinfo--text-markup contents 'italic)) + (org-texinfo--text-markup contents 'italic)) ;;; Item -(defun org-e-texinfo-item (item contents info) +(defun org-texinfo-item (item contents info) "Transcode an ITEM element from Org to Texinfo. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let* ((tag (org-element-property :tag item)) (desc (org-export-data tag info))) (concat "\n@item " (if tag desc) "\n" - (org-trim contents) "\n"))) + (and contents (org-trim contents)) "\n"))) ;;; Keyword -(defun org-e-texinfo-keyword (keyword contents info) +(defun org-texinfo-keyword (keyword contents info) "Transcode a KEYWORD element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." (let ((key (org-element-property :key keyword)) @@ -1192,24 +1187,16 @@ CONTENTS is nil. INFO is a plist holding contextual information." ((string= key "TINDEX") (format "@tindex %s" value)) ((string= key "VINDEX") (format "@vindex %s" value))))) -;;; Latex Environment -;; -;; Latex environments are ignored - -;;; Latex Fragment -;; -;; Latex fragments are ignored. - ;;; Line Break -(defun org-e-texinfo-line-break (line-break contents info) +(defun org-texinfo-line-break (line-break contents info) "Transcode a LINE-BREAK object from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." - "@*") + "@*\n") ;;; Link -(defun org-e-texinfo-link (link desc info) +(defun org-texinfo-link (link desc info) "Transcode a LINK object from Org to Texinfo. DESC is the description part of the link, or the empty string. @@ -1223,8 +1210,6 @@ INFO is a plist holding contextual information. See ((member type '("http" "https" "ftp")) (concat type ":" raw-path)) ((string= type "file") - (when (string-match "\\(.+\\)::.+" raw-path) - (setq raw-path (match-string 1 raw-path))) (if (file-name-absolute-p raw-path) (concat "file://" (expand-file-name raw-path)) (concat "file://" raw-path))) @@ -1235,7 +1220,7 @@ INFO is a plist holding contextual information. See (concat text (if desc (concat "," desc)))))) protocol) (cond - ;; Links pointing to an headline: Find destination and build + ;; Links pointing to a headline: Find destination and build ;; appropriate referencing command. ((member type '("custom-id" "id")) (let ((destination (org-export-resolve-id-link link info))) @@ -1244,15 +1229,21 @@ INFO is a plist holding contextual information. See (plain-text (if desc (format "@uref{file://%s,%s}" destination desc) (format "@uref{file://%s}" destination))) - ;; LINK points to an headline. Use the headline as the NODE target + ;; LINK points to a headline. Use the headline as the NODE target (headline - (format "@ref{%s}" - (org-export-data - (org-element-property :title destination) info))) + (format "@ref{%s,%s}" + (org-texinfo--get-node destination info) + (or desc ""))) (otherwise (let ((path (org-export-solidify-link-text path))) (if (not desc) (format "@ref{%s}" path) (format "@ref{%s,,%s}" path desc))))))) + ((member type '("info")) + (let* ((info-path (split-string path "[:#]")) + (info-manual (car info-path)) + (info-node (or (cadr info-path) "top")) + (title (or desc ""))) + (format "@ref{%s,%s,,%s,}" info-node title info-manual))) ((member type '("fuzzy")) (let ((destination (org-export-resolve-fuzzy-link link info))) (case (org-element-type destination) @@ -1260,11 +1251,11 @@ INFO is a plist holding contextual information. See (plain-text (if desc (format "@uref{file://%s,%s}" destination desc) (format "@uref{file://%s}" destination))) - ;; LINK points to an headline. Use the headline as the NODE target + ;; LINK points to a headline. Use the headline as the NODE target (headline - (format "@ref{%s}" - (org-export-data - (org-element-property :title destination) info))) + (format "@ref{%s,%s}" + (org-texinfo--get-node destination info) + (or desc ""))) (otherwise (let ((path (org-export-solidify-link-text path))) (if (not desc) (format "@ref{%s}" path) @@ -1277,19 +1268,12 @@ INFO is a plist holding contextual information. See ;; External link without a description part. (path (format "@uref{%s}" path)) ;; No path, only description. Try to do something useful. - (t (format org-e-texinfo-link-with-unknown-path-format desc))))) + (t (format org-texinfo-link-with-unknown-path-format desc))))) -;;; Macro - -(defun org-e-texinfo-macro (macro contents info) - "Transcode a MACRO element from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual information." - ;; Use available tools. - (org-export-expand-macro macro info)) ;;; Menu -(defun org-e-texinfo-make-menu (info level) +(defun org-texinfo-make-menu (info level) "Create the menu for inclusion in the texifo document. INFO is the parsed buffer that contains the headlines. LEVEL @@ -1297,28 +1281,19 @@ determines whether to make the main menu, or the detailed menu. This is only used for generating the primary menu. In-Node menus are generated directly." - (let* ((parse (plist-get info :parse-tree)) - ;; Top determines level to build menu from, it finds the - ;; level of the first headline in the export. - (top (org-element-map - parse 'headline - (lambda (headline) - (org-element-property :level headline)) info 't))) + (let ((parse (plist-get info :parse-tree))) (cond ;; Generate the main menu - ((eq level 'main) - (org-e-texinfo--build-menu parse top info)) + ((eq level 'main) (org-texinfo--build-menu parse 1 info)) ;; Generate the detailed (recursive) menu ((eq level 'detailed) ;; Requires recursion - ;;(org-e-texinfo--build-detailed-menu parse top info) - (org-e-texinfo--build-menu parse top info 'detailed)) - ;; Otherwise do nothing - (t)))) + ;;(org-texinfo--build-detailed-menu parse top info) + (org-texinfo--build-menu parse 1 info 'detailed))))) ;;; Paragraph -(defun org-e-texinfo-paragraph (paragraph contents info) +(defun org-texinfo-paragraph (paragraph contents info) "Transcode a PARAGRAPH element from Org to Texinfo. CONTENTS is the contents of the paragraph, as a string. INFO is the plist used as a communication channel." @@ -1326,19 +1301,17 @@ the plist used as a communication channel." ;;; Plain List -(defun org-e-texinfo-plain-list (plain-list contents info) +(defun org-texinfo-plain-list (plain-list contents info) "Transcode a PLAIN-LIST element from Org to Texinfo. CONTENTS is the contents of the list. INFO is a plist holding contextual information." (let* ((attr (org-export-read-attribute :attr_texinfo plain-list)) (indic (or (plist-get attr :indic) - org-e-texinfo-def-table-markup)) + org-texinfo-def-table-markup)) (type (org-element-property :type plain-list)) - (table-type (or (plist-get attr :table-type) - "table")) + (table-type (plist-get attr :table-type)) ;; Ensure valid texinfo table type. - (table-type (if (memq table-type '("table" "ftable" "vtable")) - table-type + (table-type (if (member table-type '("ftable" "vtable")) table-type "table")) (list-type (cond ((eq type 'ordered) "enumerate") @@ -1353,33 +1326,38 @@ contextual information." ;;; Plain Text -(defun org-e-texinfo-plain-text (text info) +(defun org-texinfo-plain-text (text info) "Transcode a TEXT string from Org to Texinfo. TEXT is the string to transcode. INFO is a plist holding contextual information." - ;; LaTeX into @LaTeX{} and TeX into @TeX{} - (let ((case-fold-search nil) - (start 0)) - (while (string-match "\\(\\(?:La\\)?TeX\\)" text start) - (setq text (replace-match - (format "@%s{}" (match-string 1 text)) nil t text) - start (match-end 0)))) - ;; Handle quotation marks - (setq text (org-e-texinfo--quotation-marks text info)) - ;; Convert special strings. - (when (plist-get info :with-special-strings) - (while (string-match (regexp-quote "...") text) - (setq text (replace-match "@dots{}" nil t text)))) - ;; Handle break preservation if required. - (when (plist-get info :preserve-breaks) - (setq text (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" " @*\n" - text))) - ;; Return value with @ { and } protected. - (org-e-texinfo--sanitize-content text)) + ;; First protect @, { and }. + (let ((output (org-texinfo--sanitize-content text))) + ;; Activate smart quotes. Be sure to provide original TEXT string + ;; since OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output + (org-export-activate-smart-quotes output :texinfo info text))) + ;; LaTeX into @LaTeX{} and TeX into @TeX{} + (let ((case-fold-search nil) + (start 0)) + (while (string-match "\\(\\(?:La\\)?TeX\\)" output start) + (setq output (replace-match + (format "@%s{}" (match-string 1 output)) nil t output) + start (match-end 0)))) + ;; Convert special strings. + (when (plist-get info :with-special-strings) + (while (string-match (regexp-quote "...") output) + (setq output (replace-match "@dots{}" nil t output)))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" " @*\n" output))) + ;; Return value. + output)) ;;; Planning -(defun org-e-texinfo-planning (planning contents info) +(defun org-texinfo-planning (planning contents info) "Transcode a PLANNING element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1392,27 +1370,30 @@ information." (let ((closed (org-element-property :closed planning))) (when closed (concat - (format "@strong%s} " org-closed-string) - (format org-e-texinfo-inactive-timestamp-format - (org-translate-time closed))))) + (format "@strong{%s} " org-closed-string) + (format org-texinfo-inactive-timestamp-format + (org-translate-time + (org-element-property :raw-value closed)))))) (let ((deadline (org-element-property :deadline planning))) (when deadline (concat (format "@strong{%s} " org-deadline-string) - (format org-e-texinfo-active-timestamp-format - (org-translate-time deadline))))) + (format org-texinfo-active-timestamp-format + (org-translate-time + (org-element-property :raw-value deadline)))))) (let ((scheduled (org-element-property :scheduled planning))) (when scheduled (concat (format "@strong{%s} " org-scheduled-string) - (format org-e-texinfo-active-timestamp-format - (org-translate-time scheduled))))))) + (format org-texinfo-active-timestamp-format + (org-translate-time + (org-element-property :raw-value scheduled)))))))) " ") "@*")) ;;; Property Drawer -(defun org-e-texinfo-property-drawer (property-drawer contents info) +(defun org-texinfo-property-drawer (property-drawer contents info) "Transcode a PROPERTY-DRAWER element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1422,7 +1403,7 @@ information." ;;; Quote Block -(defun org-e-texinfo-quote-block (quote-block contents info) +(defun org-texinfo-quote-block (quote-block contents info) "Transcode a QUOTE-BLOCK element from Org to Texinfo. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -1434,7 +1415,7 @@ holding contextual information." ;;; Quote Section -(defun org-e-texinfo-quote-section (quote-section contents info) +(defun org-texinfo-quote-section (quote-section contents info) "Transcode a QUOTE-SECTION element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." (let ((value (org-remove-indentation @@ -1443,7 +1424,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;; Radio Target -(defun org-e-texinfo-radio-target (radio-target text info) +(defun org-texinfo-radio-target (radio-target text info) "Transcode a RADIO-TARGET object from Org to Texinfo. TEXT is the text of the target. INFO is a plist holding contextual information." @@ -1454,48 +1435,50 @@ contextual information." ;;; Section -(defun org-e-texinfo-section (section contents info) +(defun org-texinfo-section (section contents info) "Transcode a SECTION element from Org to Texinfo. CONTENTS holds the contents of the section. INFO is a plist holding contextual information." contents) ;;; Special Block -;; -;; Are ignored at the moment + +(defun org-texinfo-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist used +as a communication channel." + contents) ;;; Src Block -(defun org-e-texinfo-src-block (src-block contents info) +(defun org-texinfo-src-block (src-block contents info) "Transcode a SRC-BLOCK element from Org to Texinfo. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let* ((lang (org-element-property :language src-block)) - (lisp-p (string-match-p "lisp" lang))) + (lisp-p (string-match-p "lisp" lang)) + (src-contents (org-texinfo--sanitize-content + (org-export-format-code-default src-block info)))) (cond ;; Case 1. Lisp Block (lisp-p - (format "@lisp\n%s\n@end lisp" - (org-export-format-code-default src-block info))) + (format "@lisp\n%s@end lisp" + src-contents)) ;; Case 2. Other blocks (t - (format "@example\n%s\n@end example" - (org-export-format-code-default src-block info)))))) + (format "@example\n%s@end example" + src-contents))))) ;;; Statistics Cookie -(defun org-e-texinfo-statistics-cookie (statistics-cookie contents info) +(defun org-texinfo-statistics-cookie (statistics-cookie contents info) "Transcode a STATISTICS-COOKIE object from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." (org-element-property :value statistics-cookie)) -;;; Strike-Through -;; -;; Strikethrough is ignored - ;;; Subscript -(defun org-e-texinfo-subscript (subscript contents info) +(defun org-texinfo-subscript (subscript contents info) "Transcode a SUBSCRIPT object from Org to Texinfo. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -1503,7 +1486,7 @@ contextual information." ;;; Superscript -(defun org-e-texinfo-superscript (superscript contents info) +(defun org-texinfo-superscript (superscript contents info) "Transcode a SUPERSCRIPT object from Org to Texinfo. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -1511,22 +1494,22 @@ contextual information." ;;; Table ;; -;; `org-e-texinfo-table' is the entry point for table transcoding. It +;; `org-texinfo-table' is the entry point for table transcoding. It ;; takes care of tables with a "verbatim" attribute. Otherwise, it -;; delegates the job to either `org-e-texinfo-table--table.el-table' or -;; `org-e-texinfo-table--org-table' functions, depending of the type of +;; delegates the job to either `org-texinfo-table--table.el-table' or +;; `org-texinfo-table--org-table' functions, depending of the type of ;; the table. ;; -;; `org-e-texinfo-table--align-string' is a subroutine used to build +;; `org-texinfo-table--align-string' is a subroutine used to build ;; alignment string for Org tables. -(defun org-e-texinfo-table (table contents info) +(defun org-texinfo-table (table contents info) "Transcode a TABLE element from Org to Texinfo. CONTENTS is the contents of the table. INFO is a plist holding contextual information." (cond ;; Case 1: verbatim table. - ((or org-e-texinfo-tables-verbatim + ((or org-texinfo-tables-verbatim (let ((attr (mapconcat 'identity (org-element-property :attr_latex table) " "))) @@ -1538,19 +1521,18 @@ contextual information." `(table nil ,@(org-element-contents table)))))) ;; Case 2: table.el table. Convert it using appropriate tools. ((eq (org-element-property :type table) 'table.el) - (org-e-texinfo-table--table.el-table table contents info)) + (org-texinfo-table--table.el-table table contents info)) ;; Case 3: Standard table. - (t (org-e-texinfo-table--org-table table contents info)))) + (t (org-texinfo-table--org-table table contents info)))) -(defun org-e-texinfo-table-column-widths (table info) +(defun org-texinfo-table-column-widths (table info) "Determine the largest table cell in each column to process alignment. TABLE is the table element to transcode. INFO is a plist used as a communication channel." (let* ((rows (org-element-map table 'table-row 'identity info)) (collected (loop for row in rows collect - (org-element-map - row 'table-cell 'identity info))) + (org-element-map row 'table-cell 'identity info))) (number-cells (length (car collected))) cells counts) (loop for row in collected do @@ -1559,7 +1541,7 @@ a communication channel." (end (org-element-property :contents-end ref)) (length (- end start))) length)) row) cells)) - (setq cells (remove-if #'null cells)) + (setq cells (org-remove-if 'null cells)) (push (loop for count from 0 to (- number-cells 1) collect (loop for item in cells collect (nth count item))) counts) @@ -1568,7 +1550,7 @@ a communication channel." (apply 'max `,@ref)) (car counts)) "} {"))) -(defun org-e-texinfo-table--org-table (table contents info) +(defun org-texinfo-table--org-table (table contents info) "Return appropriate Texinfo code for an Org table. TABLE is the table type element to transcode. CONTENTS is its @@ -1582,7 +1564,7 @@ This function assumes TABLE has `org' as its `:type' attribute." (format "@columnfractions %s" col-width) (format "{%s}" - (org-e-texinfo-table-column-widths + (org-texinfo-table-column-widths table info))))) ;; Prepare the final format string for the table. (cond @@ -1593,7 +1575,7 @@ This function assumes TABLE has `org' as its `:type' attribute." columns contents)))))) -(defun org-e-texinfo-table--table.el-table (table contents info) +(defun org-texinfo-table--table.el-table (table contents info) "Returns nothing. Rather than return an invalid table, nothing is returned." @@ -1601,16 +1583,16 @@ Rather than return an invalid table, nothing is returned." ;;; Table Cell -(defun org-e-texinfo-table-cell (table-cell contents info) +(defun org-texinfo-table-cell (table-cell contents info) "Transcode a TABLE-CELL element from Org to Texinfo. CONTENTS is the cell contents. INFO is a plist used as a communication channel." (concat (if (and contents - org-e-texinfo-table-scientific-notation + org-texinfo-table-scientific-notation (string-match orgtbl-exp-regexp contents)) ;; Use appropriate format string for scientific ;; notation. - (format org-e-texinfo-table-scientific-notation + (format org-texinfo-table-scientific-notation (match-string 1 contents) (match-string 2 contents)) contents) @@ -1618,18 +1600,30 @@ a communication channel." ;;; Table Row -(defun org-e-texinfo-table-row (table-row contents info) +(defun org-texinfo-table-row (table-row contents info) "Transcode a TABLE-ROW element from Org to Texinfo. CONTENTS is the contents of the row. INFO is a plist used as a communication channel." ;; Rules are ignored since table separators are deduced from ;; borders of the current row. (when (eq (org-element-property :type table-row) 'standard) - (concat "@item " contents "\n"))) + (let ((rowgroup-tag + (cond + ;; Case 1: Belongs to second or subsequent rowgroup. + ((not (= 1 (org-export-table-row-group table-row info))) + "@item ") + ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups. + ((org-export-table-has-header-p + (org-export-get-parent-table table-row) info) + "@headitem ") + ;; Case 3: Row is from first and only row group. + (t "@item ")))) + (when (eq (org-element-property :type table-row) 'standard) + (concat rowgroup-tag contents "\n"))))) ;;; Target -(defun org-e-texinfo-target (target contents info) +(defun org-texinfo-target (target contents info) "Transcode a TARGET object from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1638,33 +1632,30 @@ information." ;;; Timestamp -(defun org-e-texinfo-timestamp (timestamp contents info) +(defun org-texinfo-timestamp (timestamp contents info) "Transcode a TIMESTAMP object from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." - (let ((value (org-translate-time (org-element-property :value timestamp))) - (type (org-element-property :type timestamp))) - (cond ((memq type '(active active-range)) - (format org-e-texinfo-active-timestamp-format value)) - ((memq type '(inactive inactive-range)) - (format org-e-texinfo-inactive-timestamp-format value)) - (t (format org-e-texinfo-diary-timestamp-format value))))) - -;;; Underline -;; -;; Underline is ignored + (let ((value (org-texinfo-plain-text + (org-timestamp-translate timestamp) info))) + (case (org-element-property :type timestamp) + ((active active-range) + (format org-texinfo-active-timestamp-format value)) + ((inactive inactive-range) + (format org-texinfo-inactive-timestamp-format value)) + (t (format org-texinfo-diary-timestamp-format value))))) ;;; Verbatim -(defun org-e-texinfo-verbatim (verbatim contents info) +(defun org-texinfo-verbatim (verbatim contents info) "Transcode a VERBATIM object from Org to Texinfo. CONTENTS is nil. INFO is a plist used as a communication channel." - (org-e-texinfo--text-markup (org-element-property :value verbatim) 'verbatim)) + (org-texinfo--text-markup (org-element-property :value verbatim) 'verbatim)) ;;; Verse Block -(defun org-e-texinfo-verse-block (verse-block contents info) +(defun org-texinfo-verse-block (verse-block contents info) "Transcode a VERSE-BLOCK element from Org to Texinfo. CONTENTS is verse block contents. INFO is a plist holding contextual information." @@ -1686,8 +1677,8 @@ contextual information." ;;; Interactive functions -(defun org-e-texinfo-export-to-texinfo - (&optional subtreep visible-only body-only ext-plist pub-dir) +(defun org-texinfo-export-to-texinfo + (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to a Texinfo file. If narrowing is active in the current buffer, only export its @@ -1695,6 +1686,10 @@ narrowed part. If a region is active, export that region. +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + When optional argument SUBTREEP is non-nil, export the sub-tree at point, extracting information from the headline properties first. @@ -1709,17 +1704,24 @@ EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to file-local settings. -When optional argument PUB-DIR is set, use it as the publishing -directory. - Return output file's name." (interactive) - (let ((outfile (org-export-output-file-name ".texi" subtreep pub-dir))) - (org-export-to-file - 'e-texinfo outfile subtreep visible-only body-only ext-plist))) + (let ((outfile (org-export-output-file-name ".texi" subtreep)) + (org-export-coding-system org-texinfo-coding-system)) + (if async + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'texinfo)) + (let ((org-export-coding-system org-texinfo-coding-system)) + `(expand-file-name + (org-export-to-file + 'texinfo ,outfile ,subtreep ,visible-only ,body-only + ',ext-plist)))) + (let ((org-export-coding-system org-texinfo-coding-system)) + (org-export-to-file + 'texinfo outfile subtreep visible-only body-only ext-plist))))) -(defun org-e-texinfo-export-to-info - (&optional subtreep visible-only body-only ext-plist pub-dir) +(defun org-texinfo-export-to-info + (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to Texinfo then process through to INFO. If narrowing is active in the current buffer, only export its @@ -1727,6 +1729,10 @@ narrowed part. If a region is active, export that region. +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + When optional argument SUBTREEP is non-nil, export the sub-tree at point, extracting information from the headline properties first. @@ -1746,64 +1752,100 @@ directory. Return INFO file's name." (interactive) - (org-e-texinfo-compile - (org-e-texinfo-export-to-texinfo - subtreep visible-only body-only ext-plist pub-dir))) + (if async + (let ((outfile (org-export-output-file-name ".texi" subtreep)) + (org-export-coding-system org-texinfo-coding-system)) + (org-export-async-start + (lambda (f) (org-export-add-to-stack f 'texinfo)) + (let ((org-export-coding-system org-texinfo-coding-system)) + `(expand-file-name + (org-texinfo-compile + (org-export-to-file + 'texinfo ,outfile ,subtreep ,visible-only ,body-only + ',ext-plist)))))) + (org-texinfo-compile + (let ((org-export-coding-system org-texinfo-coding-system)) + (org-texinfo-export-to-texinfo + nil subtreep visible-only body-only ext-plist))))) -(defun org-e-texinfo-compile (texifile) +;;;###autoload +(defun org-texinfo-publish-to-texinfo (plist filename pub-dir) + "Publish an org file to Texinfo. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'texinfo filename ".texi" plist pub-dir)) + +;;;###autoload +(defun org-texinfo-convert-region-to-texinfo () + "Assume the current region has org-mode syntax, and convert it to Texinfo. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in an Texinfo buffer and use +this command to convert it." + (interactive) + (org-export-replace-region-by 'texinfo)) + +(defun org-texinfo-compile (file) "Compile a texinfo file. -TEXIFILE is the name of the file being compiled. Processing is -done through the command specified in `org-e-texinfo-info-process'. +FILE is the name of the file being compiled. Processing is +done through the command specified in `org-texinfo-info-process'. Return INFO file name or an error if it couldn't be produced." - (let* ((wconfig (current-window-configuration)) - (texifile (file-truename texifile)) - (base (file-name-sans-extension texifile)) + (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) + (full-name (file-truename file)) + (out-dir (file-name-directory file)) + ;; Make sure `default-directory' is set to FILE directory, + ;; not to whatever value the current buffer may have. + (default-directory (file-name-directory full-name)) errors) - (message (format "Processing Texinfo file %s ..." texifile)) - (unwind-protect - (progn - (cond - ;; A function is provided: Apply it. - ((functionp org-e-texinfo-info-process) - (funcall org-e-texinfo-info-process (shell-quote-argument texifile))) - ;; A list is provided: Replace %b, %f and %o with appropriate - ;; values in each command before applying it. Output is - ;; redirected to "*Org INFO Texinfo Output*" buffer. - ((consp org-e-texinfo-info-process) - (let* ((out-dir (or (file-name-directory texifile) "./")) - (outbuf (get-buffer-create "*Org Info Texinfo Output*"))) - (mapc - (lambda (command) - (shell-command - (replace-regexp-in-string - "%b" (shell-quote-argument base) - (replace-regexp-in-string - "%f" (shell-quote-argument texifile) - (replace-regexp-in-string - "%o" (shell-quote-argument out-dir) command t t) t t) t t) - outbuf)) - org-e-texinfo-info-process) - ;; Collect standard errors from output buffer. - (setq errors (org-e-texinfo-collect-errors outbuf)))) - (t (error "No valid command to process to Info"))) - (let ((infofile (concat base ".info"))) - ;; Check for process failure. Provide collected errors if - ;; possible. - (if (not (file-exists-p infofile)) - (error (concat (format "INFO file %s wasn't produced" infofile) - (when errors (concat ": " errors)))) - ;; Else remove log files, when specified, and signal end of - ;; process to user, along with any error encountered. - (message (concat "Process completed" - (if (not errors) "." - (concat " with errors: " errors))))) - ;; Return output file name. - infofile)) - (set-window-configuration wconfig)))) + (message (format "Processing Texinfo file %s..." file)) + (save-window-excursion + (cond + ;; A function is provided: Apply it. + ((functionp org-texinfo-info-process) + (funcall org-texinfo-info-process (shell-quote-argument file))) + ;; A list is provided: Replace %b, %f and %o with appropriate + ;; values in each command before applying it. Output is + ;; redirected to "*Org INFO Texinfo Output*" buffer. + ((consp org-texinfo-info-process) + (let ((outbuf (get-buffer-create "*Org INFO Texinfo Output*"))) + (mapc + (lambda (command) + (shell-command + (replace-regexp-in-string + "%b" (shell-quote-argument base-name) + (replace-regexp-in-string + "%f" (shell-quote-argument full-name) + (replace-regexp-in-string + "%o" (shell-quote-argument out-dir) command t t) t t) t t) + outbuf)) + org-texinfo-info-process) + ;; Collect standard errors from output buffer. + (setq errors (org-texinfo-collect-errors outbuf)))) + (t (error "No valid command to process to Info"))) + (let ((infofile (concat out-dir base-name ".info"))) + ;; Check for process failure. Provide collected errors if + ;; possible. + (if (not (file-exists-p infofile)) + (error (concat (format "INFO file %s wasn't produced" infofile) + (when errors (concat ": " errors)))) + ;; Else remove log files, when specified, and signal end of + ;; process to user, along with any error encountered. + (when org-texinfo-remove-logfiles + (dolist (ext org-texinfo-logfiles-extensions) + (let ((file (concat out-dir base-name "." ext))) + (when (file-exists-p file) (delete-file file))))) + (message (concat "Process completed" + (if (not errors) "." + (concat " with errors: " errors))))) + ;; Return output file name. + infofile)))) -(defun org-e-texinfo-collect-errors (buffer) +(defun org-texinfo-collect-errors (buffer) "Collect some kind of errors from \"makeinfo\" command output. BUFFER is the buffer containing output. @@ -1819,7 +1861,7 @@ none." (errors "")) (when (save-excursion (re-search-forward "perhaps incorrect sectioning?" nil t)) - (setq errors (concat errors " [incorrect sectionnng]"))) + (setq errors (concat errors " [incorrect sectioning]"))) (when (save-excursion (re-search-forward "missing close brace" nil t)) (setq errors (concat errors " [syntax error]"))) @@ -1840,5 +1882,11 @@ none." (setq errors (concat errors " [syntax error]"))) (and (org-string-nw-p errors) (org-trim errors))))))) -(provide 'org-e-texinfo) -;;; org-e-texinfo.el ends here + +(provide 'ox-texinfo) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-texinfo.el ends here diff --git a/contrib/lisp/org-export.el b/lisp/ox.el similarity index 51% rename from contrib/lisp/org-export.el rename to lisp/ox.el index bcc812f77..40c9501f7 100644 --- a/contrib/lisp/org-export.el +++ b/lisp/ox.el @@ -1,22 +1,22 @@ -;;; org-export.el --- Generic Export Engine For Org +;;; ox.el --- Generic Export Engine for Org Mode ;; Copyright (C) 2012, 2013 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou ;; Keywords: outlines, hypermedia, calendar, wp -;; This program is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -48,11 +48,10 @@ ;; buffer as a string. ;; ;; An export back-end is defined with `org-export-define-backend', -;; which sets one mandatory variable: his translation table. Its name -;; is always `org-BACKEND-translate-alist' where BACKEND stands for -;; the name chosen for the back-end. 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. +;; 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 @@ -66,39 +65,30 @@ ;; customizable should belong to the `org-export-BACKEND' group. ;; ;; Tools for common tasks across back-ends are implemented in the -;; penultimate part of this file. A dispatcher for standard back-ends -;; is provided in the last one. +;; following part of the file. +;; +;; Then, a wrapper macro for asynchronous export, +;; `org-export-async-start', along with tools to display results. are +;; given in the penultimate part. +;; +;; Eventually, a dispatcher (`org-export-dispatch') for standard +;; back-ends is provided in the last one. ;;; Code: (eval-when-compile (require 'cl)) (require 'org-element) +(require 'org-macro) +(require 'ob-exp) +(declare-function org-publish "ox-publish" (project &optional force async)) +(declare-function org-publish-all "ox-publish" (&optional force async)) +(declare-function + org-publish-current-file "ox-publish" (&optional force async)) +(declare-function org-publish-current-project "ox-publish" + (&optional force async)) -(declare-function org-e-ascii-export-as-ascii "org-e-ascii" - (&optional subtreep visible-only body-only ext-plist)) -(declare-function org-e-ascii-export-to-ascii "org-e-ascii" - (&optional subtreep visible-only body-only ext-plist pub-dir)) -(declare-function org-e-html-export-as-html "org-e-html" - (&optional subtreep visible-only body-only ext-plist)) -(declare-function org-e-html-export-to-html "org-e-html" - (&optional subtreep visible-only body-only ext-plist pub-dir)) -(declare-function org-e-latex-export-as-latex "org-e-latex" - (&optional subtreep visible-only body-only ext-plist)) -(declare-function org-e-latex-export-to-latex "org-e-latex" - (&optional subtreep visible-only body-only ext-plist pub-dir)) -(declare-function org-e-latex-export-to-pdf "org-e-latex" - (&optional subtreep visible-only body-only ext-plist pub-dir)) -(declare-function org-e-odt-export-to-odt "org-e-odt" - (&optional subtreep visible-only body-only ext-plist pub-dir)) -(declare-function org-e-publish "org-e-publish" (project &optional force)) -(declare-function org-e-publish-all "org-e-publish" (&optional force)) -(declare-function org-e-publish-current-file "org-e-publish" (&optional force)) -(declare-function org-e-publish-current-project "org-e-publish" - (&optional force)) -(declare-function org-export-blocks-preprocess "org-exp-blocks") - -(defvar org-e-publish-project-alist) +(defvar org-publish-project-alist) (defvar org-table-number-fraction) (defvar org-table-number-regexp) @@ -132,6 +122,7 @@ (:with-author nil "author" org-export-with-author) (:with-clocks nil "c" org-export-with-clocks) (:with-creator nil "creator" org-export-with-creator) + (:with-date nil "date" org-export-with-date) (:with-drawers nil "d" org-export-with-drawers) (:with-email nil "email" org-export-with-email) (:with-emphasize nil "*" org-export-with-emphasize) @@ -139,9 +130,12 @@ (:with-fixed-width nil ":" org-export-with-fixed-width) (:with-footnotes nil "f" org-export-with-footnotes) (:with-inlinetasks nil "inline" org-export-with-inlinetasks) - (:with-plannings nil "p" org-export-with-planning) + (:with-latex nil "tex" org-export-with-latex) + (:with-planning nil "p" org-export-with-planning) (:with-priority nil "pri" org-export-with-priority) + (:with-smart-quotes nil "'" org-export-with-smart-quotes) (:with-special-strings nil "-" org-export-with-special-strings) + (:with-statistics-cookies nil "stat" org-export-with-statistics-cookies) (:with-sub-superscript nil "^" org-export-with-sub-superscripts) (:with-toc nil "toc" org-export-with-toc) (:with-tables nil "|" org-export-with-tables) @@ -156,12 +150,12 @@ like (KEYWORD OPTION DEFAULT BEHAVIOUR) where: KEYWORD is a string representing a buffer keyword, or nil. Each property defined this way can also be set, during subtree - export, through an headline property named after the keyword + export, through a headline property named after the keyword with the \"EXPORT_\" prefix (i.e. DATE keyword and EXPORT_DATE property). OPTION is a string that could be found in an #+OPTIONS: line. DEFAULT is the default value for the property. -BEHAVIOUR determine how Org should handle multiple keywords for +BEHAVIOUR determines how Org should handle multiple keywords for the same property. It is a symbol among: nil Keep old value and discard the new one. t Replace old value with the new one. @@ -171,14 +165,14 @@ BEHAVIOUR determine how Org should handle multiple keywords for `split' Split values at white spaces, and cons them to the previous list. -KEYWORD and OPTION have precedence over DEFAULT. +Values set through KEYWORD and OPTION have precedence over +DEFAULT. All these properties should be back-end agnostic. Back-end specific properties are set through `org-export-define-backend'. Properties redefined there have precedence over these.") -(defconst org-export-special-keywords - '("SETUP_FILE" "OPTIONS" "MACRO") +(defconst org-export-special-keywords '("FILETAGS" "SETUPFILE" "OPTIONS") "List of in-buffer keywords that require special treatment. These keywords are not directly associated to a property. The way they are handled must be hard-coded into @@ -192,6 +186,7 @@ way they are handled must be hard-coded into (:filter-code . org-export-filter-code-functions) (:filter-comment . org-export-filter-comment-functions) (:filter-comment-block . org-export-filter-comment-block-functions) + (:filter-diary-sexp . org-export-filter-diary-sexp-functions) (:filter-drawer . org-export-filter-drawer-functions) (:filter-dynamic-block . org-export-filter-dynamic-block-functions) (:filter-entity . org-export-filter-entity-functions) @@ -214,7 +209,8 @@ way they are handled must be hard-coded into (:filter-latex-fragment . org-export-filter-latex-fragment-functions) (:filter-line-break . org-export-filter-line-break-functions) (:filter-link . org-export-filter-link-functions) - (:filter-macro . org-export-filter-macro-functions) + (:filter-node-property . org-export-filter-node-property-functions) + (:filter-options . org-export-filter-options-functions) (:filter-paragraph . org-export-filter-paragraph-functions) (:filter-parse-tree . org-export-filter-parse-tree-functions) (:filter-plain-list . org-export-filter-plain-list-functions) @@ -265,6 +261,45 @@ whose extension is either \"png\", \"jpeg\", \"jpg\", \"gif\", See `org-export-inline-image-p' for more information about rules.") +(defvar org-export-async-debug nil + "Non-nil means asynchronous export process should leave data behind. + +This data is found in the appropriate \"*Org Export Process*\" +buffer, and in files prefixed with \"org-export-process\" and +located in `temporary-file-directory'. + +When non-nil, it will also set `debug-on-error' to a non-nil +value in the external process.") + +(defvar org-export-stack-contents nil + "Record asynchronously generated export results and processes. +This is an alist: its CAR is the source of the +result (destination file or buffer for a finished process, +original buffer for a running one) and its CDR is a list +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 + "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.") + +(defvar org-export-dispatch-last-action nil + "Last command called from the dispatcher. +The value should be a list. Its CAR is the action, as a symbol, +and its CDR is a list of export options.") + +(defvar org-export-dispatch-last-position (make-marker) + "The position where the last export command was created using the dispatcher. +This marker will be used with `C-u C-c C-e' to make sure export repetition +uses the same subtree if the previous command was restricted to a subtree.") ;;; User-configurable Variables @@ -293,7 +328,7 @@ nil Do not export, pretend this tree is not present. t Do export the entire tree. `headline' Only export the headline, but skip the tree below it. -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"arch:nil\"." :group 'org-export-general :type '(choice @@ -303,14 +338,14 @@ e.g. \"arch:nil\"." (defcustom org-export-with-author t "Non-nil means insert author name into the exported file. -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"author:nil\"." :group 'org-export-general :type 'boolean) (defcustom org-export-with-clocks nil "Non-nil means export CLOCK keywords. -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"c:t\"." :group 'org-export-general :type 'boolean) @@ -328,45 +363,76 @@ If the value is `comment' insert it as a comment." (const :tag "Sentence as a comment" 'comment) (const :tag "Insert the sentence" t))) +(defcustom org-export-with-date t + "Non-nil means insert date in the exported document. +This option can also be set with the OPTIONS keyword, +e.g. \"date:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-date-timestamp-format nil + "Time-stamp format string to use for DATE keyword. + +The format string, when specified, only applies if date consists +in a single time-stamp. Otherwise its value will be ignored. + +See `format-time-string' for details on how to build this +string." + :group 'org-export-general + :type '(choice + (string :tag "Time-stamp format string") + (const :tag "No format string" nil))) + (defcustom org-export-creator-string - (format "Generated by Org mode %s in Emacs %s." - (if (fboundp 'org-version) (org-version) "(Unknown)") - emacs-version) - "String to insert at the end of the generated document." + (format "Emacs %s (Org mode %s)" + emacs-version + (if (fboundp 'org-version) (org-version) "unknown version")) + "Information about the creator of the document. +This option can also be set on with the CREATOR keyword." :group 'org-export-general :type '(string :tag "Creator string")) -(defcustom org-export-with-drawers t +(defcustom org-export-with-drawers '(not "LOGBOOK") "Non-nil means export contents of standard drawers. When t, all drawers are exported. This may also be a list of -drawer names to export. This variable doesn't apply to -properties drawers. +drawer names to export. If that list starts with `not', only +drawers with such names will be ignored. -This option can also be set with the #+OPTIONS line, +This variable doesn't apply to properties drawers. + +This option can also be set with the OPTIONS keyword, e.g. \"d:nil\"." :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") :type '(choice (const :tag "All drawers" t) (const :tag "None" nil) (repeat :tag "Selected drawers" - (string :tag "Drawer name")))) + (string :tag "Drawer name")) + (list :tag "Ignored drawers" + (const :format "" not) + (repeat :tag "Specify names of drawers to ignore during export" + :inline t + (string :tag "Drawer name"))))) (defcustom org-export-with-email nil "Non-nil means insert author email into the exported file. -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"email:t\"." :group 'org-export-general :type 'boolean) (defcustom org-export-with-emphasize t - "Non-nil means interpret *word*, /word/, and _word_ as emphasized text. + "Non-nil means interpret *word*, /word/, _word_ and +word+. If the export target supports emphasizing text, the word will be -typeset in bold, italic, or underlined, respectively. Not all -export backends support this. +typeset in bold, italic, with an underline or strike-through, +respectively. -This option can also be set with the #+OPTIONS line, e.g. \"*:nil\"." +This option can also be set with the OPTIONS keyword, +e.g. \"*:nil\"." :group 'org-export-general :type 'boolean) @@ -377,7 +443,7 @@ All trees carrying any of these tags will be excluded from export. This is without condition, so even subtrees inside that carry one of the `org-export-select-tags' will be removed. -This option can also be set with the #+EXCLUDE_TAGS: keyword." +This option can also be set with the EXCLUDE_TAGS keyword." :group 'org-export-general :type '(repeat (string :tag "Tag"))) @@ -392,39 +458,57 @@ etc. For example: will be looking just like this in also HTML. See also the QUOTE keyword. Not all export backends support this. -This option can also be set with the #+OPTIONS line, e.g. \"::nil\"." - :group 'org-export-translation +This option can also be set with the OPTIONS keyword, +e.g. \"::nil\"." + :group 'org-export-general :type 'boolean) (defcustom org-export-with-footnotes t "Non-nil means Org footnotes should be exported. -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"f:nil\"." :group 'org-export-general :type 'boolean) +(defcustom org-export-with-latex t + "Non-nil means process LaTeX environments and fragments. + +This option can also be set with the OPTIONS line, +e.g. \"tex:verbatim\". Allowed values are: + +nil Ignore math snippets. +`verbatim' Keep everything in verbatim. +t Allow export of math snippets." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not process math in any way" nil) + (const :tag "Interpret math snippets" t) + (const :tag "Leave math verbatim" verbatim))) + (defcustom org-export-headline-levels 3 "The last level which is still exported as a headline. -Inferior levels will produce itemize lists when exported. +Inferior levels will usually produce itemize or enumerate lists +when exported, but back-end behaviour may differ. -This option can also be set with the #+OPTIONS line, e.g. \"H:2\"." +This option can also be set with the OPTIONS keyword, +e.g. \"H:2\"." :group 'org-export-general :type 'integer) (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'." +`org-clock-clocktable-language-setup'. This option can also be +set with the LANGUAGE keyword." :group 'org-export-general :type '(string :tag "Language")) (defcustom org-export-preserve-breaks nil "Non-nil means preserve all line breaks when exporting. - -Normally, in HTML output paragraphs will be reformatted. - -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"\\n:t\"." :group 'org-export-general :type 'boolean) @@ -438,28 +522,36 @@ For example, HTML export converts \\alpha to α and \\AA to For a list of supported names, see the constant `org-entities' and the user option `org-entities-user'. -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"e:nil\"." :group 'org-export-general :type 'boolean) (defcustom org-export-with-inlinetasks t "Non-nil means inlinetasks should be exported. -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"inline:nil\"." :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) (defcustom org-export-with-planning nil "Non-nil means include planning info in export. -This option can also be set with the #+OPTIONS: line, + +Planning info is the line containing either SCHEDULED:, +DEADLINE:, CLOSED: time-stamps, or a combination of them. + +This option can also be set with the OPTIONS keyword, e.g. \"p:t\"." :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) (defcustom org-export-with-priority nil "Non-nil means include priority cookies in export. -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"pri:t\"." :group 'org-export-general :type 'boolean) @@ -470,7 +562,7 @@ e.g. \"pri:t\"." When set to an integer n, numbering will only happen for headlines whose relative level is higher or equal to n. -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"num:t\"." :group 'org-export-general :type 'boolean) @@ -483,27 +575,51 @@ one of these tags will be ignored during export. Inside trees that are selected like this, you can still deselect a subtree by tagging it with one of the `org-export-exclude-tags'. -This option can also be set with the #+SELECT_TAGS: keyword." +This option can also be set with the SELECT_TAGS keyword." :group 'org-export-general :type '(repeat (string :tag "Tag"))) +(defcustom org-export-with-smart-quotes nil + "Non-nil means activate smart quotes during export. +This option can also be set with the OPTIONS keyword, +e.g., \"':t\". + +When setting this to non-nil, you need to take care of +using the correct Babel package when exporting to LaTeX. +E.g., you can load Babel for french like this: + +#+LATEX_HEADER: \\usepackage[french]{babel}" + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + (defcustom org-export-with-special-strings t - "Non-nil means interpret \"\-\", \"--\" and \"---\" for export. + "Non-nil means interpret \"\\-\", \"--\" and \"---\" for export. When this option is turned on, these strings will be exported as: - Org HTML LaTeX - -----+----------+-------- - \\- ­ \\- - -- – -- - --- — --- - ... … \ldots + Org HTML LaTeX UTF-8 + -----+----------+--------+------- + \\- ­ \\- + -- – -- – + --- — --- — + ... … \\ldots … -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"-:nil\"." :group 'org-export-general :type 'boolean) +(defcustom org-export-with-statistics-cookies t + "Non-nil means include statistics cookies in export. +This option can also be set with the OPTIONS keyword, +e.g. \"stat:nil\"" + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + (defcustom org-export-with-sub-superscripts t "Non-nil means interpret \"_\" and \"^\" for export. @@ -525,7 +641,7 @@ the sub/superscript. If you set this variable to the symbol interpretations as sub/superscript. This can be helpful in documents that need \"_\" frequently in plain text. -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"^:nil\"." :group 'org-export-general :type '(choice @@ -543,7 +659,7 @@ up to N in the toc, this may then be different from larger than the number of headline levels. When nil, no table of contents is made. -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"toc:nil\" or \"toc:3\"." :group 'org-export-general :type '(choice @@ -559,7 +675,8 @@ For example: |-------------+----------+-----------| | Arthur Dent | England | 29.2.2100 | -This option can also be set with the #+OPTIONS line, e.g. \"|:nil\"." +This option can also be set with the OPTIONS keyword, +e.g. \"|:nil\"." :group 'org-export-general :type 'boolean) @@ -570,7 +687,7 @@ If this is the symbol `not-in-toc', tags will be removed from table of contents entries, but still be shown in the headlines of the document. -This option can also be set with the #+OPTIONS line, +This option can also be set with the OPTIONS keyword, e.g. \"tags:nil\"." :group 'org-export-general :type '(choice @@ -580,12 +697,16 @@ e.g. \"tags:nil\"." (defcustom org-export-with-tasks t "Non-nil means include TODO items for export. + This may have the following values: t include tasks independent of state. -todo include only tasks that are not yet done. -done include only tasks that are already done. -nil remove all tasks before export -list of keywords keep only tasks with these keywords" +`todo' include only tasks that are not yet done. +`done' include only tasks that are already done. +nil ignore all tasks. +list of keywords include tasks with these keywords. + +This option can also be set with the OPTIONS keyword, +e.g. \"tasks:nil\"." :group 'org-export-general :type '(choice (const :tag "All tasks" t) @@ -597,21 +718,25 @@ list of keywords keep only tasks with these keywords" (defcustom org-export-time-stamp-file t "Non-nil means insert a time stamp into the exported file. -The time stamp shows when the file was created. - -This option can also be set with the #+OPTIONS line, -e.g. \"timestamp:nil\"." +The time stamp shows when the file was created. This option can +also be set with the OPTIONS keyword, e.g. \"timestamp:nil\"." :group 'org-export-general :type 'boolean) (defcustom org-export-with-timestamps t "Non nil means allow timestamps in export. -It can be set to `active', `inactive', t or nil, in order to -export, respectively, only active timestamps, only inactive ones, -all of them or none. +It can be set to any of the following values: + t export all timestamps. + `active' export active timestamps only. + `inactive' export inactive timestamps only. + nil do not export timestamps -This option can also be set with the #+OPTIONS line, e.g. +This only applies to timestamps isolated in a paragraph +containing only timestamps. Other timestamps are always +exported. + +This option can also be set with the OPTIONS keyword, e.g. \"<:nil\"." :group 'org-export-general :type '(choice @@ -622,43 +747,50 @@ This option can also be set with the #+OPTIONS line, e.g. (defcustom org-export-with-todo-keywords t "Non-nil means include TODO keywords in export. -When nil, remove all these keywords from the export." +When nil, remove all these keywords from the export. This option +can also be set with the OPTIONS keyword, e.g. \"todo:nil\"." :group 'org-export-general :type 'boolean) -(defcustom org-export-allow-BIND 'confirm - "Non-nil means allow #+BIND to define local variable values for export. -This is a potential security risk, which is why the user must -confirm the use of these lines." +(defcustom org-export-allow-bind-keywords nil + "Non-nil means BIND keywords can define local variable values. +This is a potential security risk, which is why the default value +is nil. You can also allow them through local buffer variables." :group 'org-export-general - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "Ask a confirmation for each file" confirm))) + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) (defcustom org-export-snippet-translation-alist nil "Alist between export snippets back-ends and exporter back-ends. This variable allows to provide shortcuts for export snippets. -For example, with a value of '\(\(\"h\" . \"e-html\"\)\), the +For example, with a value of '\(\(\"h\" . \"html\"\)\), the HTML back-end will recognize the contents of \"@@h:@@\" as HTML code while every other back-end will ignore it." :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") :type '(repeat - (cons - (string :tag "Shortcut") - (string :tag "Back-end")))) + (cons (string :tag "Shortcut") + (string :tag "Back-end")))) (defcustom org-export-coding-system nil "Coding system for the exported file." :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") :type 'coding-system) -(defcustom org-export-copy-to-kill-ring t - "Non-nil means exported stuff will also be pushed onto the kill ring." +(defcustom org-export-copy-to-kill-ring 'if-interactive + "Should we push exported content to the kill ring?" :group 'org-export-general - :type 'boolean) + :version "24.3" + :type '(choice + (const :tag "Always" t) + (const :tag "When export is done interactively" if-interactive) + (const :tag "Never" nil))) (defcustom org-export-initial-scope 'buffer "The initial scope when exporting with `org-export-dispatch'. @@ -678,22 +810,74 @@ these cases." :group 'org-export-general :type 'boolean) +(defcustom org-export-in-background nil + "Non-nil means export and publishing commands will run in background. +Results from an asynchronous export are never displayed +automatically. But you can retrieve them with \\[org-export-stack]." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-async-init-file user-init-file + "File used to initialize external export process. +Value must be an absolute file name. It defaults to user's +initialization file. Though, a specific configuration makes the +process faster and the export more portable." + :group 'org-export-general + :version "24.4" + :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 -for current export scope is added to the prompt \(i.e. \"b\" when +for current export scope is added to the prompt (\"b\" when output is restricted to body only, \"s\" when it is restricted to -the current subtree and \"v\" when only visible elements are -considered for export\). Also, \[?] allows to switch back to -standard mode." +the current subtree, \"v\" when only visible elements are +considered for export, \"f\" when publishing functions should be +passed the FORCE argument and \"a\" when the export should be +asynchronous). Also, \[?] allows to switch back to standard +mode." :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) -;;; Defining New Back-ends +;;; 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. +;; +;; 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'. +;; +;; Eventually `org-export-barf-if-invalid-backend' returns an error +;; when a given back-end hasn't been registered yet. -(defmacro org-export-define-backend (backend translators &rest body) +(defun org-export-define-backend (backend translators &rest body) "Define a new back-end BACKEND. TRANSLATORS is an alist between object or element types and @@ -716,13 +900,15 @@ string, the type will be ignored, but the blank lines or white spaces will be kept. In addition to element and object types, one function can be -associated to the `template' symbol and another one to the -`plain-text' symbol. +associated to the `template' (or `inner-template') symbol and +another one to the `plain-text' symbol. The former returns the final transcoded string, and can be used to add a preamble and a postamble to document's body. It must accept two arguments: the transcoded string and the property list -containing export options. +containing export options. A function associated to `template' +will not be applied if export has option \"body-only\". +A function associated to `inner-template' is always applied. The latter, when defined, is to be called on every text not recognized as an element or an object. It must accept two @@ -749,72 +935,68 @@ keywords are understood: shouldn't make a back-end test, as it may prevent back-ends derived from this one to behave properly. + :menu-entry + + Menu entry for the export dispatcher. It should be a list + like: + + '(KEY DESCRIPTION-OR-ORDINAL ACTION-OR-MENU) + + where : + + KEY is a free character selecting the back-end. + + DESCRIPTION-OR-ORDINAL is either a string or a number. + + If it is a string, is will be used to name the back-end in + its menu entry. If it is a number, the following menu will + be displayed as a sub-menu of the back-end with the same + KEY. Also, the number will be used to determine in which + order such sub-menus will appear (lowest first). + + ACTION-OR-MENU is either a function or an alist. + + If it is an action, it will be called with four + arguments (booleans): ASYNC, SUBTREEP, VISIBLE-ONLY and + BODY-ONLY. See `org-export-as' for further explanations on + some of them. + + If it is an alist, associations should follow the + pattern: + + '(KEY DESCRIPTION ACTION) + + where KEY, DESCRIPTION and ACTION are described above. + + Valid values include: + + '(?m \"My Special Back-end\" my-special-export-function) + + or + + '(?l \"Export to LaTeX\" + \(?p \"As PDF file\" org-latex-export-to-pdf) + \(?o \"As PDF file and open\" + \(lambda (a s v b) + \(if a (org-latex-export-to-pdf t s v b) + \(org-open-file + \(org-latex-export-to-pdf nil s v b))))))) + + or the following, which will be added to the previous + sub-menu, + + '(?l 1 + \((?B \"As TEX buffer (Beamer)\" org-beamer-export-as-latex) + \(?P \"As PDF file (Beamer)\" org-beamer-export-to-pdf))) + :options-alist Alist between back-end specific properties introduced in communication channel and how their value are acquired. See `org-export-options-alist' for more information about - structure of the values. - -As an example, here is how the `e-ascii' back-end is defined: - -\(org-export-define-backend e-ascii - \((bold . org-e-ascii-bold) - \(center-block . org-e-ascii-center-block) - \(clock . org-e-ascii-clock) - \(code . org-e-ascii-code) - \(drawer . org-e-ascii-drawer) - \(dynamic-block . org-e-ascii-dynamic-block) - \(entity . org-e-ascii-entity) - \(example-block . org-e-ascii-example-block) - \(export-block . org-e-ascii-export-block) - \(export-snippet . org-e-ascii-export-snippet) - \(fixed-width . org-e-ascii-fixed-width) - \(footnote-definition . org-e-ascii-footnote-definition) - \(footnote-reference . org-e-ascii-footnote-reference) - \(headline . org-e-ascii-headline) - \(horizontal-rule . org-e-ascii-horizontal-rule) - \(inline-src-block . org-e-ascii-inline-src-block) - \(inlinetask . org-e-ascii-inlinetask) - \(italic . org-e-ascii-italic) - \(item . org-e-ascii-item) - \(keyword . org-e-ascii-keyword) - \(latex-environment . org-e-ascii-latex-environment) - \(latex-fragment . org-e-ascii-latex-fragment) - \(line-break . org-e-ascii-line-break) - \(link . org-e-ascii-link) - \(macro . org-e-ascii-macro) - \(paragraph . org-e-ascii-paragraph) - \(plain-list . org-e-ascii-plain-list) - \(plain-text . org-e-ascii-plain-text) - \(planning . org-e-ascii-planning) - \(property-drawer . org-e-ascii-property-drawer) - \(quote-block . org-e-ascii-quote-block) - \(quote-section . org-e-ascii-quote-section) - \(radio-target . org-e-ascii-radio-target) - \(section . org-e-ascii-section) - \(special-block . org-e-ascii-special-block) - \(src-block . org-e-ascii-src-block) - \(statistics-cookie . org-e-ascii-statistics-cookie) - \(strike-through . org-e-ascii-strike-through) - \(subscript . org-e-ascii-subscript) - \(superscript . org-e-ascii-superscript) - \(table . org-e-ascii-table) - \(table-cell . org-e-ascii-table-cell) - \(table-row . org-e-ascii-table-row) - \(target . org-e-ascii-target) - \(template . org-e-ascii-template) - \(timestamp . org-e-ascii-timestamp) - \(underline . org-e-ascii-underline) - \(verbatim . org-e-ascii-verbatim) - \(verse-block . org-e-ascii-verse-block)) - :export-block \"ASCII\" - :filters-alist ((:filter-headline . org-e-ascii-filter-headline-blank-lines) - \(:filter-section . org-e-ascii-filter-headline-blank-lines)) - :options-alist ((:ascii-charset nil nil org-e-ascii-charset)))" - (declare (debug (&define name sexp [&rest [keywordp sexp]] defbody)) - (indent 1)) - (let (filters options export-block) + structure of the values." + (declare (indent 1)) + (let (export-block filters menu-entry options contents) (while (keywordp (car body)) (case (pop body) (:export-block (let ((names (pop body))) @@ -822,35 +1004,26 @@ As an example, here is how the `e-ascii' back-end is defined: (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)))) - `(progn - ;; Define translators. - (defvar ,(intern (format "org-%s-translate-alist" backend)) ',translators - "Alist between element or object types and translators.") - ;; Define options. - ,(when options - `(defconst ,(intern (format "org-%s-options-alist" backend)) ',options - ,(format "Alist between %s export properties and ways to set them. -See `org-export-options-alist' for more information on the -structure of the values." - backend))) - ;; Define filters. - ,(when filters - `(defconst ,(intern (format "org-%s-filters-alist" backend)) ',filters - "Alist between filters keywords and back-end specific filters. -See `org-export-filters-alist' for more information.")) - ;; 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)) - ;; Splice in the body, if any. - ,@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)))) -(defmacro org-export-define-derived-backend (child parent &rest body) +(defun org-export-define-derived-backend (child parent &rest body) "Create a new back-end as a variant of an existing one. CHILD is the name of the derived back-end. PARENT is the name of @@ -871,7 +1044,13 @@ keywords are understood: Alist of filters that will overwrite or complete filters defined in PARENT back-end. See `org-export-filters-alist' - for more a list of allowed filters. + for a list of allowed filters. + + :menu-entry + + Menu entry for the export dispatcher. See + `org-export-define-backend' for more information about the + expected value. :options-alist @@ -888,18 +1067,16 @@ keywords are understood: about transcoders. As an example, here is how one could define \"my-latex\" back-end -as a variant of `e-latex' back-end with a custom template -function: +as a variant of `latex' back-end with a custom template function: - \(org-export-define-derived-backend my-latex e-latex - :translate-alist ((template . my-latex-template-fun))) + \(org-export-define-derived-backend 'my-latex 'latex + :translate-alist '((template . my-latex-template-fun))) The back-end could then be called with, for example: \(org-export-to-buffer 'my-latex \"*Test my-latex*\")" - (declare (debug (&define name sexp [&rest [keywordp sexp]] def-body)) - (indent 2)) - (let (filters options translate export-block) + (declare (indent 2)) + (let (export-block filters menu-entry options translators contents) (while (keywordp (car body)) (case (pop body) (:export-block (let ((names (pop body))) @@ -907,46 +1084,67 @@ The back-end could then be called with, for example: (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 translate (pop body))) + (:translate-alist (setq translators (pop body))) (t (pop body)))) - `(progn - ;; 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)) - ;; Define filters. - ,(let ((parent-filters (intern (format "org-%s-filters-alist" parent)))) - (when (or (boundp parent-filters) filters) - `(defconst ,(intern (format "org-%s-filters-alist" child)) - ',(append filters - (and (boundp parent-filters) - (copy-sequence (symbol-value parent-filters)))) - "Alist between filters keywords and back-end specific filters. -See `org-export-filters-alist' for more information."))) - ;; Define options. - ,(let ((parent-options (intern (format "org-%s-options-alist" parent)))) - (when (or (boundp parent-options) options) - `(defconst ,(intern (format "org-%s-options-alist" child)) - ',(append options - (and (boundp parent-options) - (copy-sequence (symbol-value parent-options)))) - ,(format "Alist between %s export properties and ways to set them. -See `org-export-options-alist' for more information on the -structure of the values." - child)))) - ;; Define translators. - (defvar ,(intern (format "org-%s-translate-alist" child)) - ',(append translate - (copy-sequence - (symbol-value - (intern (format "org-%s-translate-alist" parent))))) - "Alist between element or object types and translators.") - ;; Splice in the body, if any. - ,@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)) @@ -967,8 +1165,7 @@ structure of the values." ;; just before export, by `org-export-collect-tree-properties'. ;; ;; Here is the full list of properties available during transcode -;; process, with their category (option, tree or local) and their -;; value type. +;; process, with their category and their value type. ;; ;; + `:author' :: Author's name. ;; - category :: option @@ -999,20 +1196,31 @@ structure of the values." ;; - category :: option ;; - type :: list of strings ;; +;; + `:export-options' :: List of export options available for current +;; process. +;; - category :: none +;; - type :: list of symbols, among `subtree', `body-only' and +;; `visible-only'. +;; ;; + `:exported-data' :: Hash table used for memoizing ;; `org-export-data'. ;; - category :: tree ;; - type :: hash table ;; +;; + `:filetags' :: List of global tags for buffer. Used by +;; `org-export-get-tags' to get tags with inheritance. +;; - category :: option +;; - type :: list of strings +;; ;; + `:footnote-definition-alist' :: Alist between footnote labels and -;; their definition, as parsed data. Only non-inlined footnotes -;; are represented in this alist. Also, every definition isn't -;; guaranteed to be referenced in the parse tree. The purpose of -;; this property is to preserve definitions from oblivion -;; (i.e. when the parse tree comes from a part of the original -;; buffer), it isn't meant for direct use in a back-end. To -;; retrieve a definition relative to a reference, use -;; `org-export-get-footnote-definition' instead. +;; their definition, as parsed data. Only non-inlined footnotes +;; are represented in this alist. Also, every definition isn't +;; guaranteed to be referenced in the parse tree. The purpose of +;; this property is to preserve definitions from oblivion +;; (i.e. when the parse tree comes from a part of the original +;; buffer), it isn't meant for direct use in a back-end. To +;; retrieve a definition relative to a reference, use +;; `org-export-get-footnote-definition' instead. ;; - category :: option ;; - type :: alist (STRING . LIST) ;; @@ -1082,12 +1290,6 @@ structure of the values." ;; - category :: option ;; - type :: list of strings ;; -;; + `:target-list' :: List of targets encountered in the parse tree. -;; This is used to partly resolve "fuzzy" links -;; (cf. `org-export-resolve-fuzzy-link'). -;; - category :: tree -;; - type :: list of strings -;; ;; + `:time-stamp-file' :: Non-nil means transcoding should insert ;; a time stamp in the output. ;; - category :: option @@ -1095,7 +1297,8 @@ structure of the values." ;; ;; + `:translate-alist' :: Alist between element and object types and ;; transcoding functions relative to the current back-end. -;; Special keys `template' and `plain-text' are also possible. +;; Special keys `inner-template', `template' and `plain-text' are +;; also possible. ;; - category :: option ;; - type :: alist (SYMBOL . FUNCTION) ;; @@ -1110,19 +1313,24 @@ structure of the values." ;; - category :: option ;; - type :: symbol (nil, t) ;; -;; + `:with-clocks' :: Non-nild means clock keywords should be exported. +;; + `:with-clocks' :: Non-nil means clock keywords should be exported. ;; - category :: option ;; - type :: symbol (nil, t) ;; -;; + `:with-creator' :: Non-nild means a creation sentence should be +;; + `:with-creator' :: Non-nil means a creation sentence should be ;; inserted at the end of the transcoded string. If the value ;; is `comment', it should be commented. ;; - category :: option ;; - type :: symbol (`comment', nil, t) ;; +;; + `:with-date' :: Non-nil means output should contain a date. +;; - category :: option +;; - type :. symbol (nil, t) +;; ;; + `:with-drawers' :: Non-nil means drawers should be exported. If ;; its value is a list of names, only drawers with such names -;; will be transcoded. +;; will be transcoded. If that list starts with `not', drawer +;; with these names will be skipped. ;; - category :: option ;; - type :: symbol (nil, t) or list of strings ;; @@ -1146,7 +1354,13 @@ structure of the values." ;; - category :: option ;; - type :: symbol (nil, t) ;; -;; + `:with-plannings' :: Non-nil means transcoding should include +;; + `:with-latex' :: Non-nil means `latex-environment' elements and +;; `latex-fragment' objects should appear in export output. When +;; this property is set to `verbatim', they will be left as-is. +;; - category :: option +;; - type :: symbol (`verbatim', nil, t) +;; +;; + `:with-planning' :: Non-nil means transcoding should include ;; planning info. ;; - category :: option ;; - type :: symbol (nil, t) @@ -1156,6 +1370,11 @@ structure of the values." ;; - category :: option ;; - type :: symbol (nil, t) ;; +;; + `:with-smart-quotes' :: Non-nil means activate smart quotes in +;; plain text. +;; - category :: option +;; - type :: symbol (nil, t) +;; ;; + `:with-special-strings' :: Non-nil means transcoding should ;; interpret special strings in plain text. ;; - category :: option @@ -1228,8 +1447,8 @@ structure of the values." ;; `org-export--get-subtree-options' and ;; `org-export--get-inbuffer-options' ;; -;; Also, `org-export--confirm-letbind' and `org-export--install-letbind' -;; take care of the part relative to "#+BIND:" keywords. +;; Also, `org-export--install-letbind-maybe' takes care of the part +;; relative to "#+BIND:" keywords. (defun org-export-get-environment (&optional backend subtreep ext-plist) "Collect export options from the current buffer. @@ -1243,74 +1462,98 @@ done against the current sub-tree. Third optional argument EXT-PLIST is a property list with external parameters overriding Org default settings, but still inferior to file-local settings." - ;; First install #+BIND variables. - (org-export--install-letbind-maybe) + ;; First install #+BIND variables since these must be set before + ;; global options are read. + (dolist (pair (org-export--list-bound-variables)) + (org-set-local (car pair) (nth 1 pair))) ;; Get and prioritize export options... (org-combine-plists ;; ... from global variables... (org-export--get-global-options backend) - ;; ... from buffer's attributes... - (org-export--get-buffer-attributes) ;; ... from an external property list... ext-plist ;; ... from in-buffer settings... - (org-export--get-inbuffer-options - backend - (and buffer-file-name (org-remove-double-quotes buffer-file-name))) + (org-export--get-inbuffer-options backend) ;; ... and from subtree, when appropriate. (and subtreep (org-export--get-subtree-options backend)) - ;; Eventually install back-end symbol and its translation table. - `(:back-end - ,backend - :translate-alist - ,(let ((trans-alist (intern (format "org-%s-translate-alist" backend)))) - (when (boundp trans-alist) (symbol-value trans-alist)))))) + ;; Eventually add misc. properties. + (list + :back-end + backend + :translate-alist + (org-export-backend-translate-table backend) + :footnote-definition-alist + ;; Footnotes definitions must be collected in the original + ;; buffer, as there's no insurance that they will still be in + ;; the parse tree, due to possible narrowing. + (let (alist) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward org-footnote-definition-re nil t) + (let ((def (save-match-data (org-element-at-point)))) + (when (eq (org-element-type def) 'footnote-definition) + (push + (cons (org-element-property :label def) + (let ((cbeg (org-element-property :contents-begin def))) + (when cbeg + (org-element--parse-elements + cbeg (org-element-property :contents-end def) + nil nil nil nil (list 'org-data nil))))) + alist)))) + alist)) + :id-alist + ;; Collect id references. + (let (alist) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward "\\[\\[id:\\S-+?\\]" nil t) + (let ((link (org-element-context))) + (when (eq (org-element-type link) 'link) + (let* ((id (org-element-property :path link)) + (file (org-id-find-id-file id))) + (when file + (push (cons id (file-relative-name file)) alist))))))) + alist)))) (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 specific items to read, if any." (let* ((all - (append org-export-options-alist - (and backend - (let ((var (intern - (format "org-%s-options-alist" backend)))) - (and (boundp var) (eval var)))))) - ;; Build an alist between #+OPTION: item and property-name. - (alist (delq nil - (mapcar (lambda (e) - (when (nth 2 e) (cons (regexp-quote (nth 2 e)) - (car e)))) - all))) + ;; Priority is given to back-end specific options. + (append (and backend (org-export-backend-options backend)) + org-export-options-alist)) plist) - (mapc (lambda (e) - (when (string-match (concat "\\(\\`\\|[ \t]\\)" - (car e) - ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)") - options) - (setq plist (plist-put plist - (cdr e) - (car (read-from-string - (match-string 2 options))))))) - alist) + (dolist (option all) + (let ((property (car option)) + (item (nth 2 option))) + (when (and item + (not (plist-member plist property)) + (string-match (concat "\\(\\`\\|[ \t]\\)" + (regexp-quote item) + ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)") + options)) + (setq plist (plist-put plist + property + (car (read-from-string + (match-string 2 options)))))))) plist)) (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 for export. Return options as a plist." - ;; For each buffer keyword, create an headline property setting the + ;; For each buffer keyword, create a headline property setting the ;; same property in communication channel. The name for the property ;; is the keyword with "EXPORT_" appended to it. (org-with-wide-buffer (let (prop plist) - ;; Make sure point is at an heading. - (unless (org-at-heading-p) (org-back-to-heading t)) + ;; Make sure point is at a heading. + (if (org-at-heading-p) (org-up-heading-safe) (org-back-to-heading t)) ;; Take care of EXPORT_TITLE. If it isn't defined, use headline's ;; title as its fallback value. - (when (setq prop (progn (looking-at org-todo-line-regexp) - (or (save-match-data - (org-entry-get (point) "EXPORT_TITLE")) + (when (setq prop (or (org-entry-get (point) "EXPORT_TITLE") + (progn (looking-at org-todo-line-regexp) (org-match-string-no-properties 3)))) (setq plist (plist-put @@ -1321,164 +1564,146 @@ for export. Return options as a plist." (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS")) (setq plist (nconc plist (org-export--parse-option-keyword prop backend)))) - ;; Handle other keywords. + ;; Handle other keywords. TITLE keyword is excluded as it has + ;; been handled already. (let ((seen '("TITLE"))) (mapc (lambda (option) - (let ((property (nth 1 option))) - (when (and property (not (member property seen))) - (let* ((subtree-prop (concat "EXPORT_" property)) + (let ((property (car option)) + (keyword (nth 1 option))) + (when (and keyword (not (member keyword seen))) + (let* ((subtree-prop (concat "EXPORT_" keyword)) ;; Export properties are not case-sensitive. (value (let ((case-fold-search t)) (org-entry-get (point) subtree-prop)))) - (push property seen) - (when value + (push keyword seen) + (when (and value (not (plist-member plist property))) (setq plist (plist-put plist - (car option) - ;; Parse VALUE if required. - (if (member property org-element-parsed-keywords) - (org-element-parse-secondary-string - value (org-element-restriction 'keyword)) - value)))))))) - ;; Also look for both general keywords and back-end specific - ;; options if BACKEND is provided. - (append (and backend - (let ((var (intern - (format "org-%s-options-alist" backend)))) - (and (boundp var) (symbol-value var)))) + property + (cond + ;; Parse VALUE if required. + ((member keyword org-element-document-properties) + (org-element-parse-secondary-string + value (org-element-restriction 'keyword))) + ;; If BEHAVIOUR is `split' expected value is + ;; a list of strings, not a string. + ((eq (nth 4 option) 'split) (org-split-string value)) + (t value))))))))) + ;; Look for both general keywords and back-end specific + ;; options, with priority given to the latter. + (append (and backend (org-export-backend-options backend)) org-export-options-alist))) ;; Return value. plist))) -(defun org-export--get-inbuffer-options (&optional backend files) +(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 which back-end specific options should also be read in the process. -Optional argument FILES is a list of setup files names read so -far, used to avoid circular dependencies. - Assume buffer is in Org mode. Narrowing, if any, is ignored." - (org-with-wide-buffer - (goto-char (point-min)) - (let ((case-fold-search t) plist) - ;; 1. Special keywords, as in `org-export-special-keywords'. - (let ((special-re (org-make-options-regexp org-export-special-keywords))) - (while (re-search-forward special-re nil t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (let* ((key (org-element-property :key element)) - (val (org-element-property :value element)) - (prop + (let* (plist + get-options ; For byte-compiler. + (case-fold-search t) + (options (append + ;; Priority is given to back-end specific options. + (and backend (org-export-backend-options backend)) + org-export-options-alist)) + (regexp (format "^[ \t]*#\\+%s:" + (regexp-opt (nconc (delq nil (mapcar 'cadr options)) + org-export-special-keywords)))) + (find-opt + (lambda (keyword) + ;; Return property name associated to KEYWORD. + (catch 'exit + (mapc (lambda (option) + (when (equal (nth 1 option) keyword) + (throw 'exit (car option)))) + options)))) + (get-options + (lambda (&optional files plist) + ;; Recursively read keywords in buffer. FILES is a list + ;; of files read so far. PLIST is the current property + ;; list obtained. + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((key (org-element-property :key element)) + (val (org-element-property :value element))) (cond - ((string= key "SETUP_FILE") - (let ((file - (expand-file-name - (org-remove-double-quotes (org-trim val))))) + ;; Options in `org-export-special-keywords'. + ((equal key "SETUPFILE") + (let ((file (expand-file-name + (org-remove-double-quotes (org-trim val))))) ;; Avoid circular dependencies. (unless (member file files) (with-temp-buffer (insert (org-file-contents file 'noerror)) - (org-mode) - (org-export--get-inbuffer-options - backend (cons file files)))))) - ((string= key "OPTIONS") - (org-export--parse-option-keyword val backend)) - ((string= key "MACRO") - (when (string-match - "^\\([-a-zA-Z0-9_]+\\)\\(?:[ \t]+\\(.*?\\)[ \t]*$\\)?" - val) - (let ((key - (intern - (concat ":macro-" - (downcase (match-string 1 val))))) - (value (org-match-string-no-properties 2 val))) - (cond - ((not value) nil) - ;; Value will be evaled: do not parse it. - ((string-match "\\`(eval\\>" value) - (list key (list value))) - ;; Value has to be parsed for nested - ;; macros. - (t - (list - key - (let ((restr (org-element-restriction 'macro))) - (org-element-parse-secondary-string - ;; If user explicitly asks for - ;; a newline, be sure to preserve it - ;; from further filling with - ;; `hard-newline'. Also replace - ;; "\\n" with "\n", "\\\n" with "\\n" - ;; and so on... - (replace-regexp-in-string - "\\(\\\\\\\\\\)n" "\\\\" - (replace-regexp-in-string - "\\(?:^\\|[^\\\\]\\)\\(\\\\n\\)" - hard-newline value nil nil 1) - nil nil 1) - restr))))))))))) - (setq plist (org-combine-plists plist prop))))))) - ;; 2. Standard options, as in `org-export-options-alist'. - (let* ((all (append org-export-options-alist - ;; Also look for back-end specific options - ;; if BACKEND is defined. - (and backend - (let ((var - (intern - (format "org-%s-options-alist" backend)))) - (and (boundp var) (eval var)))))) - ;; Build alist between keyword name and property name. - (alist - (delq nil (mapcar - (lambda (e) (when (nth 1 e) (cons (nth 1 e) (car e)))) - all))) - ;; Build regexp matching all keywords associated to export - ;; options. Note: the search is case insensitive. - (opt-re (org-make-options-regexp - (delq nil (mapcar (lambda (e) (nth 1 e)) all))))) - (goto-char (point-min)) - (while (re-search-forward opt-re nil t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (let* ((key (org-element-property :key element)) - (val (org-element-property :value element)) - (prop (cdr (assoc key alist))) - (behaviour (nth 4 (assq prop all)))) - (setq plist - (plist-put - plist prop - ;; Handle value depending on specified BEHAVIOUR. - (case behaviour - (space - (if (not (plist-get plist prop)) (org-trim val) - (concat (plist-get plist prop) " " (org-trim val)))) - (newline - (org-trim - (concat (plist-get plist prop) "\n" (org-trim val)))) - (split - `(,@(plist-get plist prop) ,@(org-split-string val))) - ('t val) - (otherwise (if (not (plist-member plist prop)) val - (plist-get plist prop)))))))))) - ;; Parse keywords specified in `org-element-parsed-keywords'. - (mapc - (lambda (key) - (let* ((prop (cdr (assoc key alist))) - (value (and prop (plist-get plist prop)))) - (when (stringp value) - (setq plist - (plist-put - plist prop - (org-element-parse-secondary-string - value (org-element-restriction 'keyword))))))) - org-element-parsed-keywords)) - ;; 3. Return final value. - plist))) + (let ((org-inhibit-startup t)) (org-mode)) + (setq plist (funcall get-options + (cons file files) plist)))))) + ((equal key "OPTIONS") + (setq plist + (org-combine-plists + plist + (org-export--parse-option-keyword val backend)))) + ((equal key "FILETAGS") + (setq plist + (org-combine-plists + plist + (list :filetags + (org-uniquify + (append (org-split-string val ":") + (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))))))))))))) + ;; 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)) (defun org-export--get-buffer-attributes () "Return properties related to buffer attributes, as a plist." @@ -1489,55 +1714,7 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." :title (or (and visited-file (file-name-sans-extension (file-name-nondirectory visited-file))) - (buffer-name (buffer-base-buffer))) - :footnote-definition-alist - ;; Footnotes definitions must be collected in the original - ;; buffer, as there's no insurance that they will still be in the - ;; parse tree, due to possible narrowing. - (let (alist) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward org-footnote-definition-re nil t) - (let ((def (org-footnote-at-definition-p))) - (when def - (org-skip-whitespace) - (push (cons (car def) - (save-restriction - (narrow-to-region (point) (nth 2 def)) - ;; Like `org-element-parse-buffer', but - ;; makes sure the definition doesn't start - ;; with a section element. - (org-element--parse-elements - (point-min) (point-max) nil nil nil nil - (list 'org-data nil)))) - alist)))) - alist)) - :id-alist - ;; Collect id references. - (let (alist) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward - "\\[\\[id:\\(\\S-+?\\)\\]\\(?:\\[.*?\\]\\)?\\]" nil t) - (let* ((id (org-match-string-no-properties 1)) - (file (org-id-find-id-file id))) - (when file (push (cons id (file-relative-name file)) alist))))) - alist) - :macro-modification-time - (and visited-file - (file-exists-p visited-file) - (concat "(eval (format-time-string \"$1\" '" - (prin1-to-string (nth 5 (file-attributes visited-file))) - "))")) - ;; Store input file name as a macro. - :macro-input-file (and visited-file (file-name-nondirectory visited-file)) - ;; `:macro-date', `:macro-time' and `:macro-property' could as - ;; well be initialized as tree properties, since they don't - ;; depend on buffer properties. Though, it may be more logical - ;; to keep them close to other ":macro-" properties. - :macro-date "(eval (format-time-string \"$1\"))" - :macro-time "(eval (format-time-string \"$1\"))" - :macro-property "(eval (org-entry-get nil \"$1\" 'selective))"))) + (buffer-name (buffer-base-buffer)))))) (defun org-export--get-global-options (&optional backend) "Return global export options as a plist. @@ -1545,63 +1722,74 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." Optional argument BACKEND, if non-nil, is a symbol specifying which back-end specific export options should also be read in the process." - (let ((all (append org-export-options-alist - (and backend - (let ((var (intern - (format "org-%s-options-alist" backend)))) - (and (boundp var) (symbol-value var)))))) - ;; Output value. + (let ((all + ;; Priority is given to back-end specific options. + (append (and backend (org-export-backend-options backend)) + org-export-options-alist)) plist) (mapc (lambda (cell) - (setq plist - (plist-put - plist - (car cell) - ;; Eval default value provided. If keyword is a member - ;; of `org-element-parsed-keywords', parse it as - ;; a secondary string before storing it. - (let ((value (eval (nth 3 cell)))) - (if (not (stringp value)) value - (let ((keyword (nth 1 cell))) - (if (not (member keyword org-element-parsed-keywords)) value - (org-element-parse-secondary-string - value (org-element-restriction 'keyword))))))))) + (let ((prop (car cell))) + (unless (plist-member plist prop) + (setq plist + (plist-put + plist + prop + ;; Eval default value provided. If keyword is a member + ;; of `org-element-document-properties', parse it as + ;; a secondary string before storing it. + (let ((value (eval (nth 3 cell)))) + (if (not (stringp value)) value + (let ((keyword (nth 1 cell))) + (if (not (member keyword org-element-document-properties)) + value + (org-element-parse-secondary-string + value (org-element-restriction 'keyword))))))))))) all) ;; Return value. plist)) -(defvar org-export--allow-BIND-local nil) -(defun org-export--confirm-letbind () - "Can we use #+BIND values during export? -By default this will ask for confirmation by the user, to divert -possible security risks." - (cond - ((not org-export-allow-BIND) nil) - ((eq org-export-allow-BIND t) t) - ((local-variable-p 'org-export--allow-BIND-local) - org-export--allow-BIND-local) - (t (org-set-local 'org-export--allow-BIND-local - (yes-or-no-p "Allow BIND values in this buffer? "))))) - -(defun org-export--install-letbind-maybe () - "Install the values from #+BIND lines as local variables. -Variables must be installed before in-buffer options are -retrieved." - (let (letbind pair) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward (org-make-options-regexp '("BIND")) nil t) - (when (org-export-confirm-letbind) - (push (read (concat "(" (org-match-string-no-properties 2) ")")) - letbind)))) - (while (setq pair (pop letbind)) - (org-set-local (car pair) (nth 1 pair))))) +(defun org-export--list-bound-variables () + "Return variables bound from BIND keywords in current buffer. +Also look for BIND keywords in setup files. The return value is +an alist where associations are (VARIABLE-NAME VALUE)." + (when org-export-allow-bind-keywords + (let* (collect-bind ; For byte-compiler. + (collect-bind + (lambda (files alist) + ;; Return an alist between variable names and their + ;; value. FILES is a list of setup files names read so + ;; far, used to avoid circular dependencies. ALIST is + ;; the alist collected so far. + (let ((case-fold-search t)) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((val (org-element-property :value element))) + (if (equal (org-element-property :key element) "BIND") + (push (read (format "(%s)" val)) alist) + ;; Enter setup file. + (let ((file (expand-file-name + (org-remove-double-quotes val)))) + (unless (member file files) + (with-temp-buffer + (let ((org-inhibit-startup t)) (org-mode)) + (insert (org-file-contents file 'noerror)) + (setq alist + (funcall collect-bind + (cons file files) + alist)))))))))) + alist))))) + ;; Return value in appropriate order of appearance. + (nreverse (funcall collect-bind nil nil))))) ;;;; Tree Properties ;; -;; Tree properties are infromation extracted from parse tree. They +;; Tree properties are information extracted from parse tree. They ;; are initialized at the beginning of the transcoding process by ;; `org-export-collect-tree-properties'. ;; @@ -1629,7 +1817,7 @@ Following tree properties are set or updated: original buffer and current parse tree. `:headline-offset' Offset between true level of headlines and - local level. An offset of -1 means an headline + local level. An offset of -1 means a headline of level 2 should be considered as a level 1 headline in the context. @@ -1639,8 +1827,6 @@ Following tree properties are set or updated: `:ignore-list' List of elements that should be ignored during export. -`:target-list' List of all targets in the parse tree. - Return updated plist." ;; Install the parse tree in the communication channel, in order to ;; use `org-export-get-genealogy' and al. @@ -1665,24 +1851,16 @@ Return updated plist." ;; This way, definitions in `footnote-definition-alist' are bound to ;; match those in the parse tree. (let ((defs (plist-get info :footnote-definition-alist))) - (org-element-map - data 'footnote-definition - (lambda (fn) - (push (cons (org-element-property :label fn) - `(org-data nil ,@(org-element-contents fn))) - defs))) + (org-element-map data 'footnote-definition + (lambda (fn) + (push (cons (org-element-property :label fn) + `(org-data nil ,@(org-element-contents fn))) + defs))) (setq info (plist-put info :footnote-definition-alist defs))) ;; Properties order doesn't matter: get the rest of the tree ;; properties. (nconc - `(:target-list - ,(org-element-map - data '(keyword target) - (lambda (blob) - (when (or (eq (org-element-type blob) 'target) - (string= (org-element-property :key blob) "TARGET")) - blob)) info) - :headline-numbering ,(org-export--collect-headline-numbering data info) + `(:headline-numbering ,(org-export--collect-headline-numbering data info) :exported-data ,(make-hash-table :test 'eq :size 4001)) info)) @@ -1695,9 +1873,9 @@ OPTIONS is a plist holding export options." (mapc (lambda (blob) (when (and (eq (org-element-type blob) 'headline) + (not (org-element-property :footnote-section-p blob)) (not (memq blob (plist-get options :ignore-list)))) - (setq min-level - (min (org-element-property :level blob) min-level))) + (setq min-level (min (org-element-property :level blob) min-level))) (when (= min-level 1) (throw 'exit 1))) (org-element-contents data)) ;; If no headline was found, for the sake of consistency, set @@ -1710,99 +1888,121 @@ OPTIONS is a plist holding export options." DATA is the parse tree. OPTIONS is the plist holding export options. -Return an alist whose key is an headline and value is its -associated numbering \(in the shape of a list of numbers\)." +Return an alist whose key is a headline and value is its +associated numbering \(in the shape of a list of numbers\) or nil +for a footnotes section." (let ((numbering (make-vector org-export-max-depth 0))) - (org-element-map - data - 'headline - (lambda (headline) - (let ((relative-level - (1- (org-export-get-relative-level headline options)))) - (cons - headline - (loop for n across numbering - for idx from 0 to org-export-max-depth - when (< idx relative-level) collect n - when (= idx relative-level) collect (aset numbering idx (1+ n)) - when (> idx relative-level) do (aset numbering idx 0))))) - options))) + (org-element-map data 'headline + (lambda (headline) + (unless (org-element-property :footnote-section-p headline) + (let ((relative-level + (1- (org-export-get-relative-level headline options)))) + (cons + headline + (loop for n across numbering + for idx from 0 to org-export-max-depth + when (< idx relative-level) collect n + when (= idx relative-level) collect (aset numbering idx (1+ n)) + when (> idx relative-level) do (aset numbering idx 0)))))) + options))) (defun org-export--populate-ignore-list (data options) "Return list of elements and objects to ignore during export. DATA is the parse tree to traverse. OPTIONS is the plist holding export options." (let* (ignore - walk-data ; for byte-compiler. + walk-data + ;; First find trees containing a select tag, if any. + (selected (org-export--selected-trees data options)) (walk-data - (function - (lambda (data options selected) - ;; Collect ignored elements or objects into IGNORE-LIST. - (mapc - (lambda (el) - (if (org-export--skip-p el options selected) (push el ignore) - (let ((type (org-element-type el))) - (if (and (eq (plist-get options :with-archived-trees) - 'headline) - (eq (org-element-type el) 'headline) - (org-element-property :archivedp el)) - ;; If headline is archived but tree below has - ;; to be skipped, add it to ignore list. - (mapc (lambda (e) (push e ignore)) - (org-element-contents el)) - ;; Move into recursive objects/elements. - (when (org-element-contents el) - (funcall walk-data el options selected)))))) - (org-element-contents data)))))) - ;; Main call. First find trees containing a select tag, if any. - (funcall walk-data data options (org-export--selected-trees data options)) + (lambda (data) + ;; Collect ignored elements or objects into IGNORE-LIST. + (let ((type (org-element-type data))) + (if (org-export--skip-p data options selected) (push data ignore) + (if (and (eq type 'headline) + (eq (plist-get options :with-archived-trees) 'headline) + (org-element-property :archivedp data)) + ;; If headline is archived but tree below has + ;; to be skipped, add it to ignore list. + (mapc (lambda (e) (push e ignore)) + (org-element-contents data)) + ;; Move into secondary string, if any. + (let ((sec-prop + (cdr (assq type org-element-secondary-value-alist)))) + (when sec-prop + (mapc walk-data (org-element-property sec-prop data)))) + ;; Move into recursive objects/elements. + (mapc walk-data (org-element-contents data)))))))) + ;; Main call. + (funcall walk-data data) ;; Return value. ignore)) (defun org-export--selected-trees (data info) - "Return list of headlines containing a select tag in their tree. + "Return list of headlines and inlinetasks with a select tag in their tree. DATA is parsed data as returned by `org-element-parse-buffer'. INFO is a plist holding export options." (let* (selected-trees - walk-data ; for byte-compiler. + walk-data ; For byte-compiler. (walk-data (function (lambda (data genealogy) - (case (org-element-type data) - (org-data (mapc (lambda (el) (funcall walk-data el genealogy)) - (org-element-contents data))) - (headline - (let ((tags (org-element-property :tags data))) - (if (loop for tag in (plist-get info :select-tags) - thereis (member tag tags)) - ;; When a select tag is found, mark full - ;; genealogy and every headline within the tree - ;; as acceptable. - (setq selected-trees - (append - genealogy - (org-element-map data 'headline 'identity) - selected-trees)) - ;; Else, continue searching in tree, recursively. - (mapc - (lambda (el) (funcall walk-data el (cons data genealogy))) - (org-element-contents data)))))))))) - (funcall walk-data data nil) selected-trees)) + (let ((type (org-element-type data))) + (cond + ((memq type '(headline inlinetask)) + (let ((tags (org-element-property :tags data))) + (if (loop for tag in (plist-get info :select-tags) + thereis (member tag tags)) + ;; When a select tag is found, mark full + ;; genealogy and every headline within the tree + ;; as acceptable. + (setq selected-trees + (append + genealogy + (org-element-map data '(headline inlinetask) + 'identity) + selected-trees)) + ;; If at a headline, continue searching in tree, + ;; recursively. + (when (eq type 'headline) + (mapc (lambda (el) + (funcall walk-data el (cons data genealogy))) + (org-element-contents data)))))) + ((or (eq type 'org-data) + (memq type org-element-greater-elements)) + (mapc (lambda (el) (funcall walk-data el genealogy)) + (org-element-contents data))))))))) + (funcall walk-data data nil) + selected-trees)) (defun org-export--skip-p (blob options selected) "Non-nil when element or object BLOB should be skipped during export. OPTIONS is the plist holding export options. SELECTED, when -non-nil, is a list of headlines belonging to a tree with a select -tag." +non-nil, is a list of headlines or inlinetasks belonging to +a tree with a select tag." (case (org-element-type blob) - ;; Check headline. - (headline + (clock (not (plist-get options :with-clocks))) + (drawer + (let ((with-drawers-p (plist-get options :with-drawers))) + (or (not with-drawers-p) + (and (consp with-drawers-p) + ;; If `:with-drawers' value starts with `not', ignore + ;; every drawer whose name belong to that list. + ;; Otherwise, ignore drawers whose name isn't in that + ;; list. + (let ((name (org-element-property :drawer-name blob))) + (if (eq (car with-drawers-p) 'not) + (member-ignore-case name (cdr with-drawers-p)) + (not (member-ignore-case name with-drawers-p)))))))) + ((headline inlinetask) (let ((with-tasks (plist-get options :with-tasks)) (todo (org-element-property :todo-keyword blob)) (todo-type (org-element-property :todo-type blob)) (archived (plist-get options :with-archived-trees)) (tags (org-element-property :tags blob))) (or + (and (eq (org-element-type blob) 'inlinetask) + (not (plist-get options :with-inlinetasks))) ;; Ignore subtrees with an exclude tag. (loop for k in (plist-get options :exclude-tags) thereis (member k tags)) @@ -1819,41 +2019,33 @@ tag." (and (memq with-tasks '(todo done)) (not (eq todo-type with-tasks))) (and (consp with-tasks) (not (member todo with-tasks)))))))) - ;; Check inlinetask. - (inlinetask (not (plist-get options :with-inlinetasks))) - ;; Check timestamp. - (timestamp - (case (plist-get options :with-timestamps) - ;; No timestamp allowed. - ('nil t) - ;; Only active timestamps allowed and the current one isn't - ;; active. - (active - (not (memq (org-element-property :type blob) - '(active active-range)))) - ;; Only inactive timestamps allowed and the current one isn't - ;; inactive. - (inactive - (not (memq (org-element-property :type blob) - '(inactive inactive-range)))))) - ;; Check drawer. - (drawer - (or (not (plist-get options :with-drawers)) - (and (consp (plist-get options :with-drawers)) - (not (member (org-element-property :drawer-name blob) - (plist-get options :with-drawers)))))) - ;; Check table-row. - (table-row (org-export-table-row-is-special-p blob options)) - ;; Check table-cell. + ((latex-environment latex-fragment) (not (plist-get options :with-latex))) + (planning (not (plist-get options :with-planning))) + (statistics-cookie (not (plist-get options :with-statistics-cookies))) (table-cell (and (org-export-table-has-special-column-p (org-export-get-parent-table blob)) (not (org-export-get-previous-element blob options)))) - ;; Check clock. - (clock (not (plist-get options :with-clocks))) - ;; Check planning. - (planning (not (plist-get options :with-plannings))))) - + (table-row (org-export-table-row-is-special-p blob options)) + (timestamp + ;; `:with-timestamps' only applies to isolated timestamps + ;; objects, i.e. timestamp objects in a paragraph containing only + ;; timestamps and whitespaces. + (when (let ((parent (org-export-get-parent-element blob))) + (and (memq (org-element-type parent) '(paragraph verse-block)) + (not (org-element-map parent + (cons 'plain-text + (remq 'timestamp org-element-all-objects)) + (lambda (obj) + (or (not (stringp obj)) (org-string-nw-p obj))) + options t)))) + (case (plist-get options :with-timestamps) + ('nil t) + (active + (not (memq (org-element-property :type blob) '(active active-range)))) + (inactive + (not (memq (org-element-property :type blob) + '(inactive inactive-range))))))))) ;;; The Transcoder @@ -1865,6 +2057,11 @@ tag." ;; lines and white space are preserved. The function memoizes its ;; results, so it is cheap to call it within translators. ;; +;; 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 ;; elements during the export. In particular, ;; `org-export-ignore-element' marks an element or object so future @@ -1927,8 +2124,12 @@ Return transcoded string." (eq (plist-get info :with-archived-trees) 'headline) (org-element-property :archivedp data))) (let ((transcoder (org-export-transcoder data info))) - (and (functionp transcoder) - (funcall transcoder data nil info)))) + (or (and (functionp transcoder) + (funcall transcoder data nil info)) + ;; Export snippets never return a nil value so + ;; that white spaces following them are never + ;; ignored. + (and (eq type 'export-snippet) "")))) ;; Element/Object with contents. (t (let ((transcoder (org-export-transcoder data info))) @@ -1986,20 +2187,56 @@ 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. + +DATA is an element, an object, a secondary string or a string. +BACKEND is a symbol. INFO is a plist used as a communication +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)) + (defun org-export--interpret-p (blob info) - "Non-nil if element or object BLOB should be interpreted as Org syntax. -Check is done according to export options INFO, stored as -a plist." + "Non-nil if element or object BLOB should be interpreted during export. +If nil, BLOB will appear as raw Org syntax. Check is done +according to export options INFO, stored as a plist." (case (org-element-type blob) ;; ... entities... (entity (plist-get info :with-entities)) ;; ... emphasis... - (emphasis (plist-get info :with-emphasize)) + ((bold italic strike-through underline) + (plist-get info :with-emphasize)) ;; ... fixed-width areas. (fixed-width (plist-get info :with-fixed-width)) ;; ... footnotes... ((footnote-definition footnote-reference) (plist-get info :with-footnotes)) + ;; ... LaTeX environments and fragments... + ((latex-environment latex-fragment) + (let ((with-latex-p (plist-get info :with-latex))) + (and with-latex-p (not (eq with-latex-p 'verbatim))))) ;; ... sub/superscripts... ((subscript superscript) (let ((sub/super-p (plist-get info :with-sub-superscript))) @@ -2041,14 +2278,19 @@ Any element in `:ignore-list' will be skipped when using ;; ;; From the developer side, filters sets can be installed in the ;; process with the help of `org-export-define-backend', which -;; internally sets `org-BACKEND-filters-alist' variable. Each -;; association has a key among the following symbols and a function or -;; a list of functions as value. +;; internally stores filters as an alist. Each association has a key +;; among the following symbols and a function or a list of functions +;; as value. ;; -;; - `:filter-parse-tree' applies directly on the complete parsed -;; tree. It's the only filters set that doesn't apply to a string. -;; Users can set it through `org-export-filter-parse-tree-functions' -;; variable. +;; - `:filter-options' applies to the property list containing export +;; options. Unlike to other filters, functions in this list accept +;; two arguments instead of three: the property list containing +;; export options and the back-end. Users can set its value through +;; `org-export-filter-options-functions' variable. +;; +;; - `:filter-parse-tree' applies directly to the complete parsed +;; tree. Users can set it through +;; `org-export-filter-parse-tree-functions' variable. ;; ;; - `:filter-final-output' applies to the final transcoded string. ;; Users can set it with `org-export-filter-final-output-functions' @@ -2059,7 +2301,7 @@ Any element in `:ignore-list' will be skipped when using ;; configure it. ;; ;; - `:filter-TYPE' applies on the string returned after an element or -;; object of type TYPE has been transcoded. An user can modify +;; object of type TYPE has been transcoded. A user can modify ;; `org-export-filter-TYPE-functions' ;; ;; All filters sets are applied with @@ -2070,19 +2312,32 @@ Any element in `:ignore-list' will be skipped when using ;; Filters properties are installed in communication channel with ;; `org-export-install-filters' function. ;; -;; Eventually, a hook (`org-export-before-parsing-hook') is run just -;; before parsing to allow for heavy structure modifications. +;; Eventually, two hooks (`org-export-before-processing-hook' and +;; `org-export-before-parsing-hook') are run at the beginning of the +;; export process and just before parsing to allow for heavy structure +;; modifications. -;;;; Before Parsing Hook +;;;; Hooks + +(defvar org-export-before-processing-hook nil + "Hook run at the beginning of the export process. + +This is run before include keywords and macros are expanded and +Babel code blocks executed, on a copy of the original buffer +being exported. Visibility and narrowing are preserved. Point +is at the beginning of the buffer. + +Every function in this hook will be called with one argument: the +back-end currently used, as a symbol.") (defvar org-export-before-parsing-hook nil "Hook run before parsing an export buffer. -This is run after include keywords have been expanded and Babel -code executed, on a copy of original buffer's area being -exported. Visibility is the same as in the original one. Point -is left at the beginning of the new one. +This is run after include keywords and macros have been expanded +and Babel code blocks executed, on a copy of the original buffer +being exported. Visibility and narrowing are preserved. Point +is at the beginning of the buffer. Every function in this hook will be called with one argument: the back-end currently used, as a symbol.") @@ -2090,6 +2345,12 @@ back-end currently used, as a symbol.") ;;;; Special Filters +(defvar org-export-filter-options-functions nil + "List of functions applied to the export options. +Each filter is called with two arguments: the export options, as +a plist, and the back-end, as a symbol. It must return +a property list containing export options.") + (defvar org-export-filter-parse-tree-functions nil "List of functions applied to the parsed tree. Each filter is called with three arguments: the parse tree, as @@ -2097,13 +2358,6 @@ returned by `org-element-parse-buffer', the back-end, as a symbol, and the communication channel, as a plist. It must return the modified parse tree to transcode.") -(defvar org-export-filter-final-output-functions nil - "List of functions applied to the transcoded string. -Each filter is called with three arguments: the full transcoded -string, the back-end, as a symbol, and the communication channel, -as a plist. It must return a string that will be used as the -final export output.") - (defvar org-export-filter-plain-text-functions nil "List of functions applied to plain text. Each filter is called with three arguments: a string which @@ -2111,9 +2365,22 @@ contains no Org syntax, the back-end, as a symbol, and the communication channel, as a plist. It must return a string or nil.") +(defvar org-export-filter-final-output-functions nil + "List of functions applied to the transcoded string. +Each filter is called with three arguments: the full transcoded +string, the back-end, as a symbol, and the communication channel, +as a plist. It must return a string that will be used as the +final export output.") + ;;;; Elements Filters +(defvar org-export-filter-babel-call-functions nil + "List of functions applied to a transcoded babel-call. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + (defvar org-export-filter-center-block-functions nil "List of functions applied to a transcoded center block. Each filter is called with three arguments: the transcoded data, @@ -2126,6 +2393,24 @@ Each filter is called with three arguments: the transcoded data, as a string, the back-end, as a symbol, and the communication channel, as a plist. It must return a string or nil.") +(defvar org-export-filter-comment-functions nil + "List of functions applied to a transcoded comment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-comment-block-functions nil + "List of functions applied to a transcoded comment-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-diary-sexp-functions nil + "List of functions applied to a transcoded diary-sexp. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + (defvar org-export-filter-drawer-functions nil "List of functions applied to a transcoded drawer. Each filter is called with three arguments: the transcoded data, @@ -2138,42 +2423,6 @@ Each filter is called with three arguments: the transcoded data, as a string, the back-end, as a symbol, and the communication channel, as a plist. It must return a string or nil.") -(defvar org-export-filter-headline-functions nil - "List of functions applied to a transcoded headline. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-inlinetask-functions nil - "List of functions applied to a transcoded inlinetask. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-plain-list-functions nil - "List of functions applied to a transcoded plain-list. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-item-functions nil - "List of functions applied to a transcoded item. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-comment-functions nil - "List of functions applied to a transcoded comment. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-comment-block-functions nil - "List of functions applied to a transcoded comment-comment. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - (defvar org-export-filter-example-block-functions nil "List of functions applied to a transcoded example-block. Each filter is called with three arguments: the transcoded data, @@ -2198,12 +2447,30 @@ Each filter is called with three arguments: the transcoded data, as a string, the back-end, as a symbol, and the communication channel, as a plist. It must return a string or nil.") +(defvar org-export-filter-headline-functions nil + "List of functions applied to a transcoded headline. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + (defvar org-export-filter-horizontal-rule-functions nil "List of functions applied to a transcoded horizontal-rule. Each filter is called with three arguments: the transcoded data, as a string, the back-end, as a symbol, and the communication channel, as a plist. It must return a string or nil.") +(defvar org-export-filter-inlinetask-functions nil + "List of functions applied to a transcoded inlinetask. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-item-functions nil + "List of functions applied to a transcoded item. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + (defvar org-export-filter-keyword-functions nil "List of functions applied to a transcoded keyword. Each filter is called with three arguments: the transcoded data, @@ -2216,8 +2483,8 @@ Each filter is called with three arguments: the transcoded data, as a string, the back-end, as a symbol, and the communication channel, as a plist. It must return a string or nil.") -(defvar org-export-filter-babel-call-functions nil - "List of functions applied to a transcoded babel-call. +(defvar org-export-filter-node-property-functions nil + "List of functions applied to a transcoded node-property. Each filter is called with three arguments: the transcoded data, as a string, the back-end, as a symbol, and the communication channel, as a plist. It must return a string or nil.") @@ -2228,6 +2495,12 @@ Each filter is called with three arguments: the transcoded data, as a string, the back-end, as a symbol, and the communication channel, as a plist. It must return a string or nil.") +(defvar org-export-filter-plain-list-functions nil + "List of functions applied to a transcoded plain-list. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + (defvar org-export-filter-planning-functions nil "List of functions applied to a transcoded planning. Each filter is called with three arguments: the transcoded data, @@ -2364,12 +2637,6 @@ Each filter is called with three arguments: the transcoded data, as a string, the back-end, as a symbol, and the communication channel, as a plist. It must return a string or nil.") -(defvar org-export-filter-macro-functions nil - "List of functions applied to a transcoded macro. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - (defvar org-export-filter-radio-target-functions nil "List of functions applied to a transcoded radio-target. Each filter is called with three arguments: the transcoded data, @@ -2449,35 +2716,40 @@ 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 value)) + (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. - INFO is a plist containing the current communication channel. - Return the updated communication channel." (let (plist) - ;; Install user defined filters with `org-export-filters-alist'. + ;; Install user-defined filters with `org-export-filters-alist' + ;; and filters already in INFO (through ext-plist mechanism). (mapc (lambda (p) - (setq plist (plist-put plist (car p) (eval (cdr p))))) + (let* ((prop (car p)) + (info-value (plist-get info prop)) + (default-value (symbol-value (cdr p)))) + (setq plist + (plist-put plist prop + ;; Filters in INFO will be called + ;; before those user provided. + (append (if (listp info-value) info-value + (list info-value)) + default-value))))) org-export-filters-alist) ;; Prepend back-end specific filters to that list. - (let ((back-end-filters (intern (format "org-%s-filters-alist" - (plist-get info :back-end))))) - (when (boundp back-end-filters) - (mapc (lambda (p) - ;; Single values get consed, lists are prepended. - (let ((key (car p)) (value (cdr p))) - (when value - (setq plist - (plist-put - plist key - (if (atom value) (cons value (plist-get plist key)) - (append value (plist-get plist key)))))))) - (eval back-end-filters)))) + (mapc (lambda (p) + ;; Single values get consed, lists are appended. + (let ((key (car p)) (value (cdr p))) + (when value + (setq plist + (plist-put + plist key + (if (atom value) (cons value (plist-get plist key)) + (append value (plist-get plist key)))))))) + (org-export-backend-filters (plist-get info :back-end))) ;; Return new communication channel. (org-combine-plists info plist))) @@ -2486,8 +2758,11 @@ Return the updated communication channel." ;;; Core functions ;; ;; This is the room for the main function, `org-export-as', along with -;; its derivatives, `org-export-to-buffer' and `org-export-to-file'. -;; They differ only by the way they output the resulting code. +;; its derivatives, `org-export-to-buffer', `org-export-to-file' and +;; `org-export-string-as'. They differ either by the way they output +;; the resulting code (for the first two) or by the input type (for +;; the latter). `org-export--copy-to-kill-ring-p' determines if +;; output of these function should be added to kill ring. ;; ;; `org-export-output-file-name' is an auxiliary function meant to be ;; used with `org-export-to-file'. With a given extension, it tries @@ -2495,21 +2770,119 @@ Return the updated communication channel." ;; ;; Note that `org-export-as' doesn't really parse the current buffer, ;; but a copy of it (with the same buffer-local variables and -;; visibility), where include keywords are expanded and Babel blocks -;; are executed, if appropriate. -;; `org-export-with-current-buffer-copy' macro prepares that copy. +;; visibility), where macros and include keywords are expanded and +;; Babel blocks are executed, if appropriate. +;; `org-export-with-buffer-copy' macro prepares that copy. ;; ;; File inclusion is taken care of by ;; `org-export-expand-include-keyword' and ;; `org-export--prepare-file-contents'. Structure wise, including ;; a whole Org file in a buffer often makes little sense. For -;; example, if the file contains an headline and the include keyword +;; example, if the file contains a headline and the include keyword ;; was within an item, the item should contain the headline. That's ;; why file inclusion should be done before any structure can be ;; associated to the file, that is before parsing. +;; +;; `org-export-insert-default-template' is a command to insert +;; a default template (or a back-end specific template) at point or in +;; current subtree. +(defun org-export-copy-buffer () + "Return a copy of the current buffer. +The copy preserves Org buffer-local variables, visibility and +narrowing." + (let ((copy-buffer-fun (org-export--generate-copy-script (current-buffer))) + (new-buf (generate-new-buffer (buffer-name)))) + (with-current-buffer new-buf + (funcall copy-buffer-fun) + (set-buffer-modified-p nil)) + new-buf)) + +(defmacro org-export-with-buffer-copy (&rest body) + "Apply BODY in a copy of the current buffer. +The copy preserves local variables, visibility and contents of +the original buffer. Point is at the beginning of the buffer +when BODY is applied." + (declare (debug t)) + (org-with-gensyms (buf-copy) + `(let ((,buf-copy (org-export-copy-buffer))) + (unwind-protect + (with-current-buffer ,buf-copy + (goto-char (point-min)) + (progn ,@body)) + (and (buffer-live-p ,buf-copy) + ;; Kill copy without confirmation. + (progn (with-current-buffer ,buf-copy + (restore-buffer-modified-p nil)) + (kill-buffer ,buf-copy))))))) + +(defun org-export--generate-copy-script (buffer) + "Generate a function duplicating BUFFER. + +The copy will preserve local variables, visibility, contents and +narrowing of the original buffer. If a region was active in +BUFFER, contents will be narrowed to that region instead. + +The resulting function can be evaled at a later time, from +another buffer, effectively cloning the original buffer there. + +The function assumes BUFFER's major mode is `org-mode'." + (with-current-buffer buffer + `(lambda () + (let ((inhibit-modification-hooks t)) + ;; Set major mode. Ignore `org-mode-hook' as it has been run + ;; already in BUFFER. + (let ((org-mode-hook nil) (org-inhibit-startup t)) (org-mode)) + ;; Copy specific buffer local variables and variables set + ;; through BIND keywords. + ,@(let ((bound-variables (org-export--list-bound-variables)) + vars) + (dolist (entry (buffer-local-variables (buffer-base-buffer)) vars) + (when (consp entry) + (let ((var (car entry)) + (val (cdr entry))) + (and (not (eq var 'org-font-lock-keywords)) + (or (memq var + '(default-directory + buffer-file-name + buffer-file-coding-system)) + (assq var bound-variables) + (string-match "^\\(org-\\|orgtbl-\\)" + (symbol-name var))) + ;; Skip unreadable values, as they cannot be + ;; sent to external process. + (or (not val) (ignore-errors (read (format "%S" val)))) + (push `(set (make-local-variable (quote ,var)) + (quote ,val)) + vars)))))) + ;; Whole buffer contents. + (insert + ,(org-with-wide-buffer + (buffer-substring-no-properties + (point-min) (point-max)))) + ;; Narrowing. + ,(if (org-region-active-p) + `(narrow-to-region ,(region-beginning) ,(region-end)) + `(narrow-to-region ,(point-min) ,(point-max))) + ;; Current position of point. + (goto-char ,(point)) + ;; Overlays with invisible property. + ,@(let (ov-set) + (mapc + (lambda (ov) + (let ((invis-prop (overlay-get ov 'invisible))) + (when invis-prop + (push `(overlay-put + (make-overlay ,(overlay-start ov) + ,(overlay-end ov)) + 'invisible (quote ,invis-prop)) + ov-set)))) + (overlays-in (point-min) (point-max))) + ov-set))))) + +;;;###autoload (defun org-export-as - (backend &optional subtreep visible-only body-only ext-plist noexpand) + (backend &optional subtreep visible-only body-only ext-plist) "Transcode current Org buffer into BACKEND code. If narrowing is active in the current buffer, only transcode its @@ -2525,16 +2898,14 @@ When optional argument VISIBLE-ONLY is non-nil, don't export contents of hidden elements. When optional argument BODY-ONLY is non-nil, only return body -code, without preamble nor postamble. +code, without surrounding template. Optional argument EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to file-local settings. -Optional argument NOEXPAND, when non-nil, prevents included files -to be expanded and Babel code to be executed. - Return code as a string." + (org-export-barf-if-invalid-backend backend) (save-excursion (save-restriction ;; Narrow buffer to an appropriate region or subtree for @@ -2547,60 +2918,94 @@ Return code as a string." (goto-char (point-min)) (forward-line) (narrow-to-region (point) (point-max)))) - ;; 1. Get export environment from original buffer. Also install - ;; user's and developer's filters. - (let ((info (org-export-install-filters - (org-export-get-environment backend subtreep ext-plist))) - ;; 2. Get parse tree. Buffer isn't parsed directly. - ;; Instead, a temporary copy is created, where include - ;; keywords are expanded and code blocks are evaluated. - (tree (let ((buf (or (buffer-file-name (buffer-base-buffer)) - (current-buffer)))) - (org-export-with-current-buffer-copy - (unless noexpand - (org-export-expand-include-keyword) - ;; TODO: Setting `org-current-export-file' is - ;; required by Org Babel to properly resolve - ;; noweb references. Once "org-exp.el" is - ;; removed, modify - ;; `org-export-blocks-preprocess' so it accepts - ;; the value as an argument instead. - (let ((org-current-export-file buf)) - (org-export-blocks-preprocess))) - (goto-char (point-min)) - ;; Run hook - ;; `org-export-before-parsing-hook'. with current - ;; back-end as argument. - (run-hook-with-args - 'org-export-before-parsing-hook backend) - ;; Eventually parse buffer. - (org-element-parse-buffer nil visible-only))))) - ;; 3. Call parse-tree filters to get the final tree. - (setq tree - (org-export-filter-apply-functions - (plist-get info :filter-parse-tree) tree info)) - ;; 4. Now tree is complete, compute its properties and add - ;; them to communication channel. - (setq info - (org-combine-plists - info (org-export-collect-tree-properties tree info))) - ;; 5. Eventually transcode TREE. Wrap the resulting string - ;; into a template, if required. Eventually call - ;; final-output filter. - (let* ((body (org-element-normalize-string (org-export-data tree info))) - (template (cdr (assq 'template - (plist-get info :translate-alist)))) - (output (org-export-filter-apply-functions - (plist-get info :filter-final-output) - (if (or (not (functionp template)) body-only) body - (funcall template body info)) - info))) - ;; Maybe add final OUTPUT to kill ring, then return it. - (when org-export-copy-to-kill-ring (org-kill-new output)) - output))))) + ;; Initialize communication channel with original buffer + ;; attributes, unavailable in its copy. + (let ((info (org-combine-plists + (list :export-options + (delq nil + (list (and subtreep 'subtree) + (and visible-only 'visible-only) + (and body-only 'body-only)))) + (org-export--get-buffer-attributes))) + tree) + ;; Update communication channel and get parse tree. Buffer + ;; isn't parsed directly. Instead, a temporary copy is + ;; created, where include keywords, macros are expanded and + ;; code blocks are evaluated. + (org-export-with-buffer-copy + ;; Run first hook with current back-end as argument. + (run-hook-with-args 'org-export-before-processing-hook backend) + (org-export-expand-include-keyword) + ;; Update macro templates since #+INCLUDE keywords might have + ;; added some new ones. + (org-macro-initialize-templates) + (org-macro-replace-all org-macro-templates) + (org-export-execute-babel-code) + ;; 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. + (goto-char (point-min)) + (save-excursion + (run-hook-with-args 'org-export-before-parsing-hook backend)) + ;; Update communication channel with environment. Also + ;; install user's and developer's filters. + (setq info + (org-export-install-filters + (org-combine-plists + info (org-export-get-environment backend subtreep ext-plist)))) + ;; Expand export-specific set of macros: {{{author}}}, + ;; {{{date}}}, {{{email}}} and {{{title}}}. It must be done + ;; once regular macros have been expanded, since document + ;; keywords may contain one of them. + (org-macro-replace-all + (list (cons "author" + (org-element-interpret-data (plist-get info :author))) + (cons "date" + (org-element-interpret-data (plist-get info :date))) + ;; EMAIL is not a parsed keyword: store it as-is. + (cons "email" (or (plist-get info :email) "")) + (cons "title" + (org-element-interpret-data (plist-get info :title))))) + ;; Call options filters and update export options. We do not + ;; use `org-export-filter-apply-functions' here since the + ;; arity of such filters is different. + (dolist (filter (plist-get info :filter-options)) + (let ((result (funcall filter info backend))) + (when result (setq info result)))) + ;; Parse buffer and call parse-tree filter on it. + (setq tree + (org-export-filter-apply-functions + (plist-get info :filter-parse-tree) + (org-element-parse-buffer nil visible-only) info)) + ;; Now tree is complete, compute its properties and add them + ;; to communication channel. + (setq info + (org-combine-plists + info (org-export-collect-tree-properties tree info))) + ;; Eventually transcode TREE. Wrap the resulting string into + ;; a template. + (let* ((body (org-element-normalize-string + (or (org-export-data tree info) ""))) + (inner-template (cdr (assq 'inner-template + (plist-get info :translate-alist)))) + (full-body (if (not (functionp inner-template)) body + (funcall inner-template body info))) + (template (cdr (assq 'template + (plist-get info :translate-alist))))) + ;; Remove all text properties since they cannot be + ;; retrieved from an external process. Finally call + ;; final-output filter and return result. + (org-no-properties + (org-export-filter-apply-functions + (plist-get info :filter-final-output) + (if (or (not (functionp template)) body-only) full-body + (funcall template full-body info)) + info)))))))) +;;;###autoload (defun org-export-to-buffer - (backend buffer &optional subtreep visible-only body-only ext-plist noexpand) + (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. @@ -2608,45 +3013,180 @@ BACKEND is the back-end used for transcoding, as a symbol. BUFFER is the output buffer. If it already exists, it will be erased first, otherwise, it will be created. -Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST -and NOEXPAND are similar to those used in `org-export-as', which +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which see. -Return buffer." - (let ((out (org-export-as - backend subtreep visible-only body-only ext-plist noexpand)) +Depending on `org-export-copy-to-kill-ring', add buffer contents +to kill ring. Return buffer." + (let ((out (org-export-as backend subtreep visible-only body-only ext-plist)) (buffer (get-buffer-create buffer))) (with-current-buffer buffer (erase-buffer) (insert out) (goto-char (point-min))) + ;; Maybe add buffer contents to kill ring. + (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p out)) + (org-kill-new out)) + ;; Return buffer. buffer)) +;;;###autoload (defun org-export-to-file - (backend file &optional subtreep visible-only body-only ext-plist noexpand) + (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. -Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST -and NOEXPAND are similar to those used in `org-export-as', which +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which see. -Return output file's name." +Depending on `org-export-copy-to-kill-ring', add file contents +to kill ring. Return output file's name." ;; Checks for FILE permissions. `write-file' would do the same, but ;; we'd rather avoid needless transcoding of parse tree. (unless (file-writable-p file) (error "Output file not writable")) ;; Insert contents to a temporary buffer and write it to FILE. - (let ((out (org-export-as - backend subtreep visible-only body-only ext-plist noexpand))) + (let ((out (org-export-as backend subtreep visible-only body-only ext-plist))) (with-temp-buffer (insert out) (let ((coding-system-for-write org-export-coding-system)) - (write-file file)))) + (write-file file))) + ;; Maybe add file contents to kill ring. + (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p out)) + (org-kill-new out))) ;; Return full path. file) +;;;###autoload +(defun org-export-string-as (string backend &optional body-only ext-plist) + "Transcode STRING into BACKEND code. + +When optional argument BODY-ONLY is non-nil, only return body +code, without preamble nor postamble. + +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Return code as a string." + (with-temp-buffer + (insert string) + (let ((org-inhibit-startup t)) (org-mode)) + (org-export-as backend nil nil body-only ext-plist))) + +;;;###autoload +(defun org-export-replace-region-by (backend) + "Replace the active region by its export to BACKEND." + (if (not (org-region-active-p)) + (user-error "No active region to replace") + (let* ((beg (region-beginning)) + (end (region-end)) + (str (buffer-substring beg end)) rpl) + (setq rpl (org-export-string-as str backend t)) + (delete-region beg end) + (insert rpl)))) + +;;;###autoload +(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. + +If SUBTREEP is non-nil, export configuration will be set up +locally for the subtree through node properties." + (interactive) + (unless (derived-mode-p 'org-mode) (user-error "Not in an Org mode buffer")) + (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)))))) + options keywords) + ;; Populate OPTIONS and KEYWORDS. + (dolist (entry (if (eq backend 'default) org-export-options-alist + (org-export-backend-options backend))) + (let ((keyword (nth 1 entry)) + (option (nth 2 entry))) + (cond + (keyword (unless (assoc keyword keywords) + (let ((value + (if (eq (nth 4 entry) 'split) + (mapconcat 'identity (eval (nth 3 entry)) " ") + (eval (nth 3 entry))))) + (push (cons keyword value) keywords)))) + (option (unless (assoc option options) + (push (cons option (eval (nth 3 entry))) options)))))) + ;; Move to an appropriate location in order to insert options. + (unless subtreep (beginning-of-line)) + ;; First get TITLE, DATE, AUTHOR and EMAIL if they belong to the + ;; list of available keywords. + (when (assoc "TITLE" keywords) + (let ((title + (or (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (and visited-file + (file-name-sans-extension + (file-name-nondirectory visited-file)))) + (buffer-name (buffer-base-buffer))))) + (if (not subtreep) (insert (format "#+TITLE: %s\n" title)) + (org-entry-put node "EXPORT_TITLE" title)))) + (when (assoc "DATE" keywords) + (let ((date (with-temp-buffer (org-insert-time-stamp (current-time))))) + (if (not subtreep) (insert "#+DATE: " date "\n") + (org-entry-put node "EXPORT_DATE" date)))) + (when (assoc "AUTHOR" keywords) + (let ((author (cdr (assoc "AUTHOR" keywords)))) + (if subtreep (org-entry-put node "EXPORT_AUTHOR" author) + (insert + (format "#+AUTHOR:%s\n" + (if (not (org-string-nw-p author)) "" + (concat " " author))))))) + (when (assoc "EMAIL" keywords) + (let ((email (cdr (assoc "EMAIL" keywords)))) + (if subtreep (org-entry-put node "EXPORT_EMAIL" email) + (insert + (format "#+EMAIL:%s\n" + (if (not (org-string-nw-p email)) "" + (concat " " email))))))) + ;; Then (multiple) OPTIONS lines. Never go past fill-column. + (when options + (let ((items + (mapcar + (lambda (opt) + (format "%s:%s" (car opt) (format "%s" (cdr opt)))) + (sort options (lambda (k1 k2) (string< (car k1) (car k2))))))) + (if subtreep + (org-entry-put + node "EXPORT_OPTIONS" (mapconcat 'identity items " ")) + (while items + (insert "#+OPTIONS:") + (let ((width 10)) + (while (and items + (< (+ width (length (car items)) 1) fill-column)) + (let ((item (pop items))) + (insert " " item) + (incf width (1+ (length item)))))) + (insert "\n"))))) + ;; And the rest of keywords. + (dolist (key (sort keywords (lambda (k1 k2) (string< (car k1) (car k2))))) + (unless (member (car key) '("TITLE" "DATE" "AUTHOR" "EMAIL")) + (let ((val (cdr key))) + (if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val) + (insert + (format "#+%s:%s\n" + (car key) + (if (org-string-nw-p val) (format " %s" val) ""))))))))) + (defun org-export-output-file-name (extension &optional subtreep pub-dir) "Return output file's name according to buffer specifications. @@ -2663,68 +3203,44 @@ directory. When optional argument VISIBLE-ONLY is non-nil, don't export contents of hidden elements. -Return file name as a string, or nil if it couldn't be -determined." - (let ((base-name - ;; File name may come from EXPORT_FILE_NAME subtree property, - ;; assuming point is at beginning of said sub-tree. - (file-name-sans-extension - (or (and subtreep - (org-entry-get - (save-excursion - (ignore-errors (org-back-to-heading) (point))) - "EXPORT_FILE_NAME" t)) - ;; File name may be extracted from buffer's associated - ;; file, if any. - (buffer-file-name (buffer-base-buffer)) - ;; Can't determine file name on our own: Ask user. - (let ((read-file-name-function - (and org-completion-use-ido 'ido-read-file-name))) - (read-file-name - "Output file: " pub-dir nil nil nil - (lambda (name) - (string= (file-name-extension name t) extension)))))))) - ;; Build file name. Enforce EXTENSION over whatever user may have - ;; come up with. PUB-DIR, if defined, always has precedence over - ;; any provided path. - (cond - (pub-dir - (concat (file-name-as-directory pub-dir) - (file-name-nondirectory base-name) - extension)) - ((string= (file-name-nondirectory base-name) base-name) - (concat (file-name-as-directory ".") base-name extension)) - (t (concat base-name extension))))) - -(defmacro org-export-with-current-buffer-copy (&rest body) - "Apply BODY in a copy of the current buffer. - -The copy preserves local variables and visibility of the original -buffer. - -Point is at buffer's beginning when BODY is applied." - (org-with-gensyms (original-buffer offset buffer-string overlays) - `(let ((,original-buffer (current-buffer)) - (,offset (1- (point-min))) - (,buffer-string (buffer-string)) - (,overlays (mapcar - 'copy-overlay (overlays-in (point-min) (point-max))))) - (with-temp-buffer - (let ((buffer-invisibility-spec nil)) - (org-clone-local-variables - ,original-buffer - "^\\(org-\\|orgtbl-\\|major-mode$\\|outline-\\(regexp\\|level\\)$\\)") - (insert ,buffer-string) - (mapc (lambda (ov) - (move-overlay - ov - (- (overlay-start ov) ,offset) - (- (overlay-end ov) ,offset) - (current-buffer))) - ,overlays) - (goto-char (point-min)) - (progn ,@body)))))) -(def-edebug-spec org-export-with-current-buffer-copy (body)) +Return file name as a string." + (let* ((visited-file (buffer-file-name (buffer-base-buffer))) + (base-name + ;; File name may come from EXPORT_FILE_NAME subtree + ;; property, assuming point is at beginning of said + ;; sub-tree. + (file-name-sans-extension + (or (and subtreep + (org-entry-get + (save-excursion + (ignore-errors (org-back-to-heading) (point))) + "EXPORT_FILE_NAME" t)) + ;; File name may be extracted from buffer's associated + ;; file, if any. + (and visited-file (file-name-nondirectory visited-file)) + ;; Can't determine file name on our own: Ask user. + (let ((read-file-name-function + (and org-completion-use-ido 'ido-read-file-name))) + (read-file-name + "Output file: " pub-dir nil nil nil + (lambda (name) + (string= (file-name-extension name t) extension))))))) + (output-file + ;; Build file name. Enforce EXTENSION over whatever user + ;; may have come up with. PUB-DIR, if defined, always has + ;; precedence over any provided path. + (cond + (pub-dir + (concat (file-name-as-directory pub-dir) + (file-name-nondirectory base-name) + extension)) + ((file-name-absolute-p base-name) (concat base-name extension)) + (t (concat (file-name-as-directory ".") base-name extension))))) + ;; If writing to OUTPUT-FILE would overwrite original file, append + ;; EXTENSION another time to final name. + (if (and visited-file (org-file-equal-p visited-file output-file)) + (concat output-file extension) + output-file))) (defun org-export-expand-include-keyword (&optional included dir) "Expand every include keyword in buffer. @@ -2735,7 +3251,7 @@ working directory. It is used to properly resolve relative paths." (let ((case-fold-search t)) (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#\\+INCLUDE: \\(.*\\)" nil t) + (while (re-search-forward "^[ \t]*#\\+INCLUDE: +\\(.*\\)[ \t]*$" nil t) (when (eq (org-element-type (save-match-data (org-element-at-point))) 'keyword) (beginning-of-line) @@ -2767,6 +3283,7 @@ paths." ;; Remove keyword. (delete-region (point) (progn (forward-line) (point))) (cond + ((not file) (error "Invalid syntax in INCLUDE keyword")) ((not (file-readable-p file)) (error "Cannot include file %s" file)) ;; Check if files has already been parsed. Look after ;; inclusion lines too, as different parts of the same file @@ -2779,29 +3296,22 @@ paths." (insert (let ((ind-str (make-string ind ? )) (contents - ;; Protect sensitive contents with commas. - (replace-regexp-in-string - "\\(^\\)\\([*]\\|[ \t]*#\\+\\)" "," - (org-export--prepare-file-contents file lines) - nil nil 1))) + (org-escape-code-in-string + (org-export--prepare-file-contents file lines)))) (format "%s#+BEGIN_EXAMPLE\n%s%s#+END_EXAMPLE\n" ind-str contents ind-str)))) ((stringp env) (insert (let ((ind-str (make-string ind ? )) (contents - ;; Protect sensitive contents with commas. - (replace-regexp-in-string - (if (string= env "org") "\\(^\\)\\(.\\)" - "\\(^\\)\\([*]\\|[ \t]*#\\+\\)") "," - (org-export--prepare-file-contents file lines) - nil nil 1))) + (org-escape-code-in-string + (org-export--prepare-file-contents file lines)))) (format "%s#+BEGIN_SRC %s\n%s%s#+END_SRC\n" ind-str env contents ind-str)))) (t (insert (with-temp-buffer - (org-mode) + (let ((org-inhibit-startup t)) (org-mode)) (insert (org-export--prepare-file-contents file lines ind minlevel)) (org-export-expand-include-keyword @@ -2853,7 +3363,8 @@ file should have." ;; If IND is set, preserve indentation of include keyword until ;; the first headline encountered. (when ind - (unless (eq major-mode 'org-mode) (org-mode)) + (unless (eq major-mode 'org-mode) + (let ((org-inhibit-startup t)) (org-mode))) (goto-char (point-min)) (let ((ind-str (make-string ind ? ))) (while (not (or (eobp) (looking-at org-outline-regexp-bol))) @@ -2867,19 +3378,38 @@ file should have." ;; in the file (CUR-MIN), and remove stars to each headline so ;; that headlines with minimal level have a level of MINLEVEL. (when minlevel - (unless (eq major-mode 'org-mode) (org-mode)) - (let ((levels (org-map-entries - (lambda () (org-reduced-level (org-current-level)))))) - (when levels - (let ((offset (- minlevel (apply 'min levels)))) - (unless (zerop offset) - (when org-odd-levels-only (setq offset (* offset 2))) - ;; Only change stars, don't bother moving whole - ;; sections. - (org-map-entries - (lambda () (if (< offset 0) (delete-char (abs offset)) - (insert (make-string offset ?*)))))))))) - (buffer-string))) + (unless (eq major-mode 'org-mode) + (let ((org-inhibit-startup t)) (org-mode))) + (org-with-limited-levels + (let ((levels (org-map-entries + (lambda () (org-reduced-level (org-current-level)))))) + (when levels + (let ((offset (- minlevel (apply 'min levels)))) + (unless (zerop offset) + (when org-odd-levels-only (setq offset (* offset 2))) + ;; Only change stars, don't bother moving whole + ;; sections. + (org-map-entries + (lambda () (if (< offset 0) (delete-char (abs offset)) + (insert (make-string offset ?*))))))))))) + (org-element-normalize-string (buffer-string)))) + +(defun org-export-execute-babel-code () + "Execute every Babel code in the visible part of current buffer." + ;; Get a pristine copy of current buffer so Babel references can be + ;; properly resolved. + (let ((reference (org-export-copy-buffer))) + (unwind-protect (let ((org-current-export-file reference)) + (org-babel-exp-process-buffer)) + (kill-buffer reference)))) + +(defun org-export--copy-to-kill-ring-p () + "Return a non-nil value when output should be added to the kill ring. +See also `org-export-copy-to-kill-ring'." + (if (eq org-export-copy-to-kill-ring 'if-interactive) + (not (or executing-kbd-macro noninteractive)) + (eq org-export-copy-to-kill-ring t))) + ;;; Tools For Back-Ends @@ -2887,16 +3417,17 @@ file should have." ;; A whole set of tools is available to help build new exporters. Any ;; function general enough to have its use across many back-ends ;; should be added here. -;; -;; As of now, functions operating on footnotes, headlines, links, -;; macros, references, src-blocks, tables and tables of contents are -;; implemented. ;;;; For Affiliated Keywords ;; ;; `org-export-read-attribute' reads a property from a given element ;; as a plist. It can be used to normalize affiliated keywords' ;; syntax. +;; +;; Since captions can span over multiple lines and accept dual values, +;; their internal representation is a bit tricky. Therefore, +;; `org-export-get-caption' transparently returns a given element's +;; caption as a secondary string. (defun org-export-read-attribute (attribute element &optional property) "Turn ATTRIBUTE property from ELEMENT into a plist. @@ -2906,13 +3437,67 @@ that property within attributes. This function assumes attributes are defined as \":keyword value\" pairs. It is appropriate for `:attr_html' like -properties." - (let ((attributes - (let ((value (org-element-property attribute element))) - (and value - (read (format "(%s)" (mapconcat 'identity value " "))))))) +properties. + +All values will become strings except the empty string and +\"nil\", which will become nil. Also, values containing only +double quotes will be read as-is, which means that \"\" value +will become the empty string." + (let* ((prepare-value + (lambda (str) + (cond ((member str '(nil "" "nil")) nil) + ((string-match "^\"\\(\"+\\)?\"$" str) + (or (match-string 1 str) "")) + (t str)))) + (attributes + (let ((value (org-element-property attribute element))) + (when value + (let ((s (mapconcat 'identity value " ")) result) + (while (string-match + "\\(?:^\\|[ \t]+\\)\\(:[-a-zA-Z0-9_]+\\)\\([ \t]+\\|$\\)" + s) + (let ((value (substring s 0 (match-beginning 0)))) + (push (funcall prepare-value value) result)) + (push (intern (match-string 1 s)) result) + (setq s (substring s (match-end 0)))) + ;; Ignore any string before first property with `cdr'. + (cdr (nreverse (cons (funcall prepare-value s) result)))))))) (if property (plist-get attributes property) attributes))) +(defun org-export-get-caption (element &optional shortp) + "Return caption from ELEMENT as a secondary string. + +When optional argument SHORTP is non-nil, return short caption, +as a secondary string, instead. + +Caption lines are separated by a white space." + (let ((full-caption (org-element-property :caption element)) caption) + (dolist (line full-caption (cdr caption)) + (let ((cap (funcall (if shortp 'cdr 'car) line))) + (when cap + (setq caption (nconc (list " ") (copy-sequence cap) caption))))))) + + +;;;; For Derived Back-ends +;; +;; `org-export-with-backend' is a function allowing to locally use +;; another back-end to transcode some object or element. In a derived +;; 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) + (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))))) + (if (functionp transcoder) (funcall transcoder data contents info) + (error "No foreign transcoder available")))))) + ;;;; For Export Snippets ;; @@ -2936,7 +3521,7 @@ applied." ;; ;; `org-export-collect-footnote-definitions' is a tool to list ;; actually used footnotes definitions in the whole parse tree, or in -;; an headline, in order to add footnote listings throughout the +;; a headline, in order to add footnote listings throughout the ;; transcoded data. ;; ;; `org-export-footnote-first-reference-p' is a predicate used by some @@ -2962,22 +3547,21 @@ footnotes. Unreferenced definitions are ignored." (function (lambda (data) ;; Collect footnote number, label and definition in DATA. - (org-element-map - data 'footnote-reference - (lambda (fn) - (when (org-export-footnote-first-reference-p fn info) - (let ((def (org-export-get-footnote-definition fn info))) - (push - (list (org-export-get-footnote-number fn info) - (org-element-property :label fn) - def) - num-alist) - ;; Also search in definition for nested footnotes. - (when (eq (org-element-property :type fn) 'standard) - (funcall collect-fn def))))) - ;; Don't enter footnote definitions since it will happen - ;; when their first reference is found. - info nil 'footnote-definition))))) + (org-element-map data 'footnote-reference + (lambda (fn) + (when (org-export-footnote-first-reference-p fn info) + (let ((def (org-export-get-footnote-definition fn info))) + (push + (list (org-export-get-footnote-number fn info) + (org-element-property :label fn) + def) + num-alist) + ;; Also search in definition for nested footnotes. + (when (eq (org-element-property :type fn) 'standard) + (funcall collect-fn def))))) + ;; Don't enter footnote definitions since it will happen + ;; when their first reference is found. + info nil 'footnote-definition))))) (funcall collect-fn (plist-get info :parse-tree)) (reverse num-alist))) @@ -2995,31 +3579,33 @@ INFO is the plist used as a communication channel." (search-refs (function (lambda (data) - (org-element-map - data 'footnote-reference - (lambda (fn) - (cond - ((string= (org-element-property :label fn) label) - (throw 'exit fn)) - ;; If FN isn't inlined, be sure to traverse its - ;; definition before resuming search. See - ;; comments in `org-export-get-footnote-number' - ;; for more information. - ((eq (org-element-property :type fn) 'standard) - (funcall search-refs - (org-export-get-footnote-definition fn info))))) - ;; Don't enter footnote definitions since it will - ;; happen when their first reference is found. - info 'first-match 'footnote-definition))))) + (org-element-map data 'footnote-reference + (lambda (fn) + (cond + ((string= (org-element-property :label fn) label) + (throw 'exit fn)) + ;; If FN isn't inlined, be sure to traverse its + ;; definition before resuming search. See + ;; comments in `org-export-get-footnote-number' + ;; for more information. + ((eq (org-element-property :type fn) 'standard) + (funcall search-refs + (org-export-get-footnote-definition fn info))))) + ;; Don't enter footnote definitions since it will + ;; happen when their first reference is found. + info 'first-match 'footnote-definition))))) (eq (catch 'exit (funcall search-refs (plist-get info :parse-tree))) - footnote-reference))))) + footnote-reference))))) (defun org-export-get-footnote-definition (footnote-reference info) "Return definition of FOOTNOTE-REFERENCE as parsed data. -INFO is the plist used as a communication channel." +INFO is the plist used as a communication channel. If no such +definition can be found, return the \"DEFINITION NOT FOUND\" +string." (let ((label (org-element-property :label footnote-reference))) (or (org-element-property :inline-definition footnote-reference) - (cdr (assoc label (plist-get info :footnote-definition-alist)))))) + (cdr (assoc label (plist-get info :footnote-definition-alist))) + "DEFINITION NOT FOUND."))) (defun org-export-get-footnote-number (footnote info) "Return number associated to a footnote. @@ -3034,38 +3620,38 @@ INFO is the plist used as a communication channel." (lambda (data) ;; Search footnote references through DATA, filling ;; SEEN-REFS along the way. - (org-element-map - data 'footnote-reference - (lambda (fn) - (let ((fn-lbl (org-element-property :label fn))) - (cond - ;; Anonymous footnote match: return number. - ((and (not fn-lbl) (eq fn footnote)) - (throw 'exit (1+ (length seen-refs)))) - ;; Labels match: return number. - ((and label (string= label fn-lbl)) - (throw 'exit (1+ (length seen-refs)))) - ;; Anonymous footnote: it's always a new one. Also, - ;; be sure to return nil from the `cond' so - ;; `first-match' doesn't get us out of the loop. - ((not fn-lbl) (push 'inline seen-refs) nil) - ;; Label not seen so far: add it so SEEN-REFS. - ;; - ;; Also search for subsequent references in - ;; footnote definition so numbering follows reading - ;; logic. Note that we don't have to care about - ;; inline definitions, since `org-element-map' - ;; already traverses them at the right time. - ;; - ;; Once again, return nil to stay in the loop. - ((not (member fn-lbl seen-refs)) - (push fn-lbl seen-refs) - (funcall search-ref - (org-export-get-footnote-definition fn info)) - nil)))) - ;; Don't enter footnote definitions since it will happen - ;; when their first reference is found. - info 'first-match 'footnote-definition))))) + (org-element-map data 'footnote-reference + (lambda (fn) + (let ((fn-lbl (org-element-property :label fn))) + (cond + ;; Anonymous footnote match: return number. + ((and (not fn-lbl) (eq fn footnote)) + (throw 'exit (1+ (length seen-refs)))) + ;; Labels match: return number. + ((and label (string= label fn-lbl)) + (throw 'exit (1+ (length seen-refs)))) + ;; Anonymous footnote: it's always a new one. + ;; Also, be sure to return nil from the `cond' so + ;; `first-match' doesn't get us out of the loop. + ((not fn-lbl) (push 'inline seen-refs) nil) + ;; Label not seen so far: add it so SEEN-REFS. + ;; + ;; Also search for subsequent references in + ;; footnote definition so numbering follows + ;; reading logic. Note that we don't have to care + ;; about inline definitions, since + ;; `org-element-map' already traverses them at the + ;; right time. + ;; + ;; Once again, return nil to stay in the loop. + ((not (member fn-lbl seen-refs)) + (push fn-lbl seen-refs) + (funcall search-ref + (org-export-get-footnote-definition fn info)) + nil)))) + ;; Don't enter footnote definitions since it will + ;; happen when their first reference is found. + info 'first-match 'footnote-definition))))) (catch 'exit (funcall search-ref (plist-get info :parse-tree))))) @@ -3081,6 +3667,14 @@ INFO is the plist used as a communication channel." ;; `org-export-low-level-p', `org-export-first-sibling-p' and ;; `org-export-last-sibling-p' are three useful predicates when it ;; comes to fulfill the `:headline-levels' property. +;; +;; `org-export-get-tags', `org-export-get-category' and +;; `org-export-get-node-property' extract useful information from an +;; headline or a parent headline. They all handle inheritance. +;; +;; `org-export-get-alt-title' tries to retrieve an alternative title, +;; as a secondary string, suitable for table of contents. It falls +;; back onto default title. (defun org-export-get-relative-level (headline info) "Return HEADLINE relative level within current parsed tree. @@ -3131,7 +3725,7 @@ INFO is a plist used as a communication channel." (pop roman))) res))) -(defun org-export-get-tags (element info &optional tags) +(defun org-export-get-tags (element info &optional tags inherited) "Return list of tags associated to ELEMENT. ELEMENT has either an `headline' or an `inlinetask' type. INFO @@ -3141,11 +3735,85 @@ Select tags (see `org-export-select-tags') and exclude tags (see `org-export-exclude-tags') are removed from the list. When non-nil, optional argument TAGS should be a list of strings. -Any tag belonging to this list will also be removed." - (org-remove-if (lambda (tag) (or (member tag (plist-get info :select-tags)) - (member tag (plist-get info :exclude-tags)) - (member tag tags))) - (org-element-property :tags element))) +Any tag belonging to this list will also be removed. + +When optional argument INHERITED is non-nil, tags can also be +inherited from parent headlines and FILETAGS keywords." + (org-remove-if + (lambda (tag) (or (member tag (plist-get info :select-tags)) + (member tag (plist-get info :exclude-tags)) + (member tag tags))) + (if (not inherited) (org-element-property :tags element) + ;; Build complete list of inherited tags. + (let ((current-tag-list (org-element-property :tags element))) + (mapc + (lambda (parent) + (mapc + (lambda (tag) + (when (and (memq (org-element-type parent) '(headline inlinetask)) + (not (member tag current-tag-list))) + (push tag current-tag-list))) + (org-element-property :tags parent))) + (org-export-get-genealogy element)) + ;; Add FILETAGS keywords and return results. + (org-uniquify (append (plist-get info :filetags) current-tag-list)))))) + +(defun org-export-get-node-property (property blob &optional inherited) + "Return node PROPERTY value for BLOB. + +PROPERTY is an upcase symbol (i.e. `:COOKIE_DATA'). BLOB is an +element or object. + +If optional argument INHERITED is non-nil, the value can be +inherited from a parent headline. + +Return value is a string or nil." + (let ((headline (if (eq (org-element-type blob) 'headline) blob + (org-export-get-parent-headline blob)))) + (if (not inherited) (org-element-property property blob) + (let ((parent headline) value) + (catch 'found + (while parent + (when (plist-member (nth 1 parent) property) + (throw 'found (org-element-property property parent))) + (setq parent (org-element-property :parent parent)))))))) + +(defun org-export-get-category (blob info) + "Return category for element or object BLOB. + +INFO is a plist used as a communication channel. + +CATEGORY is automatically inherited from a parent headline, from +#+CATEGORY: keyword or created out of original file name. If all +fail, the fall-back value is \"???\"." + (or (let ((headline (if (eq (org-element-type blob) 'headline) blob + (org-export-get-parent-headline blob)))) + ;; Almost like `org-export-node-property', but we cannot trust + ;; `plist-member' as every headline has a `:CATEGORY' + ;; property, would it be nil or equal to "???" (which has the + ;; same meaning). + (let ((parent headline) value) + (catch 'found + (while parent + (let ((category (org-element-property :CATEGORY parent))) + (and category (not (equal "???" category)) + (throw 'found category))) + (setq parent (org-element-property :parent parent)))))) + (org-element-map (plist-get info :parse-tree) 'keyword + (lambda (kwd) + (when (equal (org-element-property :key kwd) "CATEGORY") + (org-element-property :value kwd))) + info 'first-match) + (let ((file (plist-get info :input-file))) + (and file (file-name-sans-extension (file-name-nondirectory file)))) + "???")) + +(defun org-export-get-alt-title (headline info) + "Return alternative title for HEADLINE, as a secondary string. +INFO is a plist used as a communication channel. If no optional +title is defined, fall-back to the regular title." + (or (org-element-property :alt-title headline) + (org-element-property :title headline))) (defun org-export-first-sibling-p (headline info) "Non-nil when HEADLINE is the first sibling in its sub-tree. @@ -3159,6 +3827,32 @@ INFO is a plist used as a communication channel." (not (org-export-get-next-element headline info))) +;;;; For Keywords +;; +;; `org-export-get-date' returns a date appropriate for the document +;; to about to be exported. In particular, it takes care of +;; `org-export-date-timestamp-format'. + +(defun org-export-get-date (info &optional fmt) + "Return date value for the current document. + +INFO is a plist used as a communication channel. FMT, when +non-nil, is a time format string that will be applied on the date +if it consists in a single timestamp object. It defaults to +`org-export-date-timestamp-format' when nil. + +A proper date can be a secondary string, a string or nil. It is +meant to be translated with `org-export-data' or alike." + (let ((date (plist-get info :date)) + (fmt (or fmt org-export-date-timestamp-format))) + (cond ((not date) nil) + ((and fmt + (not (cdr date)) + (eq (org-element-type (car date)) 'timestamp)) + (org-timestamp-format (car date) fmt)) + (t date)))) + + ;;;; For Links ;; ;; `org-export-solidify-link-text' turns a string into a safer version @@ -3185,7 +3879,7 @@ INFO is a plist used as a communication channel." (defun org-export-solidify-link-text (s) "Take link text S and make a safe target out of it." (save-match-data - (mapconcat 'identity (org-split-string s "[^a-zA-Z0-9_.-]+") "-"))) + (mapconcat 'identity (org-split-string s "[^a-zA-Z0-9_.-:]+") "-"))) (defun org-export-get-coderef-format (path desc) "Return format string for code reference link. @@ -3231,26 +3925,25 @@ INFO is a plist used as a communication channel. Return associated line number in source code, or REF itself, depending on src-block or example element's switches." - (org-element-map - (plist-get info :parse-tree) '(example-block src-block) - (lambda (el) - (with-temp-buffer - (insert (org-trim (org-element-property :value el))) - (let* ((label-fmt (regexp-quote - (or (org-element-property :label-fmt el) - org-coderef-label-format))) - (ref-re - (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$" - (replace-regexp-in-string "%s" ref label-fmt nil t)))) - ;; Element containing REF is found. Resolve it to either - ;; a label or a line number, as needed. - (when (re-search-backward ref-re nil t) - (cond - ((org-element-property :use-labels el) ref) - ((eq (org-element-property :number-lines el) 'continued) - (+ (org-export-get-loc el info) (line-number-at-pos))) - (t (line-number-at-pos))))))) - info 'first-match)) + (org-element-map (plist-get info :parse-tree) '(example-block src-block) + (lambda (el) + (with-temp-buffer + (insert (org-trim (org-element-property :value el))) + (let* ((label-fmt (regexp-quote + (or (org-element-property :label-fmt el) + org-coderef-label-format))) + (ref-re + (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$" + (replace-regexp-in-string "%s" ref label-fmt nil t)))) + ;; Element containing REF is found. Resolve it to either + ;; a label or a line number, as needed. + (when (re-search-backward ref-re nil t) + (cond + ((org-element-property :use-labels el) ref) + ((eq (org-element-property :number-lines el) 'continued) + (+ (org-export-get-loc el info) (line-number-at-pos))) + (t (line-number-at-pos))))))) + info 'first-match)) (defun org-export-resolve-fuzzy-link (link info) "Return LINK destination. @@ -3259,8 +3952,7 @@ INFO is a plist holding contextual information. Return value can be an object, an element, or nil: -- If LINK path matches a target object (i.e. <>) or - element (i.e. \"#+TARGET: path\"), return it. +- If LINK path matches a target object (i.e. <>) return it. - If LINK path exactly matches the name affiliated keyword \(i.e. #+NAME: path) of an element, return that element. @@ -3272,45 +3964,56 @@ Return value can be an object, an element, or nil: - Otherwise, return nil. -Assume LINK type is \"fuzzy\"." - (let* ((path (org-element-property :path link)) - (match-title-p (eq (aref path 0) ?*))) +Assume LINK type is \"fuzzy\". White spaces are not +significant." + (let* ((raw-path (org-element-property :path link)) + (match-title-p (eq (aref raw-path 0) ?*)) + ;; Split PATH at white spaces so matches are space + ;; insensitive. + (path (org-split-string + (if match-title-p (substring raw-path 1) raw-path)))) (cond ;; First try to find a matching "<>" unless user specified - ;; he was looking for an headline (path starts with a * + ;; he was looking for a headline (path starts with a "*" ;; character). ((and (not match-title-p) - (loop for target in (plist-get info :target-list) - when (string= (org-element-property :value target) path) - return target))) + (org-element-map (plist-get info :parse-tree) 'target + (lambda (blob) + (and (equal (org-split-string (org-element-property :value blob)) + path) + blob)) + info t))) ;; Then try to find an element with a matching "#+NAME: path" ;; affiliated keyword. ((and (not match-title-p) - (org-element-map - (plist-get info :parse-tree) org-element-all-elements - (lambda (el) - (when (string= (org-element-property :name el) path) el)) - info 'first-match))) - ;; Last case: link either points to an headline or to - ;; nothingness. Try to find the source, with priority given to - ;; headlines with the closest common ancestor. If such candidate - ;; is found, return it, otherwise return nil. + (org-element-map (plist-get info :parse-tree) + org-element-all-elements + (lambda (el) + (let ((name (org-element-property :name el))) + (when (and name (equal (org-split-string name) path)) el))) + info 'first-match))) + ;; Last case: link either points to a headline or to nothingness. + ;; Try to find the source, with priority given to headlines with + ;; the closest common ancestor. If such candidate is found, + ;; return it, otherwise return nil. (t (let ((find-headline (function - ;; Return first headline whose `:raw-value' property - ;; is NAME in parse tree DATA, or nil. + ;; Return first headline whose `:raw-value' property is + ;; NAME in parse tree DATA, or nil. Statistics cookies + ;; are ignored. (lambda (name data) - (org-element-map - data 'headline - (lambda (headline) - (when (string= - (org-element-property :raw-value headline) - name) - headline)) - info 'first-match))))) - ;; Search among headlines sharing an ancestor with link, - ;; from closest to farthest. + (org-element-map data 'headline + (lambda (headline) + (when (equal (org-split-string + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (org-element-property :raw-value headline))) + name) + headline)) + info 'first-match))))) + ;; Search among headlines sharing an ancestor with link, from + ;; closest to farthest. (or (catch 'exit (mapc (lambda (parent) @@ -3318,10 +4021,8 @@ Assume LINK type is \"fuzzy\"." (let ((foundp (funcall find-headline path parent))) (when foundp (throw 'exit foundp))))) (org-export-get-genealogy link)) nil) - ;; No match with a common ancestor: try the full parse-tree. - (funcall find-headline - (if match-title-p (substring path 1) path) - (plist-get info :parse-tree)))))))) + ;; No match with a common ancestor: try full parse-tree. + (funcall find-headline path (plist-get info :parse-tree)))))))) (defun org-export-resolve-id-link (link info) "Return headline referenced as LINK destination. @@ -3333,13 +4034,12 @@ tree, a file name or nil. Assume LINK type is either \"id\" or \"custom-id\"." (let ((id (org-element-property :path link))) ;; First check if id is within the current parse tree. - (or (org-element-map - (plist-get info :parse-tree) 'headline - (lambda (headline) - (when (or (string= (org-element-property :id headline) id) - (string= (org-element-property :custom-id headline) id)) - headline)) - info 'first-match) + (or (org-element-map (plist-get info :parse-tree) 'headline + (lambda (headline) + (when (or (string= (org-element-property :ID headline) id) + (string= (org-element-property :CUSTOM_ID headline) id)) + headline)) + info 'first-match) ;; Otherwise, look for external files. (cdr (assoc id (plist-get info :id-alist)))))) @@ -3351,40 +4051,12 @@ INFO is a plist used as a communication channel. Return value can be a radio-target object or nil. Assume LINK has type \"radio\"." (let ((path (org-element-property :path link))) - (org-element-map - (plist-get info :parse-tree) 'radio-target - (lambda (radio) - (when (equal (org-element-property :value radio) path) radio)) - info 'first-match))) - - -;;;; For Macros -;; -;; `org-export-expand-macro' simply takes care of expanding macros. - -(defun org-export-expand-macro (macro info) - "Expand MACRO and return it as a string. -INFO is a plist holding export options." - (let* ((key (org-element-property :key macro)) - (args (org-element-property :args macro)) - ;; User's macros are stored in the communication channel with - ;; a ":macro-" prefix. Replace arguments in VALUE. Also - ;; expand recursively macros within. - (value (org-export-data - (mapcar - (lambda (obj) - (if (not (stringp obj)) (org-export-data obj info) - (replace-regexp-in-string - "\\$[0-9]+" - (lambda (arg) - (nth (1- (string-to-number (substring arg 1))) args)) - obj))) - (plist-get info (intern (format ":macro-%s" key)))) - info))) - ;; VALUE starts with "(eval": it is a s-exp, `eval' it. - (when (string-match "\\`(eval\\>" value) (setq value (eval (read value)))) - ;; Return string. - (format "%s" (or value "")))) + (org-element-map (plist-get info :parse-tree) 'radio-target + (lambda (radio) + (and (compare-strings + (org-element-property :value radio) 0 nil path 0 nil t) + radio)) + info 'first-match))) ;;;; For References @@ -3408,50 +4080,47 @@ accepts two arguments: the element or object being considered and the plist used as a communication channel. This allows to count only a certain type of objects (i.e. inline images). -Return value is a list of numbers if ELEMENT is an headline or an +Return value is a list of numbers if ELEMENT is a headline or an item. It is nil for keywords. It represents the footnote number for footnote definitions and footnote references. If ELEMENT is a target, return the same value as if ELEMENT was the closest table, item or headline containing the target. In any other case, return the sequence number of ELEMENT among elements or objects of the same type." - ;; A target keyword, representing an invisible target, never has - ;; a sequence number. - (unless (eq (org-element-type element) 'keyword) - ;; Ordinal of a target object refer to the ordinal of the closest - ;; table, item, or headline containing the object. - (when (eq (org-element-type element) 'target) - (setq element - (loop for parent in (org-export-get-genealogy element) - when - (memq - (org-element-type parent) - '(footnote-definition footnote-reference headline item - table)) - return parent))) - (case (org-element-type element) - ;; Special case 1: An headline returns its number as a list. - (headline (org-export-get-headline-number element info)) - ;; Special case 2: An item returns its number as a list. - (item (let ((struct (org-element-property :structure element))) - (org-list-get-item-number - (org-element-property :begin element) - struct - (org-list-prevs-alist struct) - (org-list-parents-alist struct)))) - ((footnote-definition footnote-reference) - (org-export-get-footnote-number element info)) - (otherwise - (let ((counter 0)) - ;; Increment counter until ELEMENT is found again. - (org-element-map - (plist-get info :parse-tree) (or types (org-element-type element)) - (lambda (el) - (cond - ((eq element el) (1+ counter)) - ((not predicate) (incf counter) nil) - ((funcall predicate el info) (incf counter) nil))) - info 'first-match)))))) + ;; Ordinal of a target object refer to the ordinal of the closest + ;; table, item, or headline containing the object. + (when (eq (org-element-type element) 'target) + (setq element + (loop for parent in (org-export-get-genealogy element) + when + (memq + (org-element-type parent) + '(footnote-definition footnote-reference headline item + table)) + return parent))) + (case (org-element-type element) + ;; Special case 1: A headline returns its number as a list. + (headline (org-export-get-headline-number element info)) + ;; Special case 2: An item returns its number as a list. + (item (let ((struct (org-element-property :structure element))) + (org-list-get-item-number + (org-element-property :begin element) + struct + (org-list-prevs-alist struct) + (org-list-parents-alist struct)))) + ((footnote-definition footnote-reference) + (org-export-get-footnote-number element info)) + (otherwise + (let ((counter 0)) + ;; Increment counter until ELEMENT is found again. + (org-element-map (plist-get info :parse-tree) + (or types (org-element-type element)) + (lambda (el) + (cond + ((eq element el) (1+ counter)) + ((not predicate) (incf counter) nil) + ((funcall predicate el info) (incf counter) nil))) + info 'first-match))))) ;;;; For Src-Blocks @@ -3483,25 +4152,24 @@ INFO is the plist used as a communication channel. ELEMENT is excluded from count." (let ((loc 0)) - (org-element-map - (plist-get info :parse-tree) - `(src-block example-block ,(org-element-type element)) - (lambda (el) - (cond - ;; ELEMENT is reached: Quit the loop. - ((eq el element)) - ;; Only count lines from src-block and example-block elements - ;; with a "+n" or "-n" switch. A "-n" switch resets counter. - ((not (memq (org-element-type el) '(src-block example-block))) nil) - ((let ((linums (org-element-property :number-lines el))) - (when linums - ;; Accumulate locs or reset them. - (let ((lines (org-count-lines - (org-trim (org-element-property :value el))))) - (setq loc (if (eq linums 'new) lines (+ loc lines)))))) - ;; Return nil to stay in the loop. - nil))) - info 'first-match) + (org-element-map (plist-get info :parse-tree) + `(src-block example-block ,(org-element-type element)) + (lambda (el) + (cond + ;; ELEMENT is reached: Quit the loop. + ((eq el element)) + ;; Only count lines from src-block and example-block elements + ;; with a "+n" or "-n" switch. A "-n" switch resets counter. + ((not (memq (org-element-type el) '(src-block example-block))) nil) + ((let ((linums (org-element-property :number-lines el))) + (when linums + ;; Accumulate locs or reset them. + (let ((lines (org-count-lines + (org-trim (org-element-property :value el))))) + (setq loc (if (eq linums 'new) lines (+ loc lines)))))) + ;; Return nil to stay in the loop. + nil))) + info 'first-match) ;; Return value. loc)) @@ -3520,7 +4188,7 @@ line (string)." (code (let ((c (replace-regexp-in-string "\\`\\([ \t]*\n\\)+" "" (replace-regexp-in-string - "\\(:?[ \t]*\n\\)*[ \t]*\\'" "\n" + "\\([ \t]*\n\\)*[ \t]*\\'" "\n" (org-element-property :value element))))) ;; If appropriate, remove global indentation. (if (or org-src-preserve-indentation @@ -3595,37 +4263,38 @@ code." ;; Extract code and references. (let* ((code-info (org-export-unravel-code element)) (code (car code-info)) - (code-lines (org-split-string code "\n")) - (refs (and (org-element-property :retain-labels element) - (cdr code-info))) - ;; Handle line numbering. - (num-start (case (org-element-property :number-lines element) - (continued (org-export-get-loc element info)) - (new 0))) - (num-fmt - (and num-start - (format "%%%ds " - (length (number-to-string - (+ (length code-lines) num-start)))))) - ;; Prepare references display, if required. Any reference - ;; should start six columns after the widest line of code, - ;; wrapped with parenthesis. - (max-width - (+ (apply 'max (mapcar 'length code-lines)) - (if (not num-start) 0 (length (format num-fmt num-start)))))) - (org-export-format-code - code - (lambda (loc line-num ref) - (let ((number-str (and num-fmt (format num-fmt line-num)))) - (concat - number-str - loc - (and ref - (concat (make-string - (- (+ 6 max-width) - (+ (length loc) (length number-str))) ? ) - (format "(%s)" ref)))))) - num-start refs))) + (code-lines (org-split-string code "\n"))) + (if (null code-lines) "" + (let* ((refs (and (org-element-property :retain-labels element) + (cdr code-info))) + ;; Handle line numbering. + (num-start (case (org-element-property :number-lines element) + (continued (org-export-get-loc element info)) + (new 0))) + (num-fmt + (and num-start + (format "%%%ds " + (length (number-to-string + (+ (length code-lines) num-start)))))) + ;; Prepare references display, if required. Any reference + ;; should start six columns after the widest line of code, + ;; wrapped with parenthesis. + (max-width + (+ (apply 'max (mapcar 'length code-lines)) + (if (not num-start) 0 (length (format num-fmt num-start)))))) + (org-export-format-code + code + (lambda (loc line-num ref) + (let ((number-str (and num-fmt (format num-fmt line-num)))) + (concat + number-str + loc + (and ref + (concat (make-string + (- (+ 6 max-width) + (+ (length loc) (length number-str))) ? ) + (format "(%s)" ref)))))) + num-start refs))))) ;;;; For Tables @@ -3677,22 +4346,21 @@ All special columns will be ignored during export." (eq special-column-p 'special)))) (defun org-export-table-has-header-p (table info) - "Non-nil when TABLE has an header. + "Non-nil when TABLE has a header. INFO is a plist used as a communication channel. -A table has an header when it contains at least two row groups." +A table has a header when it contains at least two row groups." (let ((rowgroup 1) row-flag) - (org-element-map - table 'table-row - (lambda (row) - (cond - ((> rowgroup 1) t) - ((and row-flag (eq (org-element-property :type row) 'rule)) - (incf rowgroup) (setq row-flag nil)) - ((and (not row-flag) (eq (org-element-property :type row) 'standard)) - (setq row-flag t) nil))) - info))) + (org-element-map table 'table-row + (lambda (row) + (cond + ((> rowgroup 1) t) + ((and row-flag (eq (org-element-property :type row) 'rule)) + (incf rowgroup) (setq row-flag nil)) + ((and (not row-flag) (eq (org-element-property :type row) 'standard)) + (setq row-flag t) nil))) + info))) (defun org-export-table-row-is-special-p (table-row info) "Non-nil if TABLE-ROW is considered special. @@ -3735,8 +4403,8 @@ All special rows will be ignored during export." INFO is a plist used as the communication channel. -Return value is the group number, as an integer, or nil special -rows and table rules. Group 1 is also table's header." +Return value is the group number, as an integer, or nil for +special rows and table rules. Group 1 is also table's header." (unless (or (eq (org-element-property :type table-row) 'rule) (org-export-table-row-is-special-p table-row info)) (let ((group 0) row-flag) @@ -3802,7 +4470,8 @@ Possible values are `left', `right' and `center'." (table (org-export-get-parent-table table-cell)) (number-cells 0) (total-cells 0) - cookie-align) + cookie-align + previous-cell-number-p) (mapc (lambda (row) (cond @@ -3832,7 +4501,11 @@ Possible values are `left', `right' and `center'." (elt (org-element-contents row) column)) info))) (incf total-cells) - (when (string-match org-table-number-regexp value) + ;; Treat an empty cell as a number if it follows a number + (if (not (or (string-match org-table-number-regexp value) + (and (string= value "") previous-cell-number-p))) + (setq previous-cell-number-p nil) + (setq previous-cell-number-p t) (incf number-cells)))))) (org-element-contents table)) ;; Return value. Alignment specified by cookies has precedence @@ -3939,10 +4612,9 @@ INFO is a plist used as a communication channel." ;; A cell starts a column group either when it is at the beginning ;; of a row (or after the special column, if any) or when it has ;; a left border. - (or (eq (org-element-map - (org-export-get-parent table-cell) - 'table-cell 'identity info 'first-match) - table-cell) + (or (eq (org-element-map (org-export-get-parent table-cell) 'table-cell + 'identity info 'first-match) + table-cell) (memq 'left (org-export-table-cell-borders table-cell info)))) (defun org-export-table-cell-ends-colgroup-p (table-cell info) @@ -3989,6 +4661,21 @@ INFO is a plist used as a communication channel." (org-export-table-row-ends-rowgroup-p table-row info) (= (org-export-table-row-group table-row info) 1))) +(defun org-export-table-row-number (table-row info) + "Return TABLE-ROW number. +INFO is a plist used as a communication channel. Return value is +zero-based and ignores separators. The function returns nil for +special colums and separators." + (when (and (eq (org-element-property :type table-row) 'standard) + (not (org-export-table-row-is-special-p table-row info))) + (let ((number 0)) + (org-element-map (org-export-get-parent-table table-row) 'table-row + (lambda (row) + (cond ((eq row table-row) number) + ((eq (org-element-property :type row) 'standard) + (incf number) nil))) + info 'first-match)))) + (defun org-export-table-dimensions (table info) "Return TABLE dimensions. @@ -3999,12 +4686,11 @@ ROWS (resp. COLUMNS) is the number of exportable rows (resp. columns)." (let (first-row (columns 0) (rows 0)) ;; Set number of rows, and extract first one. - (org-element-map - table 'table-row - (lambda (row) - (when (eq (org-element-property :type row) 'standard) - (incf rows) - (unless first-row (setq first-row row)))) info) + (org-element-map table 'table-row + (lambda (row) + (when (eq (org-element-property :type row) 'standard) + (incf rows) + (unless first-row (setq first-row row)))) info) ;; Set number of columns. (org-element-map first-row 'table-cell (lambda (cell) (incf columns)) info) ;; Return value. @@ -4027,21 +4713,13 @@ function returns nil for other cells." (eq (car (org-element-contents table-row)) table-cell))) (cons ;; Row number. - (let ((row-count 0)) - (org-element-map - table 'table-row - (lambda (row) - (cond ((eq (org-element-property :type row) 'rule) nil) - ((eq row table-row) row-count) - (t (incf row-count) nil))) - info 'first-match)) + (org-export-table-row-number (org-export-get-parent table-cell) info) ;; Column number. (let ((col-count 0)) - (org-element-map - table-row 'table-cell - (lambda (cell) - (if (eq cell table-cell) col-count (incf col-count) nil)) - info 'first-match)))))) + (org-element-map table-row 'table-cell + (lambda (cell) + (if (eq cell table-cell) col-count (incf col-count) nil)) + info 'first-match)))))) (defun org-export-get-table-cell-at (address table info) "Return regular table-cell object at ADDRESS in TABLE. @@ -4054,20 +4732,19 @@ If no table-cell, among exportable cells, is found at ADDRESS, return nil." (let ((column-pos (cdr address)) (column-count 0)) (org-element-map - ;; Row at (car address) or nil. - (let ((row-pos (car address)) (row-count 0)) - (org-element-map - table 'table-row - (lambda (row) - (cond ((eq (org-element-property :type row) 'rule) nil) - ((= row-count row-pos) row) - (t (incf row-count) nil))) - info 'first-match)) - 'table-cell - (lambda (cell) - (if (= column-count column-pos) cell - (incf column-count) nil)) - info 'first-match))) + ;; Row at (car address) or nil. + (let ((row-pos (car address)) (row-count 0)) + (org-element-map table 'table-row + (lambda (row) + (cond ((eq (org-element-property :type row) 'rule) nil) + ((= row-count row-pos) row) + (t (incf row-count) nil))) + info 'first-match)) + 'table-cell + (lambda (cell) + (if (= column-count column-pos) cell + (incf column-count) nil)) + info 'first-match))) ;;;; For Tables Of Contents @@ -4091,16 +4768,16 @@ the table of contents. Otherwise, it is set to the value of the last headline level. See `org-export-headline-levels' for more information. -Return a list of all exportable headlines as parsed elements." +Return a list of all exportable headlines as parsed elements. +Footnote sections, if any, will be ignored." (unless (wholenump n) (setq n (plist-get info :headline-levels))) - (org-element-map - (plist-get info :parse-tree) - 'headline - (lambda (headline) - ;; Strip contents from HEADLINE. - (let ((relative-level (org-export-get-relative-level headline info))) - (unless (> relative-level n) headline))) - info)) + (org-element-map (plist-get info :parse-tree) 'headline + (lambda (headline) + (unless (org-element-property :footnote-section-p headline) + ;; Strip contents from HEADLINE. + (let ((relative-level (org-export-get-relative-level headline info))) + (unless (> relative-level n) headline)))) + info)) (defun org-export-collect-elements (type info &optional predicate) "Collect referenceable elements of a determined type. @@ -4115,13 +4792,12 @@ one argument, an element of type TYPE. It returns a non-nil value when that element should be collected. Return a list of all elements found, in order of appearance." - (org-element-map - (plist-get info :parse-tree) type - (lambda (element) - (and (org-element-property :caption element) - (or (not predicate) (funcall predicate element)) - element)) - info)) + (org-element-map (plist-get info :parse-tree) type + (lambda (element) + (and (org-element-property :caption element) + (or (not predicate) (funcall predicate element)) + element)) + info)) (defun org-export-collect-tables (info) "Build a list of tables. @@ -4154,6 +4830,207 @@ Return a list of src-block elements with a caption." (org-export-collect-elements 'src-block info)) +;;;; Smart Quotes +;; +;; The main function for the smart quotes sub-system is +;; `org-export-activate-smart-quotes', which replaces every quote in +;; a given string from the parse tree with its "smart" counterpart. +;; +;; Dictionary for smart quotes is stored in +;; `org-export-smart-quotes-alist'. +;; +;; Internally, regexps matching potential smart quotes (checks at +;; string boundaries are also necessary) are defined in +;; `org-export-smart-quotes-regexps'. + +(defconst org-export-smart-quotes-alist + '(("de" + (opening-double-quote :utf-8 "„" :html "„" :latex "\"`" + :texinfo "@quotedblbase{}") + (closing-double-quote :utf-8 "“" :html "“" :latex "\"'" + :texinfo "@quotedblleft{}") + (opening-single-quote :utf-8 "‚" :html "‚" :latex "\\glq{}" + :texinfo "@quotesinglbase{}") + (closing-single-quote :utf-8 "‘" :html "‘" :latex "\\grq{}" + :texinfo "@quoteleft{}") + (apostrophe :utf-8 "’" :html "’")) + ("en" + (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 "’")) + ("es" + (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 "’")) + ("fr" + (opening-double-quote :utf-8 "« " :html "« " :latex "\\og " + :texinfo "@guillemetleft{}@tie{}") + (closing-double-quote :utf-8 " »" :html " »" :latex "\\fg{}" + :texinfo "@tie{}@guillemetright{}") + (opening-single-quote :utf-8 "« " :html "« " :latex "\\og " + :texinfo "@guillemetleft{}@tie{}") + (closing-single-quote :utf-8 " »" :html " »" :latex "\\fg{}" + :texinfo "@tie{}@guillemetright{}") + (apostrophe :utf-8 "’" :html "’"))) + "Smart quotes translations. + +Alist whose CAR is a language string and CDR is an alist with +quote type as key and a plist associating various encodings to +their translation as value. + +A quote type can be any symbol among `opening-double-quote', +`closing-double-quote', `opening-single-quote', +`closing-single-quote' and `apostrophe'. + +Valid encodings include `:utf-8', `:html', `:latex' and +`:texinfo'. + +If no translation is found, the quote character is left as-is.") + +(defconst org-export-smart-quotes-regexps + (list + ;; Possible opening quote at beginning of string. + "\\`\\([\"']\\)\\(\\w\\|\\s.\\|\\s_\\)" + ;; Possible closing quote at beginning of string. + "\\`\\([\"']\\)\\(\\s-\\|\\s)\\|\\s.\\)" + ;; Possible apostrophe at beginning of string. + "\\`\\('\\)\\S-" + ;; Opening single and double quotes. + "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\(?:\\w\\|\\s.\\|\\s_\\)" + ;; Closing single and double quotes. + "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\(?:\\s-\\|\\s)\\|\\s.\\)" + ;; Apostrophe. + "\\S-\\('\\)\\S-" + ;; Possible opening quote at end of string. + "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\'" + ;; Possible closing quote at end of string. + "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\'" + ;; Possible apostrophe at end of string. + "\\S-\\('\\)\\'") + "List of regexps matching a quote or an apostrophe. +In every regexp, quote or apostrophe matched is put in group 1.") + +(defun org-export-activate-smart-quotes (s encoding info &optional original) + "Replace regular quotes with \"smart\" quotes in string S. + +ENCODING is a symbol among `:html', `:latex', `:texinfo' and +`:utf-8'. INFO is a plist used as a communication channel. + +The function has to retrieve information about string +surroundings in parse tree. It can only happen with an +unmodified string. Thus, if S has already been through another +process, a non-nil ORIGINAL optional argument will provide that +original string. + +Return the new string." + (if (equal s "") "" + (let* ((prev (org-export-get-previous-element (or original s) info)) + ;; Try to be flexible when computing number of blanks + ;; before object. The previous object may be a string + ;; introduced by the back-end and not completely parsed. + (pre-blank (and prev + (or (org-element-property :post-blank prev) + ;; A string with missing `:post-blank' + ;; property. + (and (stringp prev) + (string-match " *\\'" prev) + (length (match-string 0 prev))) + ;; Fallback value. + 0))) + (next (org-export-get-next-element (or original s) info)) + (get-smart-quote + (lambda (q type) + ;; Return smart quote associated to a give quote Q, as + ;; a string. TYPE is a symbol among `open', `close' and + ;; `apostrophe'. + (let ((key (case type + (apostrophe 'apostrophe) + (open (if (equal "'" q) 'opening-single-quote + 'opening-double-quote)) + (otherwise (if (equal "'" q) 'closing-single-quote + 'closing-double-quote))))) + (or (plist-get + (cdr (assq key + (cdr (assoc (plist-get info :language) + org-export-smart-quotes-alist)))) + encoding) + q))))) + (if (or (equal "\"" s) (equal "'" s)) + ;; Only a quote: no regexp can match. We have to check both + ;; sides and decide what to do. + (cond ((and (not prev) (not next)) s) + ((not prev) (funcall get-smart-quote s 'open)) + ((and (not next) (zerop pre-blank)) + (funcall get-smart-quote s 'close)) + ((not next) s) + ((zerop pre-blank) (funcall get-smart-quote s 'apostrophe)) + (t (funcall get-smart-quote 'open))) + ;; 1. Replace quote character at the beginning of S. + (cond + ;; Apostrophe? + ((and prev (zerop pre-blank) + (string-match (nth 2 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'apostrophe) + nil t s 1))) + ;; Closing quote? + ((and prev (zerop pre-blank) + (string-match (nth 1 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'close) + nil t s 1))) + ;; Opening quote? + ((and (or (not prev) (> pre-blank 0)) + (string-match (nth 0 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'open) + nil t s 1)))) + ;; 2. Replace quotes in the middle of the string. + (setq s (replace-regexp-in-string + ;; Opening quotes. + (nth 3 org-export-smart-quotes-regexps) + (lambda (text) + (funcall get-smart-quote (match-string 1 text) 'open)) + s nil t 1)) + (setq s (replace-regexp-in-string + ;; Closing quotes. + (nth 4 org-export-smart-quotes-regexps) + (lambda (text) + (funcall get-smart-quote (match-string 1 text) 'close)) + s nil t 1)) + (setq s (replace-regexp-in-string + ;; Apostrophes. + (nth 5 org-export-smart-quotes-regexps) + (lambda (text) + (funcall get-smart-quote (match-string 1 text) 'apostrophe)) + s nil t 1)) + ;; 3. Replace quote character at the end of S. + (cond + ;; Apostrophe? + ((and next (string-match (nth 8 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'apostrophe) + nil t s 1))) + ;; Closing quote? + ((and (not next) + (string-match (nth 7 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'close) + nil t s 1))) + ;; Opening quote? + ((and next (string-match (nth 6 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'open) + nil t s 1)))) + ;; Return string with smart quotes. + s)))) + ;;;; Topology ;; ;; Here are various functions to retrieve information about the @@ -4209,30 +5086,76 @@ OBJECT is either a `table-cell' or `table-element' type object." (not (eq (org-element-type parent) 'table)))) parent)) -(defun org-export-get-previous-element (blob info) +(defun org-export-get-previous-element (blob info &optional n) "Return previous element or object. + BLOB is an element or object. INFO is a plist used as a communication channel. Return previous exportable element or -object, a string, or nil." - (let (prev) +object, a string, or nil. + +When optional argument N is a positive integer, return a list +containing up to N siblings before BLOB, from farthest to +closest. With any other non-nil value, return a list containing +all of them." + (let ((siblings + ;; An object can belong to the contents of its parent or + ;; to a secondary string. We check the latter option + ;; first. + (let ((parent (org-export-get-parent blob))) + (or (and (not (memq (org-element-type blob) + org-element-all-elements)) + (let ((sec-value + (org-element-property + (cdr (assq (org-element-type parent) + org-element-secondary-value-alist)) + parent))) + (and (memq blob sec-value) sec-value))) + (org-element-contents parent)))) + prev) (catch 'exit (mapc (lambda (obj) - (cond ((eq obj blob) (throw 'exit prev)) - ((memq obj (plist-get info :ignore-list))) - (t (setq prev obj)))) - (org-element-contents (org-export-get-parent blob)))))) + (cond ((memq obj (plist-get info :ignore-list))) + ((null n) (throw 'exit obj)) + ((not (wholenump n)) (push obj prev)) + ((zerop n) (throw 'exit prev)) + (t (decf n) (push obj prev)))) + (cdr (memq blob (reverse siblings)))) + prev))) -(defun org-export-get-next-element (blob info) +(defun org-export-get-next-element (blob info &optional n) "Return next element or object. + BLOB is an element or object. INFO is a plist used as a communication channel. Return next exportable element or -object, a string, or nil." - (catch 'found - (mapc (lambda (obj) - (unless (memq obj (plist-get info :ignore-list)) - (throw 'found obj))) - (cdr (memq blob (org-element-contents (org-export-get-parent blob))))) - nil)) +object, a string, or nil. + +When optional argument N is a positive integer, return a list +containing up to N siblings after BLOB, from closest to farthest. +With any other non-nil value, return a list containing all of +them." + (let ((siblings + ;; An object can belong to the contents of its parent or to + ;; a secondary string. We check the latter option first. + (let ((parent (org-export-get-parent blob))) + (or (and (not (memq (org-element-type blob) + org-element-all-objects)) + (let ((sec-value + (org-element-property + (cdr (assq (org-element-type parent) + org-element-secondary-value-alist)) + parent))) + (cdr (memq blob sec-value)))) + (cdr (memq blob (org-element-contents parent)))))) + next) + (catch 'exit + (mapc (lambda (obj) + (cond ((memq obj (plist-get info :ignore-list))) + ((null n) (throw 'exit obj)) + ((not (wholenump n)) (push obj next)) + ((zerop n) (throw 'exit (nreverse next))) + (t (decf n) (push obj next)))) + siblings) + (nreverse next)))) ;;;; Translation @@ -4244,67 +5167,124 @@ object, a string, or nil." (defconst org-export-dictionary '(("Author" - ("fr" - :ascii "Auteur" - :latin1 "Auteur" - :utf-8 "Auteur")) + ("ca" :default "Autor") + ("cs" :default "Autor") + ("da" :default "Ophavsmand") + ("de" :default "Autor") + ("eo" :html "Aŭtoro") + ("es" :default "Autor") + ("fi" :html "Tekijä") + ("fr" :default "Auteur") + ("hu" :default "Szerzõ") + ("is" :html "Höfundur") + ("it" :default "Autore") + ("ja" :html "著者" :utf-8 "著者") + ("nl" :default "Auteur") + ("no" :default "Forfatter") + ("nb" :default "Forfatter") + ("nn" :default "Forfattar") + ("pl" :default "Autor") + ("ru" :html "Автор" :utf-8 "Автор") + ("sv" :html "Författare") + ("uk" :html "Автор" :utf-8 "Автор") + ("zh-CN" :html "作者" :utf-8 "作者") + ("zh-TW" :html "作者" :utf-8 "作者")) ("Date" - ("fr" - :ascii "Date" - :latin1 "Date" - :utf-8 "Date")) - ("Equation") + ("ca" :default "Data") + ("cs" :default "Datum") + ("da" :default "Dato") + ("de" :default "Datum") + ("eo" :default "Dato") + ("es" :default "Fecha") + ("fi" :html "Päivämäärä") + ("hu" :html "Dátum") + ("is" :default "Dagsetning") + ("it" :default "Data") + ("ja" :html "日付" :utf-8 "日付") + ("nl" :default "Datum") + ("no" :default "Dato") + ("nb" :default "Dato") + ("nn" :default "Dato") + ("pl" :default "Data") + ("ru" :html "Дата" :utf-8 "Дата") + ("sv" :default "Datum") + ("uk" :html "Дата" :utf-8 "Дата") + ("zh-CN" :html "日期" :utf-8 "日期") + ("zh-TW" :html "日期" :utf-8 "日期")) + ("Equation" + ("fr" :ascii "Equation" :default "Équation")) ("Figure") ("Footnotes" - ("fr" - :ascii "Notes de bas de page" - :latin1 "Notes de bas de page" - :utf-8 "Notes de bas de page")) + ("ca" :html "Peus de pàgina") + ("cs" :default "Pozn\xe1mky pod carou") + ("da" :default "Fodnoter") + ("de" :html "Fußnoten") + ("eo" :default "Piednotoj") + ("es" :html "Pies de página") + ("fi" :default "Alaviitteet") + ("fr" :default "Notes de bas de page") + ("hu" :html "Lábjegyzet") + ("is" :html "Aftanmálsgreinar") + ("it" :html "Note a piè di pagina") + ("ja" :html "脚注" :utf-8 "脚注") + ("nl" :default "Voetnoten") + ("no" :default "Fotnoter") + ("nb" :default "Fotnoter") + ("nn" :default "Fotnotar") + ("pl" :default "Przypis") + ("ru" :html "Сноски" :utf-8 "Сноски") + ("sv" :default "Fotnoter") + ("uk" :html "Примітки" + :utf-8 "Примітки") + ("zh-CN" :html "脚注" :utf-8 "脚注") + ("zh-TW" :html "腳註" :utf-8 "腳註")) ("List of Listings" - ("fr" - :ascii "Liste des programmes" - :latin1 "Liste des programmes" - :utf-8 "Liste des programmes")) + ("fr" :default "Liste des programmes")) ("List of Tables" - ("fr" - :ascii "Liste des tableaux" - :latin1 "Liste des tableaux" - :utf-8 "Liste des tableaux")) + ("fr" :default "Liste des tableaux")) ("Listing %d:" ("fr" - :ascii "Programme %d :" - :latin1 "Programme %d :" - :utf-8 "Programme nº %d :")) + :ascii "Programme %d :" :default "Programme nº %d :" + :latin1 "Programme %d :")) ("Listing %d: %s" ("fr" - :ascii "Programme %d : %s" - :latin1 "Programme %d : %s" - :utf-8 "Programme nº %d : %s")) + :ascii "Programme %d : %s" :default "Programme nº %d : %s" + :latin1 "Programme %d : %s")) ("See section %s" - ("fr" - :ascii "cf. section %s" - :latin1 "cf. section %s" - :utf-8 "cf. section %s")) + ("fr" :default "cf. section %s")) ("Table %d:" ("fr" - :ascii "Tableau %d :" - :latin1 "Tableau %d :" - :utf-8 "Tableau nº %d :")) + :ascii "Tableau %d :" :default "Tableau nº %d :" :latin1 "Tableau %d :")) ("Table %d: %s" ("fr" - :ascii "Tableau %d : %s" - :latin1 "Tableau %d : %s" - :utf-8 "Tableau nº %d : %s")) + :ascii "Tableau %d : %s" :default "Tableau nº %d : %s" + :latin1 "Tableau %d : %s")) ("Table of Contents" - ("fr" - :ascii "Sommaire" - :latin1 "Table des matières" - :utf-8 "Table des matières")) + ("ca" :html "Índex") + ("cs" :default "Obsah") + ("da" :default "Indhold") + ("de" :default "Inhaltsverzeichnis") + ("eo" :default "Enhavo") + ("es" :html "Índice") + ("fi" :html "Sisällysluettelo") + ("fr" :ascii "Sommaire" :default "Table des matières") + ("hu" :html "Tartalomjegyzék") + ("is" :default "Efnisyfirlit") + ("it" :default "Indice") + ("ja" :html "目次" :utf-8 "目次") + ("nl" :default "Inhoudsopgave") + ("no" :default "Innhold") + ("nb" :default "Innhold") + ("nn" :default "Innhald") + ("pl" :html "Spis treści") + ("ru" :html "Содержание" + :utf-8 "Содержание") + ("sv" :html "Innehåll") + ("uk" :html "Зміст" :utf-8 "Зміст") + ("zh-CN" :html "目录" :utf-8 "目录") + ("zh-TW" :html "目錄" :utf-8 "目錄")) ("Unknown reference" - ("fr" - :ascii "Destination inconnue" - :latin1 "Référence inconnue" - :utf-8 "Référence inconnue"))) + ("fr" :ascii "Destination inconnue" :default "Référence inconnue"))) "Dictionary for export engine. Alist whose CAR is the string to translate and CDR is an alist @@ -4322,103 +5302,363 @@ entry.") ENCODING is a symbol among `:ascii', `:html', `:latex', `:latin1' and `:utf-8'. INFO is a plist used as a communication channel. -Translation depends on `:language' property. Return the -translated string. If no translation is found return S." - (let ((lang (plist-get info :language)) - (translations (cdr (assoc s org-export-dictionary)))) - (or (plist-get (cdr (assoc lang translations)) encoding) s))) +Translation depends on `:language' property. Return the +translated string. If no translation is found, try to fall back +to `:default' encoding. If it fails, return S." + (let* ((lang (plist-get info :language)) + (translations (cdr (assoc lang + (cdr (assoc s org-export-dictionary)))))) + (or (plist-get translations encoding) + (plist-get translations :default) + s))) + + + +;;; Asynchronous Export +;; +;; `org-export-async-start' is the entry point for asynchronous +;; export. It recreates current buffer (including visibility, +;; narrowing and visited file) in an external Emacs process, and +;; evaluates a command there. It then applies a function on the +;; returned results in the current process. +;; +;; Asynchronously generated results are never displayed directly. +;; Instead, they are stored in `org-export-stack-contents'. They can +;; then be retrieved by calling `org-export-stack'. +;; +;; Export Stack is viewed through a dedicated major mode +;;`org-export-stack-mode' and tools: `org-export-stack-refresh', +;;`org-export-stack-delete', `org-export-stack-view' and +;;`org-export-stack-clear'. +;; +;; For back-ends, `org-export-add-to-stack' add a new source to stack. +;; It should used whenever `org-export-async-start' is called. + +(defmacro org-export-async-start (fun &rest body) + "Call function FUN on the results returned by BODY evaluation. + +BODY evaluation happens in an asynchronous process, from a buffer +which is an exact copy of the current one. + +Use `org-export-add-to-stack' in FUN in order to register results +in the stack. Examples for, respectively a temporary buffer and +a file are: + + \(org-export-async-start + \(lambda (output) + \(with-current-buffer (get-buffer-create \"*Org BACKEND Export*\") + \(erase-buffer) + \(insert output) + \(goto-char (point-min)) + \(org-export-add-to-stack (current-buffer) 'backend))) + `(org-export-as 'backend ,subtreep ,visible-only ,body-only ',ext-plist)) + +and + + \(org-export-async-start + \(lambda (f) (org-export-add-to-stack f 'backend)) + `(expand-file-name + \(org-export-to-file + 'backend ,outfile ,subtreep ,visible-only ,body-only ',ext-plist)))" + (declare (indent 1) (debug t)) + (org-with-gensyms (process temp-file copy-fun proc-buffer handler coding) + ;; Write the full sexp evaluating BODY in a copy of the current + ;; buffer to a temporary file, as it may be too long for program + ;; args in `start-process'. + `(with-temp-message "Initializing asynchronous export process" + (let ((,copy-fun (org-export--generate-copy-script (current-buffer))) + (,temp-file (make-temp-file "org-export-process")) + (,coding buffer-file-coding-system)) + (with-temp-file ,temp-file + (insert + ;; Null characters (from variable values) are inserted + ;; within the file. As a consequence, coding system for + ;; buffer contents will not be recognized properly. So, + ;; we make sure it is the same as the one used to display + ;; the original buffer. + (format ";; -*- coding: %s; -*-\n%S" + ,coding + `(with-temp-buffer + ,(when org-export-async-debug '(setq debug-on-error t)) + ;; Ignore `kill-emacs-hook' and code evaluation + ;; queries from Babel as we need a truly + ;; non-interactive process. + (setq kill-emacs-hook nil + org-babel-confirm-evaluate-answer-no t) + ;; Initialize export framework. + (require 'ox) + ;; Re-create current buffer there. + (funcall ,,copy-fun) + (restore-buffer-modified-p nil) + ;; Sexp to evaluate in the buffer. + (print (progn ,,@body)))))) + ;; Start external process. + (let* ((process-connection-type nil) + (,proc-buffer (generate-new-buffer-name "*Org Export Process*")) + (,process + (start-process + "org-export-process" ,proc-buffer + (expand-file-name invocation-name invocation-directory) + "-Q" "--batch" + "-l" org-export-async-init-file + "-l" ,temp-file))) + ;; Register running process in stack. + (org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process) + ;; Set-up sentinel in order to catch results. + (set-process-sentinel + ,process + (let ((handler ',fun)) + `(lambda (p status) + (let ((proc-buffer (process-buffer p))) + (when (eq (process-status p) 'exit) + (unwind-protect + (if (zerop (process-exit-status p)) + (unwind-protect + (let ((results + (with-current-buffer proc-buffer + (goto-char (point-max)) + (backward-sexp) + (read (current-buffer))))) + (funcall ,handler results)) + (unless org-export-async-debug + (and (get-buffer proc-buffer) + (kill-buffer proc-buffer)))) + (org-export-add-to-stack proc-buffer nil p) + (ding) + (message "Process '%s' exited abnormally" p)) + (unless org-export-async-debug + (delete-file ,,temp-file))))))))))))) + +(defun org-export-add-to-stack (source backend &optional process) + "Add a new result to export stack if not present already. + +SOURCE is a buffer or a file name containing export results. +BACKEND is a symbol representing export back-end used to generate +it. + +Entries already pointing to SOURCE and unavailable entries are +removed beforehand. Return the new stack." + (setq org-export-stack-contents + (cons (list source backend (or process (current-time))) + (org-export-stack-remove source)))) + +(defun org-export-stack () + "Menu for asynchronous export results and running processes." + (interactive) + (let ((buffer (get-buffer-create "*Org Export Stack*"))) + (set-buffer buffer) + (when (zerop (buffer-size)) (org-export-stack-mode)) + (org-export-stack-refresh) + (pop-to-buffer buffer)) + (message "Type \"q\" to quit, \"?\" for help")) + +(defun org-export--stack-source-at-point () + "Return source from export results at point in stack." + (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents)))) + (if (not source) (error "Source unavailable, please refresh buffer") + (let ((source-name (if (stringp source) source (buffer-name source)))) + (if (save-excursion + (beginning-of-line) + (looking-at (concat ".* +" (regexp-quote source-name) "$"))) + source + ;; SOURCE is not consistent with current line. The stack + ;; view is outdated. + (error "Source unavailable; type `g' to update buffer")))))) + +(defun org-export-stack-clear () + "Remove all entries from export stack." + (interactive) + (setq org-export-stack-contents nil)) + +(defun org-export-stack-refresh (&rest dummy) + "Refresh the asynchronous export stack. +DUMMY is ignored. Unavailable sources are removed from the list. +Return the new stack." + (let ((inhibit-read-only t)) + (org-preserve-lc + (erase-buffer) + (insert (concat + (let ((counter 0)) + (mapconcat + (lambda (entry) + (let ((proc-p (processp (nth 2 entry)))) + (concat + ;; Back-end. + (format " %-12s " (or (nth 1 entry) "")) + ;; Age. + (let ((data (nth 2 entry))) + (if proc-p (format " %6s " (process-status data)) + ;; Compute age of the results. + (org-format-seconds + "%4h:%.2m " + (float-time (time-since data))))) + ;; Source. + (format " %s" + (let ((source (car entry))) + (if (stringp source) source + (buffer-name source))))))) + ;; Clear stack from exited processes, dead buffers or + ;; non-existent files. + (setq org-export-stack-contents + (org-remove-if-not + (lambda (el) + (if (processp (nth 2 el)) + (buffer-live-p (process-buffer (nth 2 el))) + (let ((source (car el))) + (if (bufferp source) (buffer-live-p source) + (file-exists-p source))))) + org-export-stack-contents)) "\n"))))))) + +(defun org-export-stack-remove (&optional source) + "Remove export results at point from stack. +If optional argument SOURCE is non-nil, remove it instead." + (interactive) + (let ((source (or source (org-export--stack-source-at-point)))) + (setq org-export-stack-contents + (org-remove-if (lambda (el) (equal (car el) source)) + org-export-stack-contents)))) + +(defun org-export-stack-view (&optional in-emacs) + "View export results at point in stack. +With an optional prefix argument IN-EMACS, force viewing files +within Emacs." + (interactive "P") + (let ((source (org-export--stack-source-at-point))) + (cond ((processp source) + (org-switch-to-buffer-other-window (process-buffer source))) + ((bufferp source) (org-switch-to-buffer-other-window source)) + (t (org-open-file source in-emacs))))) + +(defconst org-export-stack-mode-map + (let ((km (make-sparse-keymap))) + (define-key km " " 'next-line) + (define-key km "n" 'next-line) + (define-key km "\C-n" 'next-line) + (define-key km [down] 'next-line) + (define-key km "p" 'previous-line) + (define-key km "\C-p" 'previous-line) + (define-key km "\C-?" 'previous-line) + (define-key km [up] 'previous-line) + (define-key km "C" 'org-export-stack-clear) + (define-key km "v" 'org-export-stack-view) + (define-key km (kbd "RET") 'org-export-stack-view) + (define-key km "d" 'org-export-stack-remove) + km) + "Keymap for Org Export Stack.") + +(define-derived-mode org-export-stack-mode special-mode "Org-Stack" + "Mode for displaying asynchronous export stack. + +Type \\[org-export-stack] to visualize the asynchronous export +stack. + +In an Org Export Stack buffer, use \\\\[org-export-stack-view] to view export output +on current line, \\[org-export-stack-remove] to remove it from the stack and \\[org-export-stack-clear] to clear +stack completely. + +Removing entries in an Org Export Stack buffer doesn't affect +files or buffers, only the display. + +\\{org-export-stack-mode-map}" + (abbrev-mode 0) + (auto-fill-mode 0) + (setq buffer-read-only t + buffer-undo-list t + truncate-lines t + header-line-format + '(:eval + (format " %-12s | %6s | %s" "Back-End" "Age" "Source"))) + (org-add-hook 'post-command-hook 'org-export-stack-refresh nil t) + (set (make-local-variable 'revert-buffer-function) + 'org-export-stack-refresh)) ;;; The Dispatcher ;; ;; `org-export-dispatch' is the standard interactive way to start an -;; export process. It uses `org-export-dispatch-ui' as a subroutine -;; for its interface. Most commons back-ends should have an entry in -;; it. +;; export process. It uses `org-export--dispatch-ui' as a subroutine +;; for its interface, which, in turn, delegates response to key +;; pressed to `org-export--dispatch-action'. ;;;###autoload -(defun org-export-dispatch () +(defun org-export-dispatch (&optional arg) "Export dispatcher for Org mode. It provides an access to common export related tasks in a buffer. -Its interface comes in two flavours: standard and expert. While -both share the same set of bindings, only the former displays the -valid keys associations. Set `org-export-dispatch-use-expert-ui' -to switch to one or the other. +Its interface comes in two flavours: standard and expert. -Return an error if key pressed has no associated command." - (interactive) - (let* ((input (org-export-dispatch-ui - (if (listp org-export-initial-scope) org-export-initial-scope - (list org-export-initial-scope)) - org-export-dispatch-use-expert-ui)) - (raw-key (car input)) +While both share the same set of bindings, only the former +displays the valid keys associations in a dedicated buffer. +Scrolling (resp. line-wise motion) in this buffer is done with +SPC and DEL (resp. C-n and C-p) keys. + +Set variable `org-export-dispatch-use-expert-ui' to switch to one +flavour or the other. + +When ARG is \\[universal-argument], repeat the last export action, with the same set +of options used back then, on the current buffer. + +When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack." + (interactive "P") + (let* ((input + (cond ((equal arg '(16)) '(stack)) + ((and arg org-export-dispatch-last-action)) + (t (save-window-excursion + (unwind-protect + (progn + ;; Remember where we are + (move-marker org-export-dispatch-last-position + (point) + (org-base-buffer (current-buffer))) + ;; Get and store an export command + (setq org-export-dispatch-last-action + (org-export--dispatch-ui + (list org-export-initial-scope + (and org-export-in-background 'async)) + nil + org-export-dispatch-use-expert-ui))) + (and (get-buffer "*Org Export Dispatcher*") + (kill-buffer "*Org Export Dispatcher*"))))))) + (action (car input)) (optns (cdr input))) - ;; Translate "C-a", "C-b"... into "a", "b"... Then take action - ;; depending on user's key pressed. - (case (if (< raw-key 27) (+ raw-key 96) raw-key) - ;; Allow to quit with "q" key. - (?q nil) - ;; Export with `e-ascii' back-end. - ((?A ?N ?U) - (org-e-ascii-export-as-ascii - (memq 'subtree optns) (memq 'visible optns) (memq 'body optns) - `(:ascii-charset ,(case raw-key (?A 'ascii) (?N 'latin1) (t 'utf-8))))) - ((?a ?n ?u) - (org-e-ascii-export-to-ascii - (memq 'subtree optns) (memq 'visible optns) (memq 'body optns) - `(:ascii-charset ,(case raw-key (?a 'ascii) (?n 'latin1) (t 'utf-8))))) - ;; Export with `e-latex' back-end. - (?L (org-e-latex-export-as-latex - (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) - (?l - (org-e-latex-export-to-latex - (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) - (?p - (org-e-latex-export-to-pdf - (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) - (?d - (org-open-file - (org-e-latex-export-to-pdf - (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))) - ;; Export with `e-html' back-end. - (?H - (org-e-html-export-as-html - (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) - (?h - (org-e-html-export-to-html - (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) - (?b - (org-open-file - (org-e-html-export-to-html - (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))) - ;; Export with `e-odt' back-end. - (?o - (org-e-odt-export-to-odt - (memq 'subtree optns) (memq 'visible optns) (memq 'body optns))) - (?O - (org-open-file - (org-e-odt-export-to-odt - (memq 'subtree optns) (memq 'visible optns) (memq 'body optns)))) - ;; Publishing facilities - (?F - (org-e-publish-current-file (memq 'force optns))) - (?P - (org-e-publish-current-project (memq 'force optns))) - (?X - (let ((project - (assoc (org-icompleting-read - "Publish project: " org-e-publish-project-alist nil t) - org-e-publish-project-alist))) - (org-e-publish project (memq 'force optns)))) - (?E - (org-e-publish-all (memq 'force optns))) - ;; Undefined command. - (t (error "No command associated with key %s" - (char-to-string raw-key)))))) + (unless (memq 'subtree optns) + (move-marker org-export-dispatch-last-position nil)) + (case action + ;; First handle special hard-coded actions. + (template (org-export-insert-default-template nil optns)) + (stack (org-export-stack)) + (publish-current-file + (org-publish-current-file (memq 'force optns) (memq 'async optns))) + (publish-current-project + (org-publish-current-project (memq 'force optns) (memq 'async optns))) + (publish-choose-project + (org-publish (assoc (org-icompleting-read + "Publish project: " + org-publish-project-alist nil t) + org-publish-project-alist) + (memq 'force optns) + (memq 'async optns))) + (publish-all (org-publish-all (memq 'force optns) (memq 'async optns))) + (otherwise + (save-excursion + (when arg + ;; Repeating command, maybe move cursor to restore subtree + ;; context. + (if (eq (marker-buffer org-export-dispatch-last-position) + (org-base-buffer (current-buffer))) + (goto-char org-export-dispatch-last-position) + ;; We are in a different buffer, forget position. + (move-marker org-export-dispatch-last-position nil))) + (funcall action + ;; Return a symbol instead of a list to ease + ;; asynchronous export macro use. + (and (memq 'async optns) t) + (and (memq 'subtree optns) t) + (and (memq 'visible optns) t) + (and (memq 'body optns) t))))))) -(defun org-export-dispatch-ui (options expertp) +(defun org-export--dispatch-ui (options first-key expertp) "Handle interface for `org-export-dispatch'. OPTIONS is a list containing current interactive options set for @@ -4427,87 +5667,276 @@ export. It can contain any of the following symbols: `subtree' restricts export to current subtree `visible' restricts export to visible part of buffer. `force' force publishing files. +`async' use asynchronous export process + +FIRST-KEY is the key pressed to select the first level menu. It +is nil when this menu hasn't been selected yet. EXPERTP, when non-nil, triggers expert UI. In that case, no help buffer is provided, but indications about currently active options are given in the prompt. Moreover, \[?] allows to switch -back to standard interface. - -Return value is a list with key pressed as CAR and a list of -final interactive export options as CDR." - (let ((help - (format "---- (Options) ------------------------------------------- - -\[1] Body only: %s [2] Export scope: %s -\[3] Visible only: %s [4] Force publishing: %s - - ---- (ASCII/Latin-1/UTF-8 Export) ------------------------- - -\[a/n/u] to TXT file [A/N/U] to temporary buffer - ---- (HTML Export) ---------------------------------------- - -\[h] to HTML file [b] ... and open it -\[H] to temporary buffer - ---- (LaTeX Export) --------------------------------------- - -\[l] to TEX file [L] to temporary buffer -\[p] to PDF file [d] ... and open it - ---- (ODF Export) ----------------------------------------- - -\[o] to ODT file [O] ... and open it - ---- (Publish) -------------------------------------------- - -\[F] current file [P] current project -\[X] a project [E] every project" - (if (memq 'body options) "On " "Off") - (if (memq 'subtree options) "Subtree" "Buffer ") - (if (memq 'visible options) "On " "Off") - (if (memq 'force options) "On " "Off"))) - (standard-prompt "Export command: ") - (expert-prompt (format "Export command (%s%s%s%s): " - (if (memq 'body options) "b" "-") - (if (memq 'subtree options) "s" "-") - (if (memq 'visible options) "v" "-") - (if (memq 'force options) "f" "-"))) - (handle-keypress - (function - ;; Read a character from command input, toggling interactive - ;; options when applicable. PROMPT is the displayed prompt, - ;; as a string. - (lambda (prompt) - (let ((key (read-char-exclusive prompt))) - (cond - ;; Ignore non-standard characters (i.e. "M-a"). - ((not (characterp key)) (org-export-dispatch-ui options expertp)) - ;; Help key: Switch back to standard interface if - ;; expert UI was active. - ((eq key ??) (org-export-dispatch-ui options nil)) - ;; Toggle export options. - ((memq key '(?1 ?2 ?3 ?4)) - (org-export-dispatch-ui - (let ((option (case key (?1 'body) (?2 'subtree) (?3 'visible) - (?4 'force)))) - (if (memq option options) (remq option options) - (cons option options))) - expertp)) - ;; Action selected: Send key and options back to - ;; `org-export-dispatch'. - (t (cons key options)))))))) +back to standard interface." + (let* ((fontify-key + (lambda (key &optional access-key) + ;; Fontify KEY string. Optional argument ACCESS-KEY, when + ;; non-nil is the required first-level key to activate + ;; KEY. When its value is t, activate KEY independently + ;; on the first key, if any. A nil value means KEY will + ;; only be activated at first level. + (if (or (eq access-key t) (eq access-key first-key)) + (org-propertize key 'face 'org-warning) + key))) + (fontify-value + (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))))) + ;; 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)) + (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)))))) + (cond ((eq first-key ?P) (list ?f ?p ?x ?a)) + ((not first-key) (list ?P))) + (list ?& ?#) + (when expertp (list ??)) + (list ?q))) + ;; Build the help menu for standard UI. + (help + (unless expertp + (concat + ;; Options are hard-coded. + (format "[%s] Body only: %s [%s] Visible only: %s +\[%s] Export scope: %s [%s] Force publishing: %s +\[%s] Async export: %s\n\n" + (funcall fontify-key "C-b" t) + (funcall fontify-value + (if (memq 'body options) "On " "Off")) + (funcall fontify-key "C-v" t) + (funcall fontify-value + (if (memq 'visible options) "On " "Off")) + (funcall fontify-key "C-s" t) + (funcall fontify-value + (if (memq 'subtree options) "Subtree" "Buffer ")) + (funcall fontify-key "C-f" t) + (funcall fontify-value + (if (memq 'force options) "On " "Off")) + (funcall fontify-key "C-a" t) + (funcall fontify-value + (if (memq 'async options) "On " "Off"))) + ;; Display registered back-end entries. When a key + ;; appears for the second time, do not create another + ;; entry, but append its sub-menu to existing menu. + (let (last-key) + (mapconcat + (lambda (entry) + (let ((top-key (car entry))) + (concat + (unless (eq top-key last-key) + (setq last-key top-key) + (format "\n[%s] %s\n" + (funcall fontify-key (char-to-string top-key)) + (nth 1 entry))) + (let ((sub-menu (nth 2 entry))) + (unless (functionp sub-menu) + ;; Split sub-menu into two columns. + (let ((index -1)) + (concat + (mapconcat + (lambda (sub-entry) + (incf index) + (format + (if (zerop (mod index 2)) " [%s] %-26s" + "[%s] %s\n") + (funcall fontify-key + (char-to-string (car sub-entry)) + top-key) + (nth 1 sub-entry))) + sub-menu "") + (when (zerop (mod index 2)) "\n")))))))) + backends "")) + ;; Publishing menu is hard-coded. + (format "\n[%s] Publish + [%s] Current file [%s] Current project + [%s] Choose project [%s] All projects\n\n\n" + (funcall fontify-key "P") + (funcall fontify-key "f" ?P) + (funcall fontify-key "p" ?P) + (funcall fontify-key "x" ?P) + (funcall fontify-key "a" ?P)) + (format "[%s] Export stack [%s] Insert template\n" + (funcall fontify-key "&" t) + (funcall fontify-key "#" t)) + (format "[%s] %s" + (funcall fontify-key "q" t) + (if first-key "Main menu" "Exit"))))) + ;; Build prompts for both standard and expert UI. + (standard-prompt (unless expertp "Export command: ")) + (expert-prompt + (when expertp + (format + "Export command (C-%s%s%s%s%s) [%s]: " + (if (memq 'body options) (funcall fontify-key "b" t) "b") + (if (memq 'visible options) (funcall fontify-key "v" t) "v") + (if (memq 'subtree options) (funcall fontify-key "s" t) "s") + (if (memq 'force options) (funcall fontify-key "f" t) "f") + (if (memq 'async options) (funcall fontify-key "a" t) "a") + (mapconcat (lambda (k) + ;; Strip control characters. + (unless (< k 27) (char-to-string k))) + allowed-keys ""))))) ;; With expert UI, just read key with a fancy prompt. In standard ;; UI, display an intrusive help buffer. - (if expertp (funcall handle-keypress expert-prompt) - (save-window-excursion + (if expertp + (org-export--dispatch-action + expert-prompt allowed-keys backends options first-key expertp) + ;; At first call, create frame layout in order to display menu. + (unless (get-buffer "*Org Export Dispatcher*") (delete-other-windows) - (with-output-to-temp-buffer "*Org Export/Publishing Help*" (princ help)) - (org-fit-window-to-buffer - (get-buffer-window "*Org Export/Publishing Help*")) - (funcall handle-keypress standard-prompt))))) + (org-switch-to-buffer-other-window + (get-buffer-create "*Org Export Dispatcher*")) + (setq cursor-type nil + header-line-format "Use SPC, DEL, C-n or C-p to navigate.") + ;; Make sure that invisible cursor will not highlight square + ;; brackets. + (set-syntax-table (copy-syntax-table)) + (modify-syntax-entry ?\[ "w")) + ;; At this point, the buffer containing the menu exists and is + ;; visible in the current window. So, refresh it. + (with-current-buffer "*Org Export Dispatcher*" + ;; Refresh help. Maintain display continuity by re-visiting + ;; previous window position. + (let ((pos (window-start))) + (erase-buffer) + (insert help) + (set-window-start nil pos))) + (org-fit-window-to-buffer) + (org-export--dispatch-action + standard-prompt allowed-keys backends options first-key expertp)))) + +(defun org-export--dispatch-action + (prompt allowed-keys backends 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 +EXPERTP are the same as defined in `org-export--dispatch-ui', +which see. + +Toggle export options when required. Otherwise, return value is +a list with action as CAR and a list of interactive export +options as CDR." + (let (key) + ;; Scrolling: when in non-expert mode, act on motion keys (C-n, + ;; C-p, SPC, DEL). + (while (and (setq key (read-char-exclusive prompt)) + (not expertp) + (memq key '(14 16 ?\s ?\d))) + (case key + (14 (if (not (pos-visible-in-window-p (point-max))) + (ignore-errors (scroll-up-line)) + (message "End of buffer") + (sit-for 1))) + (16 (if (not (pos-visible-in-window-p (point-min))) + (ignore-errors (scroll-down-line)) + (message "Beginning of buffer") + (sit-for 1))) + (?\s (if (not (pos-visible-in-window-p (point-max))) + (scroll-up nil) + (message "End of buffer") + (sit-for 1))) + (?\d (if (not (pos-visible-in-window-p (point-min))) + (scroll-down nil) + (message "Beginning of buffer") + (sit-for 1))))) + (cond + ;; Ignore undefined associations. + ((not (memq key allowed-keys)) + (ding) + (unless expertp (message "Invalid key") (sit-for 1)) + (org-export--dispatch-ui options first-key expertp)) + ;; q key at first level aborts export. At second level, cancel + ;; first key instead. + ((eq key ?q) (if (not first-key) (error "Export aborted") + (org-export--dispatch-ui options nil expertp))) + ;; Help key: Switch back to standard interface if expert UI was + ;; active. + ((eq key ??) (org-export--dispatch-ui options first-key nil)) + ;; Send request for template insertion along with export scope. + ((eq key ?#) (cons 'template (memq 'subtree options))) + ;; Switch to asynchronous export stack. + ((eq key ?&) '(stack)) + ;; Toggle options: C-b (2) C-v (22) C-s (19) C-f (6) C-a (1). + ((memq key '(2 22 19 6 1)) + (org-export--dispatch-ui + (let ((option (case key (2 'body) (22 'visible) (19 'subtree) + (6 'force) (1 'async)))) + (if (memq option options) (remq option options) + (cons option options))) + first-key expertp)) + ;; Action selected: Send key and options back to + ;; `org-export-dispatch'. + ((or first-key (functionp (nth 2 (assq key backends)))) + (cons (cond + ((not first-key) (nth 2 (assq key backends))) + ;; Publishing actions are hard-coded. Send a special + ;; signal to `org-export-dispatch'. + ((eq first-key ?P) + (case key + (?f 'publish-current-file) + (?p 'publish-current-project) + (?x 'publish-choose-project) + (?a 'publish-all))) + ;; Return first action associated to FIRST-KEY + KEY + ;; path. Indeed, derived backends can share the same + ;; FIRST-KEY. + (t (catch 'found + (mapc (lambda (backend) + (let ((match (assq key (nth 2 backend)))) + (when match (throw 'found (nth 2 match))))) + (member (assq first-key backends) backends))))) + options)) + ;; Otherwise, enter sub-menu. + (t (org-export--dispatch-ui options key expertp))))) -(provide 'org-export) -;;; org-export.el ends here + +(provide 'ox) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox.el ends here diff --git a/mk/default.mk b/mk/default.mk index dcd29476a..1bafecb88 100644 --- a/mk/default.mk +++ b/mk/default.mk @@ -24,7 +24,7 @@ infodir = $(prefix)/info # Define if you want to include some (or all) files from contrib/lisp # just the filename please (no path prefix, no .el suffix), maybe with globbing -#ORG_ADD_CONTRIB = org-e-* org-md org-export # e.g. the new exporter +#ORG_ADD_CONTRIB = ox-* # e.g. the contributed exporter # Where to create temporary files for the testsuite # respect TMPDIR if it is already defined in the environment @@ -65,7 +65,8 @@ BTEST = $(BATCH) \ # Using emacs in batch mode. # BATCH = $(EMACS) -batch -vanilla # XEmacs -BATCH = $(EMACS) -batch -Q +BATCH = $(EMACS) -batch -Q \ + --eval '(setq vc-handled-backends nil)' # Emacs must be started in toplevel directory BATCHO = $(BATCH) \ @@ -91,7 +92,7 @@ MAKE_ORG_INSTALL = $(BATCHL) \ MAKE_ORG_VERSION = $(BATCHL) \ --eval '(load "org-compat.el")' \ --eval '(load "../mk/org-fixup.el")' \ - --eval '(org-make-org-version "$(ORGVERSION)" "$(GITVERSION)" "$(datadir)")' + --eval '(org-make-org-version "$(ORGVERSION)" "$(GITVERSION)" "'$(datadir)'")' # How to byte-compile the whole source directory ELCDIR = $(BATCHL) \ diff --git a/mk/eldo.el b/mk/eldo.el index a0281f9bd..96587dfcf 100644 --- a/mk/eldo.el +++ b/mk/eldo.el @@ -90,7 +90,7 @@ (d (get h 'variable-documentation))) (if (> (length val) 30) (setq val (concat (substring val 0 30) "..."))) (insert - " ~" val "~\n" + " =" val "=\n" (if version (format "- *Since:* Emacs version %s\n" version) "") (format (concat "- *In file:* [[" eldo-git-raw-file "][%s]]\n") f f) (format (concat "- [[" eldo-git-search-string @@ -109,7 +109,7 @@ (key (mapconcat 'key-description (where-is-internal c eldo-keymaps) ", ")) (args (help-function-arglist c t)) (d (documentation c))) - (insert "\n** " (symbol-name c) (if args (format " =%s=\n" args) "\n")) + (insert "\n** " (symbol-name c) (if args (format " =%s=\n" args) "\n")) (org-set-property "CUSTOM_ID" (symbol-name c)) (insert (if (and key (not (string= key ""))) (format "\n- *Access:* ~%s~" key) "") @@ -136,7 +136,7 @@ (if (> (length val) 30) (setq val (concat (substring val 0 30) "..."))) (if (> (length type) 30) (setq type (concat (substring type 0 30) "..."))) (insert - " ~" val "~\n\n" + " =" val "=\n\n" (format "- *Type:* %s\n" type) (if version (format "- *Since:* Emacs version %s\n" version) "") (format (concat "- *In file:* [[" eldo-git-raw-file "][%s]]\n") f f) diff --git a/mk/org-fixup.el b/mk/org-fixup.el index 7b59efb88..aa7ff09ec 100644 --- a/mk/org-fixup.el +++ b/mk/org-fixup.el @@ -70,7 +70,8 @@ work correctly if this file is not up-to-date." (with-temp-buffer (set-visited-file-name "org-loaddefs.el") (insert ";;; org-loaddefs.el --- autogenerated file, do not edit\n;;\n;;; Code:\n") - (let ((files (directory-files default-directory nil "^\\(org\\|ob\\)\\(-.*\\)?\\.el$"))) + (let ((files (directory-files default-directory + nil "^\\(org\\|ob\\|ox\\)\\(-.*\\)?\\.el$"))) (mapc (lambda (f) (generate-file-autoloads f)) files)) (insert "\f\n(provide 'org-loaddefs)\n") (insert "\f\n;; Local Variables:\n;; version-control: never\n") diff --git a/mk/server.mk b/mk/server.mk index a0c93a55a..f4cc90ca5 100644 --- a/mk/server.mk +++ b/mk/server.mk @@ -31,7 +31,7 @@ SERVERMK ?= true # or just any value at all, really #---------------------------------------------------------------------- -ORGFULL = README COPYING lisp/ \ +ORGFULL = README COPYING AUTHORS lisp/ \ Makefile request-assign-future.txt \ mk/default.mk mk/targets.mk mk/version.mk \ mk/org-fixup.el \ @@ -117,9 +117,11 @@ cleanrel: doc-up: info pdf card html $(MAKE) -C doc manual guide - $(CP) doc/org.html $(SERVROOT) - $(CP) doc/manual/* $(SERVROOT)/manual - $(CP) doc/guide/* $(SERVROOT)/guide + $(CP) doc/org.html $(SERVROOT) + $(CP) doc/org.pdf $(SERVROOT) + $(CP) doc/orgguide.pdf $(SERVROOT) + $(CP) doc/manual/* $(SERVROOT)/manual + $(CP) doc/guide/* $(SERVROOT)/guide upload: cleanall rel-up doc-up elpa-up elpaplus-up upload-elpa: cleanall elpa-up diff --git a/testing/README b/testing/README index a81efa022..9601ea7ce 100644 --- a/testing/README +++ b/testing/README @@ -15,12 +15,16 @@ The simplest way to run the Org-mode test suite is from the command line with the following invocation. Note that the paths below are relative to the base of the Org-mode directory. +Also note that many of the current tests uses babel evaluation... + #+BEGIN_SRC sh :dir (expand-file-name "..") # For Emacs earlier than 24, add -L /path/to/ert emacs -Q --batch \ -L lisp/ -L testing/ -L testing/lisp -l lisp/org.el \ -l lisp/org-id.el -l testing/org-test.el \ - --eval "(progn (org-reload) (setq org-confirm-babel-evaluate nil))" \ + --eval "(progn (org-reload) (setq org-confirm-babel-evaluate nil) \ + (org-babel-do-load-languages 'org-babel-load-languages \ + '((emacs-lisp . t) (sh . t) (org . t))))" \ -f org-test-run-batch-tests #+END_SRC @@ -43,11 +47,47 @@ load and run the test suite with the following commands. (require 'org-test) #+END_SRC -2) Then run the test suite. +2) Disable babel evaluation confirmation + #+BEGIN_SRC emacs-lisp + (setq org-confirm-babel-evaluate) + #+END_SRC + +3) Then run the test suite, #+BEGIN_SRC emacs-lisp (org-test-run-all-tests) #+END_SRC + or when a test fails run it interactively and investigate the + problem in the ERT results buffer. + + How to run one test: + Use this as a demo example of a failing test + #+BEGIN_SRC emacs-lisp + (ert-deftest test-org/org-link-escape-ascii-character-demo-of-fail () + (should (string= "%5B" ;; expected is right + (org-link-escape "["))) + (should (string= "%5C" ;; expected is wrong, "%5D" would be right + (org-link-escape "]")))) + #+END_SRC + or evaluate the ert-deftest form of the test you want to run. Then + "M-x ert RET test-org/org-link-escape-ascii-character-demo-of-fail RET" + When not visible yet switch to the ERT results buffer named + "\*ert\*". When a test failed the ERT results buffer shows the + details of the first "should" that failed. See + (info "(ert)Running Tests Interactively") on how to re-run, start + the debugger etc. + + How to run all tests of a single test file: + "M-x ert-delete-all-tests RET", confirm. Open the file + ./lisp/test-*.el, "M-x eval-buffer RET", "M-x ert RET t RET" + + Consider to set pp-escape-newlines nil before running the test when + looking at "should" in the ERT results buffer. Especially when + using "l" to look at passed test results and possibly missing an + appropriate setting of pp-escape-newlines made only temporarily for + the running time of the test as e. g. tests using + org-test-table-target-expect-tblfm do. + * Troubleshooting - If the value of the =org-babel-no-eval-on-ctrl-c-ctrl-c= is non-nil diff --git a/testing/examples/babel-dangerous.org b/testing/examples/babel-dangerous.org index 1aa0786f3..ad8f6acea 100644 --- a/testing/examples/babel-dangerous.org +++ b/testing/examples/babel-dangerous.org @@ -9,9 +9,7 @@ There is no default value assigned to =x= variable. This is not permitted anymore. -#+name: carre(x) -#+begin_src python +#+name: carre +#+begin_src python :var x return x*x #+end_src - -#+name: carre diff --git a/testing/examples/macro-templates.org b/testing/examples/macro-templates.org new file mode 100644 index 000000000..589cce8a4 --- /dev/null +++ b/testing/examples/macro-templates.org @@ -0,0 +1,2 @@ +#+TITLE: Macro templates +#+MACRO: included-macro success diff --git a/testing/examples/open-at-point.org b/testing/examples/open-at-point.org new file mode 100644 index 000000000..b3bb92d7e --- /dev/null +++ b/testing/examples/open-at-point.org @@ -0,0 +1,8 @@ + +* Header 1 + :PROPERTIES: + :ID: header1_with_great_id + :END: +* Header 2 + [[id:header1_with_great_id][Header 1]] + id:header1_with_great_id diff --git a/testing/examples/setupfile.org b/testing/examples/setupfile.org new file mode 100644 index 000000000..7d511408f --- /dev/null +++ b/testing/examples/setupfile.org @@ -0,0 +1,5 @@ +#+BIND: variable value +#+DESCRIPTION: l2 +#+LANGUAGE: en +#+SELECT_TAGS: b +#+TITLE: b diff --git a/testing/lisp/test-ob-emacs-lisp.el b/testing/lisp/test-ob-emacs-lisp.el index 92fb88043..d03f048aa 100644 --- a/testing/lisp/test-ob-emacs-lisp.el +++ b/testing/lisp/test-ob-emacs-lisp.el @@ -28,55 +28,54 @@ #+begin_src emacs-lisp ;; #+end_src" - (progn - (org-babel-next-src-block) - (org-ctrl-c-ctrl-c) - (should (re-search-forward "results:" nil t)) - (forward-line) - (should - (string= - "" - (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) + (org-babel-next-src-block) + (org-ctrl-c-ctrl-c) + (should (re-search-forward "results:" nil t)) + (forward-line) + (should + (string= + "" + (buffer-substring-no-properties (point-at-bol) (point-at-eol))))) (org-test-with-temp-text-in-file " #+begin_src emacs-lisp \"some text\";; #+end_src" - (progn - (org-babel-next-src-block) - (org-ctrl-c-ctrl-c) - (should (re-search-forward "results:" nil t)) - (forward-line) - (should - (string= - ": some text" - (buffer-substring-no-properties (point-at-bol) (point-at-eol))))))) + (org-babel-next-src-block) + (org-ctrl-c-ctrl-c) + (should (re-search-forward "results:" nil t)) + (forward-line) + (should + (string= + ": some text" + (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) (ert-deftest ob-emacs-lisp/commented-last-block-line-with-var () (org-test-with-temp-text-in-file " #+begin_src emacs-lisp :var a=1 ;; #+end_src" - (progn - (org-babel-next-src-block) - (org-ctrl-c-ctrl-c) - (re-search-forward "results" nil t) - (forward-line) - (should (string= - "" - (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) + (org-babel-next-src-block) + (org-ctrl-c-ctrl-c) + (re-search-forward "results" nil t) + (forward-line) + (should (string= + "" + (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) + +(ert-deftest ob-emacs-lisp/commented-last-block-line () (org-test-with-temp-text-in-file " #+begin_src emacs-lisp :var a=2 2;; #+end_src" - (progn - (org-babel-next-src-block) - (org-ctrl-c-ctrl-c) - (re-search-forward "results" nil t) - (forward-line) - (should (string= - ": 2" - (buffer-substring-no-properties (point-at-bol) (point-at-eol))))))) + (org-babel-next-src-block) + (org-ctrl-c-ctrl-c) + (re-search-forward "results" nil t) + (forward-line) + (should (string= + ": 2" + (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) + (provide 'test-ob-emacs-lisp) ;;; test-ob-emacs-lisp.el ends here diff --git a/testing/lisp/test-ob-exp.el b/testing/lisp/test-ob-exp.el index 2dedb763a..abfe2309b 100644 --- a/testing/lisp/test-ob-exp.el +++ b/testing/lisp/test-ob-exp.el @@ -23,14 +23,29 @@ ;; Template test file for Org-mode tests ;;; Code: + +(defmacro org-test-with-expanded-babel-code (&rest body) + "Execute BODY while in a buffer with all Babel code evaluated. +Current buffer is a copy of the original buffer." + `(let ((string (buffer-string)) + (buf (current-buffer))) + (with-temp-buffer + (org-mode) + (insert string) + (let ((org-current-export-file buf)) + (org-babel-exp-process-buffer)) + (goto-char (point-min)) + (progn ,@body)))) + (ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-headers () - "Testing export without any headlines in the org-mode file." + "Testing export without any headlines in the Org mode file." + (require 'ox-html) (let ((html-file (concat (file-name-sans-extension org-test-no-heading-file) ".html"))) (when (file-exists-p html-file) (delete-file html-file)) (org-test-in-example-file org-test-no-heading-file - ;; export the file to html - (org-export-as-html nil)) + ;; Export the file to HTML. + (org-export-to-file 'html html-file)) ;; should create a .html file (should (file-exists-p html-file)) ;; should not create a file with "::" appended to it's name @@ -39,18 +54,17 @@ (ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-file () "Testing export from buffers which are not visiting any file." - (when (get-buffer "*Org HTML Export*") (kill-buffer "*Org HTML Export*")) - (should-not (get-buffer "*Org HTML Export*")) - ;; export the file to HTML in a temporary buffer - (org-test-in-example-file nil (org-export-as-html-to-buffer nil)) - ;; should create a .html buffer - (should (buffer-live-p (get-buffer "*Org HTML Export*"))) - ;; should contain the content of the buffer - (save-excursion - (set-buffer (get-buffer "*Org HTML Export*")) - (should (string-match (regexp-quote org-test-file-ob-anchor) - (buffer-string)))) - (when (get-buffer "*Org HTML Export*") (kill-buffer "*Org HTML Export*"))) + (require 'ox-html) + (let ((name (generate-new-buffer-name "*Org HTML Export*"))) + (org-test-in-example-file nil + (org-export-to-buffer 'html name nil nil t)) + ;; Should create a HTML buffer. + (should (buffer-live-p (get-buffer name))) + ;; Should contain the content of the buffer. + (with-current-buffer (get-buffer name) + (should (string-match (regexp-quote org-test-file-ob-anchor) + (buffer-string)))) + (when (get-buffer name) (kill-buffer name)))) (ert-deftest test-ob-exp/org-babel-exp-src-blocks/w-no-headers2 () "Testing export without any headlines in the org-mode file." @@ -60,7 +74,7 @@ (when (file-exists-p html-file) (delete-file html-file)) (org-test-in-example-file org-test-link-in-heading-file ;; export the file to html - (org-export-as-html nil)) + (org-export-to-file 'html html-file)) ;; should create a .html file (should (file-exists-p html-file)) ;; should not create a file with "::" appended to it's name @@ -72,138 +86,72 @@ - yes expand on both export and tangle - no expand on neither export or tangle - tangle expand on only tangle not export" - (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7" - (org-narrow-to-subtree) - (let ((exported-html - (org-export-as-html nil nil 'string 'body-only)) - (test-point 0)) - - (org-test-with-temp-text-in-file - exported-html - - ;; check following ouput exists and in order - (mapcar (lambda (x) - (should (< test-point - (re-search-forward - x - nil t))) - (setq test-point (point))) - '(":noweb header argument expansion" - "message" "expanded1" - "message" "expanded2" - "noweb-1-yes-start" - "message" "expanded1" - "noweb-no-start" - "<<noweb-example1>>" - "noweb-2-yes-start" - "message" "expanded2" - "noweb-tangle-start" - "<<noweb-example1>>" - "<<noweb-example2>>")))))) + (should + (equal + '("(message \"expanded1\")" "(message \"expanded2\")" ";; noweb-1-yes-start + (message \"expanded1\") + (message \"expanded1\")" ";; noweb-no-start + <>" ";; noweb-2-yes-start + (message \"expanded2\") + (message \"expanded2\")" ";; noweb-tangle-start +<> +<>") + (org-test-at-id "eb1f6498-5bd9-45e0-9c56-50717053e7b7" + (org-narrow-to-subtree) + (org-element-map + (org-test-with-expanded-babel-code (org-element-parse-buffer)) + 'src-block + (lambda (src) (org-trim (org-element-property :value src)))))))) (ert-deftest ob-exp/noweb-on-export-with-exports-results () "Noweb header arguments export correctly using :exports results. - yes expand on both export and tangle - no expand on neither export or tangle - tangle expand on only tangle not export" - (org-test-at-id "8701beb4-13d9-468c-997a-8e63e8b66f8d" - (org-narrow-to-subtree) - (let ((exported-html - (org-export-as-html nil nil 'string 'body-only)) - (test-point 0)) - - (org-test-with-temp-text-in-file - exported-html - - ;; check following ouput exists and in order - (mapcar (lambda (x) - (should (< test-point - (re-search-forward - x - nil t))) - (setq test-point (point))) - '(":noweb header argument expansion using :exports results" - "expanded1" - "expanded2" - "expanded1" - "noweb-no-start" - "<<noweb-example1>>" - "expanded2" - "<<noweb-example1>>" - "<<noweb-example2>>")))))) + (should + (equal + '(";; noweb-no-start + <>" "<> +<>") + (org-test-at-id "8701beb4-13d9-468c-997a-8e63e8b66f8d" + (org-narrow-to-subtree) + (org-element-map + (org-test-with-expanded-babel-code (org-element-parse-buffer)) + 'src-block + (lambda (src) (org-trim (org-element-property :value src)))))))) (ert-deftest ob-exp/exports-both () - "Test the :exports both header argument. -The code block should create both
     and 
    -elements in the final html." + "Test the \":exports both\" header argument. +The code block evaluation should create both a code block and +a table." (org-test-at-id "92518f2a-a46a-4205-a3ab-bcce1008a4bb" (org-narrow-to-subtree) - (let ((exported-html - (org-export-as-html nil nil 'string 'body-only)) - (test-point 0)) - (org-test-with-temp-text-in-file - exported-html - - ;; check following ouput exists and in order - (mapcar (lambda (x) - (should (< test-point - (re-search-forward - x - nil t))) - (setq test-point (point))) - '( "Pascal's Triangle – exports both test" - "" - "" - """>1<""" - """>1<"">1<""" - """>1<"">2<"">1<""" - """>1<"">3<"">3<"">1<""" - """>1<"">4<"">6<"">4<"">1<""" - """>1<"">5<"">10<"">10<"">5<"">1<""" - """")))))) + (let ((tree (org-test-with-expanded-babel-code (org-element-parse-buffer)))) + (should (and (org-element-map tree 'src-block 'identity) + (org-element-map tree 'table 'identity)))))) (ert-deftest ob-exp/mixed-blocks-with-exports-both () + (should + (equal + '(property-drawer plain-list src-block fixed-width src-block plain-list) (org-test-at-id "5daa4d03-e3ea-46b7-b093-62c1b7632df3" - (org-narrow-to-subtree) - (let ((exported-html - (org-export-as-html nil nil 'string 'body-only)) - (test-point 0)) - (org-test-with-temp-text-in-file - exported-html - - ;; check following ouput exists and in order - (mapcar (lambda (x) - (should (< test-point - (re-search-forward - x - nil t))) - (setq test-point (point))) - '("mixed blocks with exports both" - "
      " - "
    • ""a""
    • " - "
    • ""b""
    • " - "
    • ""c""
    • " - "
    " - "" - "
    "
    -		  "code block results"
    -		  "
    ")))))) + (org-narrow-to-subtree) + (mapcar 'org-element-type + (org-element-map + (org-test-with-expanded-babel-code + (org-element-parse-buffer 'greater-element)) + 'section 'org-element-contents nil t)))))) (ert-deftest ob-exp/export-with-name () - (let ((org-babel-exp-code-template - "=%name=\n#+BEGIN_SRC %lang%flags\nbody\n#+END_SRC")) - (org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9" - (org-narrow-to-subtree) - (let ((ascii (org-export-as-ascii nil nil 'string 'body-only))) - (should (string-match "qux" ascii)))))) + (should + (string-match + "=qux=" + (let ((org-babel-exp-code-template + "=%name=\n#+BEGIN_SRC %lang%flags\nbody\n#+END_SRC")) + (org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9" + (org-narrow-to-subtree) + (org-test-with-expanded-babel-code + (buffer-string))))))) (ert-deftest ob-exp/export-with-header-argument () (let ((org-babel-exp-code-template @@ -215,41 +163,58 @@ elements in the final html." #+BEGIN_SRC %lang%flags\nbody\n#+END_SRC")) (org-test-at-id "b02ddd8a-eeb8-42ab-8664-8a759e6f43d9" (org-narrow-to-subtree) - (let ((ascii (org-export-as-ascii nil nil 'string 'body-only))) - (should (string-match "baz" ascii)) - (should (string-match "replace" ascii)))))) + (org-test-with-expanded-babel-code + (should (string-match "baz" (buffer-string))) + (should (string-match "replace" (buffer-string))))))) (ert-deftest ob-exp/noweb-no-export-and-exports-both () - (org-test-at-id "8a820f6c-7980-43db-8a24-0710d33729c9" - (org-narrow-to-subtree) - (let ((html (org-export-as-html nil nil 'string 'body-only))) - (should (string-match (regexp-quote "noweb-no-export-and-exports-both-1") - html))))) + (should + (string-match + "<>" + (org-test-at-id "8a820f6c-7980-43db-8a24-0710d33729c9" + (org-narrow-to-subtree) + (org-test-with-expanded-babel-code + (org-element-map (org-element-parse-buffer) 'src-block + (lambda (src-block) (org-element-property :value src-block)) + nil t)))))) (ert-deftest ob-exp/evaluate-all-executables-in-order () - (org-test-at-id "96cc7073-97ec-4556-87cf-1f9bffafd317" - (org-narrow-to-subtree) - (let (*evaluation-collector*) - (org-export-as-ascii nil nil 'string) - (should (equal '(5 4 3 2 1) *evaluation-collector*))))) + (should + (equal '(5 4 3 2 1) + (let (*evaluation-collector*) + (org-test-at-id "96cc7073-97ec-4556-87cf-1f9bffafd317" + (org-narrow-to-subtree) + (buffer-string) + (fboundp 'org-export-execute-babel-code) + (org-test-with-expanded-babel-code *evaluation-collector*)))))) + +(ert-deftest ob-exp/exports-inline () + (should + (string-match + (regexp-quote "Here is one in the middle =1= of a line. +Here is one at the end of a line. =2= +=3= Here is one at the beginning of a line.") + (org-test-at-id "54cb8dc3-298c-4883-a933-029b3c9d4b18" + (org-narrow-to-subtree) + (org-test-with-expanded-babel-code (buffer-string)))))) (ert-deftest ob-exp/export-call-line-information () (org-test-at-id "bec63a04-491e-4caa-97f5-108f3020365c" (org-narrow-to-subtree) - (let* ((org-babel-exp-call-line-template "\n: call: %line special-token") - (html (org-export-as-html nil nil 'string t))) - (should (string-match "double" html)) - (should (string-match "16" html)) - (should (string-match "special-token" html))))) + (let ((org-babel-exp-call-line-template "\n: call: %line special-token")) + (org-test-with-expanded-babel-code + (should (string-match "double" (buffer-string))) + (should (string-match "16" (buffer-string))) + (should (string-match "special-token" (buffer-string))))))) (ert-deftest ob-exp/noweb-strip-export-ensure-strips () (org-test-at-id "8e7bd234-99b2-4b14-8cd6-53945e409775" (org-narrow-to-subtree) (org-babel-next-src-block 2) (should (= 110 (org-babel-execute-src-block))) - (let ((ascii (org-export-as-ascii nil nil 'string t))) - (should-not (string-match (regexp-quote "<>") ascii)) - (should-not (string-match (regexp-quote "i=\"10\"") ascii))))) + (let ((result (org-test-with-expanded-babel-code (buffer-string)))) + (should-not (string-match (regexp-quote "<>") result)) + (should-not (string-match (regexp-quote "i=\"10\"") result))))) (ert-deftest ob-exp/export-from-a-temp-buffer () :expected-result :failed @@ -271,12 +236,11 @@ elements in the final html." (list foo <>) #+END_SRC " - (let* ((org-current-export-file (current-buffer)) - (ascii (org-export-as-ascii nil nil 'string))) + (let* ((ascii (org-export-as 'ascii))) (should (string-match (regexp-quote (format nil "%S" '(:foo :bar))) ascii))))) + (provide 'test-ob-exp) ;;; test-ob-exp.el ends here - diff --git a/testing/lisp/test-ob-fortran.el b/testing/lisp/test-ob-fortran.el index f1cda566d..c35599607 100644 --- a/testing/lisp/test-ob-fortran.el +++ b/testing/lisp/test-ob-fortran.el @@ -44,18 +44,17 @@ (org-babel-next-src-block) (should (= 15 (org-babel-execute-src-block))))) -(ert-deftest ob-fortran/preprosessor-var () +(ert-deftest ob-fortran/preprocessor-var () "Test preprocessed fortran" (org-test-at-id "d8d1dfd3-5f0c-48fe-b55d-777997e02242" (org-babel-next-src-block 2) (should (= 42 (org-babel-execute-src-block))))) -;; ;; TODO: test fails -;; (ert-deftest ob-fortran/character-var () -;; "Test string input" -;; (org-test-at-id "d8d1dfd3-5f0c-48fe-b55d-777997e02242" -;; (org-babel-next-src-block 3) -;; (should (equal "word" (org-babel-execute-src-block))))) +(ert-deftest ob-fortran/character-var () + "Test string input" + (org-test-at-id "d8d1dfd3-5f0c-48fe-b55d-777997e02242" + (org-babel-next-src-block 3) + (should (equal "word" (org-babel-execute-src-block))))) (ert-deftest ob-fortran/list-var () "Test real array input" diff --git a/testing/lisp/test-ob-lob.el b/testing/lisp/test-ob-lob.el index 6483e226c..db3b7c847 100644 --- a/testing/lisp/test-ob-lob.el +++ b/testing/lisp/test-ob-lob.el @@ -24,15 +24,13 @@ (expand-file-name "library-of-babel.org" (expand-file-name - "babel" - (expand-file-name - "contrib" + "doc" (expand-file-name ".." (expand-file-name ".." (file-name-directory - (or load-file-name buffer-file-name)))))))) + (or load-file-name buffer-file-name))))))) (ert-deftest test-ob-lob/ingest () "Test the ingestion of an org-mode file." @@ -80,37 +78,31 @@ "Test the export of a variety of library babel call lines." (org-test-at-id "72ddeed3-2d17-4c7f-8192-a575d535d3fc" (org-narrow-to-subtree) - (let ((html (org-export-as-html nil nil 'string 'body-only))) - ;; check the location of each exported number + (let ((buf (current-buffer)) + (string (buffer-string))) (with-temp-buffer - (insert html) (goto-char (point-min)) - ;; 0 should be on a line by itself - (should (re-search-forward "0" nil t)) - (should (string= "0" (buffer-substring (point-at-bol) (point-at-eol)))) - ;; 2 should be in tags - (should (re-search-forward "2" nil t)) - (should (re-search-forward (regexp-quote "") (point-at-eol) t)) - (should (re-search-backward (regexp-quote "") (point-at-bol) t)) - ;; 4 should not be exported - (should (not (re-search-forward "4" nil t))) - ;; 6 should also be inline - (should (re-search-forward "6" nil t)) - (should (re-search-forward (regexp-quote "") (point-at-eol) t)) - (should (re-search-backward (regexp-quote "") (point-at-bol) t)) - ;; 8 should not be quoted - (should (re-search-forward "8" nil t)) - (should (not (= ?= (char-after (point))))) - (should (not (= ?= (char-before (- (point) 1))))) - ;; 10 should export - (should (re-search-forward "10" nil t)))))) + (org-mode) + (insert string) + (let ((org-current-export-file buf)) + (org-babel-exp-process-buffer)) + (message (buffer-string)) + (should (re-search-forward "^: 0" nil t)) + (should (re-search-forward "call =2= stuck" nil t)) + (should (re-search-forward + "exported =call_double(it=2)= because" nil t)) + (should (re-search-forward "^=6= because" nil t)) + (should (re-search-forward "results 8 should" nil t)) + (should (re-search-forward "following 2\\*5==10= should" nil t)))))) (ert-deftest test-ob-lob/do-not-eval-lob-lines-in-example-blocks-on-export () + (require 'ox) (org-test-with-temp-text-in-file " for export #+begin_example #+call: rubbish() #+end_example" - (org-export-as-html nil))) + (should (progn (org-export-execute-babel-code) t)))) + (provide 'test-ob-lob) diff --git a/testing/lisp/test-ob-perl.el b/testing/lisp/test-ob-perl.el new file mode 100644 index 000000000..a29d39a62 --- /dev/null +++ b/testing/lisp/test-ob-perl.el @@ -0,0 +1,78 @@ +;;; test-ob-perl.el --- tests for ob-perl.el + +;; Copyright (c) 2013 Achim Gratz +;; Authors: Achim Gratz + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: +(org-test-for-executable "perl") +(unless (featurep 'ob-perl) + (signal 'missing-test-dependency "Support for perl code blocks")) + +(ert-deftest test-ob-perl/simple-output () + (org-test-with-temp-text " +#+header: :results output +#+begin_src perl + print qq(Hi Mom!$/I'm home.); +#+end_src" + (org-babel-next-src-block) + (should (equal "Hi Mom!\nI'm home." + (org-babel-execute-src-block))))) + +(ert-deftest test-ob-perl/simple-value () + (org-test-with-temp-text " +#+header: :results value +#+begin_src perl + qq(Hi Mom!$/I'm home.); +#+end_src" + (org-babel-next-src-block) + (should (equal '(("Hi Mom!") ("I'm home.")) + (org-babel-execute-src-block))))) + +(ert-deftest test-ob-perl/table-passthrough-colnames-nil () + (org-test-with-temp-text "#+name: eg +| col1 | col2 | +|------+------| +| a | 1 | +| b | 2.0 | + +#+header: :colnames nil +#+header: :var x = eg +#+begin_src perl +#+end_src" + (org-babel-next-src-block) + (should (equal '(("col1" "col2") hline ("a" 1) ("b" 2.0)) + (org-babel-execute-src-block))))) + +(ert-deftest test-ob-perl/table-passthrough-colnames-no () + (org-test-with-temp-text "#+name: eg +| col1 | col2 | +|------+------| +| a | 1 | +| b | 2.0 | + +#+header: :colnames no +#+header: :var x = eg +#+begin_src perl +#+end_src" + (org-babel-next-src-block) + (should (equal '(("col1" "col2") ("a" 1) ("b" 2.0)) + (org-babel-execute-src-block))))) + +(provide 'test-ob-perl) + +;;; test-ob-perl.el ends here diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el index 73e09abef..bbbfbc4fe 100644 --- a/testing/lisp/test-ob.el +++ b/testing/lisp/test-ob.el @@ -148,12 +148,10 @@ #+begin_src emacs-lisp prop #+end_src" - - (progn - (goto-char (point-min)) - (org-babel-next-src-block) - (let ((info (org-babel-get-src-block-info))) - (should (= 42 (org-babel-execute-src-block))))))) + (goto-char (point-min)) + (org-babel-next-src-block) + (let ((info (org-babel-get-src-block-info))) + (should (= 42 (org-babel-execute-src-block)))))) (ert-deftest test-org-babel/simple-named-code-block () "Test that simple named code blocks can be evaluated." @@ -163,10 +161,8 @@ #+begin_src emacs-lisp 42 #+end_src" - - (progn - (org-babel-next-src-block 1) - (should (= 42 (org-babel-execute-src-block)))))) + (org-babel-next-src-block 1) + (should (= 42 (org-babel-execute-src-block))))) (ert-deftest test-org-babel/simple-variable-resolution () "Test that simple variable resolution is working." @@ -181,13 +177,12 @@ (length four) #+end_src" - (progn - (org-babel-next-src-block 2) - (should (= 4 (org-babel-execute-src-block))) - (forward-line 5) - (should (string= ": 4" (buffer-substring - (point-at-bol) - (point-at-eol))))))) + (org-babel-next-src-block 2) + (should (= 4 (org-babel-execute-src-block))) + (forward-line 5) + (should (string= ": 4" (buffer-substring + (point-at-bol) + (point-at-eol)))))) (ert-deftest test-org-babel/multi-line-header-arguments () "Test that multi-line header arguments and can be read." @@ -202,11 +197,10 @@ (my-map 'list #'list numbers letters) #+end_src" - (progn - (org-babel-next-src-block) - (let ((results (org-babel-execute-src-block))) - (should(equal 'a (cadr (assoc 1 results)))) - (should(equal 'd (cadr (assoc 4 results)))))))) + (org-babel-next-src-block) + (let ((results (org-babel-execute-src-block))) + (should(equal 'a (cadr (assoc 1 results)))) + (should(equal 'd (cadr (assoc 4 results))))))) (ert-deftest test-org-babel/parse-header-args () (org-test-with-temp-text-in-file " @@ -215,17 +209,16 @@ the body #+end_src" - (progn - (org-babel-next-src-block) - (let* ((info (org-babel-get-src-block-info)) - (params (nth 2 info))) - (message "%S" params) - (should(equal "example-lang" (nth 0 info))) - (should(string= "the body" (org-babel-trim (nth 1 info)))) - (should-not (member '(:session\ \ \ \ ) params)) - (should(equal '(:session) (assoc :session params))) - (should(equal '(:result-type . output) (assoc :result-type params))) - (should(equal '(num . 9) (cdr (assoc :var params)))))))) + (org-babel-next-src-block) + (let* ((info (org-babel-get-src-block-info)) + (params (nth 2 info))) + (message "%S" params) + (should (equal "example-lang" (nth 0 info))) + (should (string= "the body" (org-babel-trim (nth 1 info)))) + (should-not (member '(:session\ \ \ \ ) params)) + (should (equal '(:session) (assoc :session params))) + (should (equal '(:result-type . output) (assoc :result-type params))) + (should (equal '(num . 9) (cdr (assoc :var params))))))) (ert-deftest test-org-babel/parse-header-args2 () (org-test-with-temp-text-in-file " @@ -247,20 +240,19 @@ :END: this is simple" - (progn - (should (string-match (regexp-quote "this is simple") - (org-babel-ref-resolve "simple-subtree"))) - (org-babel-next-src-block) - (should (= 14 (org-babel-execute-src-block)))))) + (should (string-match (regexp-quote "this is simple") + (org-babel-ref-resolve "simple-subtree"))) + (org-babel-next-src-block) + (should (= 14 (org-babel-execute-src-block))))) (ert-deftest test-org-babel/inline-src-blocks () (org-test-at-id "54cb8dc3-298c-4883-a933-029b3c9d4b18" (macrolet ((at-next (&rest body) - `(progn - (move-end-of-line 1) - (re-search-forward org-babel-inline-src-block-regexp nil t) - (goto-char (match-beginning 1)) - (save-match-data ,@body)))) + `(progn + (move-end-of-line 1) + (re-search-forward org-babel-inline-src-block-regexp nil t) + (goto-char (match-beginning 1)) + (save-match-data ,@body)))) (at-next (should (equal 1 (org-babel-execute-src-block)))) (at-next (should (equal 2 (org-babel-execute-src-block)))) (at-next (should (equal 3 (org-babel-execute-src-block))))))) @@ -309,19 +301,19 @@ this is simple" (buffer-substring-no-properties (point-at-bol) (point-at-eol))))) ;; src_ follows space line 1... (let ((test-line " src_emacs-lisp{ 1 }")) - (org-test-with-temp-text - test-line - (should-error (org-ctrl-c-ctrl-c)) - (forward-char) (org-ctrl-c-ctrl-c) - (should (string= - (concat test-line " =1=") - (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) - (re-search-forward "{ 1 ") (org-ctrl-c-ctrl-c) - (should (string= - (concat test-line " =1= =1=") - (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) - (forward-char) - (should-error (org-ctrl-c-ctrl-c))))) + (org-test-with-temp-text + test-line + (should-error (org-ctrl-c-ctrl-c)) + (forward-char) (org-ctrl-c-ctrl-c) + (should (string= + (concat test-line " =1=") + (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) + (re-search-forward "{ 1 ") (org-ctrl-c-ctrl-c) + (should (string= + (concat test-line " =1= =1=") + (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) + (forward-char) + (should-error (org-ctrl-c-ctrl-c)))))) (ert-deftest test-org-babel/inline-src_blk-default-results-replace-line-2 () ;; src_ at bol line 2... @@ -346,14 +338,14 @@ this is simple" (insert (concat "\n" test-line " end")) (re-search-backward "src") (org-ctrl-c-ctrl-c) (should (string= - (concat test-line " =y= end") - (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) + (concat test-line " =y= end") + (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) (re-search-forward "\" ") (org-ctrl-c-ctrl-c) (should (string= (concat test-line " =y= =y= end") - (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) + (buffer-substring-no-properties (point-at-bol) (point-at-eol)))) (forward-char) - (should-error (org-ctrl-c-ctrl-c)))))) + (should-error (org-ctrl-c-ctrl-c))))) (ert-deftest test-org-babel/inline-src_blk-manual-results-replace () (let ((test-line " src_emacs-lisp[:results replace]{ \"x\" }")) @@ -494,7 +486,7 @@ echo \"[[file:./cv.cls]]\" (should (equal '(error - "variable \"x\" in block \"carre\" must be assigned a default value") + "Variable \"x\" must be assigned a default value") err))))) (ert-deftest test-org-babel/just-one-results-block () @@ -637,15 +629,15 @@ on two lines (ert-deftest test-ob/eval-header-argument () (flet ((check-eval (eval runp) - (org-test-with-temp-text (format "#+begin_src emacs-lisp :eval %s + (org-test-with-temp-text (format "#+begin_src emacs-lisp :eval %s (setq foo :evald) #+end_src" eval) - (let ((foo :not-run)) - (if runp - (progn (should (org-babel-execute-src-block)) - (should (eq foo :evald))) - (progn (should-not (org-babel-execute-src-block)) - (should-not (eq foo :evald)))))))) + (let ((foo :not-run)) + (if runp + (progn (should (org-babel-execute-src-block)) + (should (eq foo :evald))) + (progn (should-not (org-babel-execute-src-block)) + (should-not (eq foo :evald)))))))) (check-eval "never" nil) (check-eval "no" nil) (check-eval "never-export" t) @@ -700,55 +692,50 @@ on two lines #+begin_src emacs-lisp ;; #+end_src" - (progn - (org-babel-next-src-block) - (org-ctrl-c-ctrl-c) - (should (re-search-forward "\\#\\+results:" nil t)) - (forward-line) - (should - (string= - "" - (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) + (org-babel-next-src-block) + (org-ctrl-c-ctrl-c) + (should (re-search-forward "\\#\\+results:" nil t)) + (forward-line) + (should + (string= + "" + (buffer-substring-no-properties (point-at-bol) (point-at-eol))))) (org-test-with-temp-text-in-file " #+begin_src emacs-lisp \"some text\";; #+end_src" - - (progn - (org-babel-next-src-block) - (org-ctrl-c-ctrl-c) - (should (re-search-forward "\\#\\+results:" nil t)) - (forward-line) - (should - (string= - ": some text" - (buffer-substring-no-properties (point-at-bol) (point-at-eol))))))) + (org-babel-next-src-block) + (org-ctrl-c-ctrl-c) + (should (re-search-forward "\\#\\+results:" nil t)) + (forward-line) + (should + (string= + ": some text" + (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) (ert-deftest test-ob/commented-last-block-line-with-var () (org-test-with-temp-text-in-file " #+begin_src emacs-lisp :var a=1 ;; #+end_src" - (progn - (org-babel-next-src-block) - (org-ctrl-c-ctrl-c) - (re-search-forward "\\#\\+results:" nil t) - (forward-line) - (should (string= - "" - (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) + (org-babel-next-src-block) + (org-ctrl-c-ctrl-c) + (re-search-forward "\\#\\+results:" nil t) + (forward-line) + (should (string= + "" + (buffer-substring-no-properties (point-at-bol) (point-at-eol))))) (org-test-with-temp-text-in-file " #+begin_src emacs-lisp :var a=2 2;; #+end_src" - (progn - (org-babel-next-src-block) - (org-ctrl-c-ctrl-c) - (re-search-forward "\\#\\+results:" nil t) - (forward-line) - (should (string= - ": 2" - (buffer-substring-no-properties (point-at-bol) (point-at-eol))))))) + (org-babel-next-src-block) + (org-ctrl-c-ctrl-c) + (re-search-forward "\\#\\+results:" nil t) + (forward-line) + (should (string= + ": 2" + (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) (defun test-ob-verify-result-and-removed-result (result buffer-text) "Test helper function to test `org-babel-remove-result'. @@ -759,18 +746,17 @@ The block is actually executed /twice/ to ensure result replacement happens correctly." (org-test-with-temp-text buffer-text - (progn - (org-babel-next-src-block) (org-ctrl-c-ctrl-c) (org-ctrl-c-ctrl-c) - (should (re-search-forward "\\#\\+results:" nil t)) - (forward-line) - (should (string= result - (buffer-substring-no-properties - (point-at-bol) - (- (point-max) 16)))) - (org-babel-previous-src-block) (org-babel-remove-result) - (should (string= buffer-text - (buffer-substring-no-properties - (point-min) (point-max))))))) + (org-babel-next-src-block) (org-ctrl-c-ctrl-c) (org-ctrl-c-ctrl-c) + (should (re-search-forward "\\#\\+results:" nil t)) + (forward-line) + (should (string= result + (buffer-substring-no-properties + (point-at-bol) + (- (point-max) 16)))) + (org-babel-previous-src-block) (org-babel-remove-result) + (should (string= buffer-text + (buffer-substring-no-properties + (point-min) (point-max)))))) (ert-deftest test-ob/org-babel-remove-result--results-default () "Test `org-babel-remove-result' with default :results." @@ -778,7 +764,7 @@ replacement happens correctly." (test-ob-verify-result-and-removed-result "\n" (concat -"* org-babel-remove-result + "* org-babel-remove-result #+begin_src " language " #+end_src @@ -793,7 +779,7 @@ replacement happens correctly." - 3 - (quote (4 5))" -"* org-babel-remove-result + "* org-babel-remove-result #+begin_src emacs-lisp :results list '(1 2 3 '(4 5)) #+end_src @@ -805,7 +791,7 @@ replacement happens correctly." If not inserted correctly then the second evaluation will fail trying to find the :END: marker." (org-test-with-temp-text - "- indented + "- indented #+begin_src sh :results file wrap echo test.txt #+end_src" @@ -834,7 +820,7 @@ trying to find the :END: marker." (test-ob-verify-result-and-removed-result ": \"I /am/ working!\"" -"* org-babel-remove-result + "* org-babel-remove-result #+begin_src emacs-lisp :results pp \"I /am/ working!\") #+end_src @@ -855,26 +841,24 @@ trying to find the :END: marker." #+begin_src emacs-lisp :var a=1 ;; #+end_src" - (progn - (org-babel-next-src-block) - (org-ctrl-c-ctrl-c) - (re-search-forward "\\#\\+results:" nil t) - (forward-line) - (should (string= - "" - (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) + (org-babel-next-src-block) + (org-ctrl-c-ctrl-c) + (re-search-forward "\\#\\+results:" nil t) + (forward-line) + (should (string= + "" + (buffer-substring-no-properties (point-at-bol) (point-at-eol))))) (org-test-with-temp-text-in-file " #+begin_src emacs-lisp :var a=2 2;; #+end_src" - (progn - (org-babel-next-src-block) - (org-ctrl-c-ctrl-c) - (re-search-forward "\\#\\+results:" nil t) - (forward-line) - (should (string= - ": 2" - (buffer-substring-no-properties (point-at-bol) (point-at-eol))))))) + (org-babel-next-src-block) + (org-ctrl-c-ctrl-c) + (re-search-forward "\\#\\+results:" nil t) + (forward-line) + (should (string= + ": 2" + (buffer-substring-no-properties (point-at-bol) (point-at-eol)))))) (defun test-ob-verify-result-and-removed-result (result buffer-text) "Test helper function to test `org-babel-remove-result'. @@ -885,18 +869,17 @@ The block is actually executed /twice/ to ensure result replacement happens correctly." (org-test-with-temp-text buffer-text - (progn - (org-babel-next-src-block) (org-ctrl-c-ctrl-c) (org-ctrl-c-ctrl-c) - (should (re-search-forward "\\#\\+results:" nil t)) - (forward-line) - (should (string= result - (buffer-substring-no-properties - (point-at-bol) - (- (point-max) 16)))) - (org-babel-previous-src-block) (org-babel-remove-result) - (should (string= buffer-text - (buffer-substring-no-properties - (point-min) (point-max))))))) + (org-babel-next-src-block) (org-ctrl-c-ctrl-c) (org-ctrl-c-ctrl-c) + (should (re-search-forward "\\#\\+results:" nil t)) + (forward-line) + (should (string= result + (buffer-substring-no-properties + (point-at-bol) + (- (point-max) 16)))) + (org-babel-previous-src-block) (org-babel-remove-result) + (should (string= buffer-text + (buffer-substring-no-properties + (point-min) (point-max)))))) (ert-deftest test-ob/org-babel-remove-result--results-default () "Test `org-babel-remove-result' with default :results." @@ -904,7 +887,7 @@ replacement happens correctly." (test-ob-verify-result-and-removed-result "\n" (concat -"* org-babel-remove-result + "* org-babel-remove-result #+begin_src " language " #+end_src @@ -919,7 +902,7 @@ replacement happens correctly." - 3 - (quote (4 5))" -"* org-babel-remove-result + "* org-babel-remove-result #+begin_src emacs-lisp :results list '(1 2 3 '(4 5)) #+end_src @@ -933,7 +916,7 @@ replacement happens correctly." hello there :END:" - "* org-babel-remove-result + "* org-babel-remove-result #+begin_src emacs-lisp :results wrap \"hello there\" @@ -950,7 +933,7 @@ hello there content #+END_SRC" -"* org-babel-remove-result + "* org-babel-remove-result #+begin_src emacs-lisp :results org \"* heading ** subheading @@ -966,7 +949,7 @@ content\" #+END_HTML" -"* org-babel-remove-result + "* org-babel-remove-result #+begin_src emacs-lisp :results html \"\" #+end_src @@ -982,7 +965,7 @@ Line 2 Line 3 #+END_LaTeX" -"* org-babel-remove-result + "* org-babel-remove-result #+begin_src emacs-lisp :results latex \"Line 1 Line 2 @@ -999,7 +982,7 @@ Line 3\" \"I am working!\" #+END_SRC" -"* org-babel-remove-result + "* org-babel-remove-result #+begin_src emacs-lisp :results code (message \"I am working!\") #+end_src @@ -1011,7 +994,7 @@ Line 3\" (test-ob-verify-result-and-removed-result ": \"I /am/ working!\"" -"* org-babel-remove-result + "* org-babel-remove-result #+begin_src emacs-lisp :results pp \"I /am/ working!\") #+end_src @@ -1022,11 +1005,11 @@ Line 3\" (org-test-with-temp-text "Block two has a space after the name. #+name: foo - #+begin_src emacs-lisp + #+begin_src emacs-lisp 1 #+end_src emacs-lisp -#+name: foo +#+name: foo #+begin_src emacs-lisp 2 #+end_src @@ -1048,6 +1031,82 @@ Line 3\" (move-beginning-of-line 0) (should (looking-at (format ": %d" num)))))) +(ert-deftest test-ob/blocks-with-spaces () + "Test expansion of blocks followed by blank lines." + (should + (equal "#+BEGIN_SRC emacs-lisp +\(+ 1 2) +#+END_SRC + +#+RESULTS: +: 3\n\n\n" + (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp +\(+ 1 2) +#+END_SRC\n\n\n" + (org-babel-execute-src-block) + (buffer-string))))) + +(ert-deftest test-ob/results-in-narrowed-buffer () + "Test block execution in a narrowed buffer." + ;; If results don't exist, they should be inserted in visible part + ;; of the buffer. + (should + (equal + "#+BEGIN_SRC emacs-lisp\n(+ 1 2)\n#+END_SRC\n\n#+RESULTS:\n: 3" + (org-test-with-temp-text + "#+BEGIN_SRC emacs-lisp\n(+ 1 2)\n#+END_SRC\n\nParagraph" + (narrow-to-region (point) (save-excursion (forward-line 3) (point))) + (org-babel-execute-src-block) + (org-trim (buffer-string))))) + (should + (equal + "#+NAME: test\n#+BEGIN_SRC emacs-lisp\n(+ 1 2)\n#+END_SRC\n\n#+RESULTS: test\n: 3" + (org-test-with-temp-text + "#+NAME: test\n#+BEGIN_SRC emacs-lisp\n(+ 1 2)\n#+END_SRC\n\nParagraph" + (narrow-to-region (point) (save-excursion (forward-line 4) (point))) + (org-babel-execute-src-block) + (org-trim (buffer-string))))) + ;; Results in visible part of buffer, should be updated here. + (should + (equal + "#+NAME: test +#+BEGIN_SRC emacs-lisp +\(+ 1 2) +#+END_SRC + +#+RESULTS: test +: 3" + (org-test-with-temp-text + "#+NAME: test +#+BEGIN_SRC emacs-lisp +\(+ 1 2) +#+END_SRC + +#+RESULTS: test +: 4 + +Paragraph" + (narrow-to-region (point) (save-excursion (forward-line 7) (point))) + (org-babel-execute-src-block) + (org-trim (buffer-string))))) + ;; Results in invisible part of buffer, should be updated there. + (org-test-with-temp-text + "#+NAME: test +#+BEGIN_SRC emacs-lisp +\(+ 1 2) +#+END_SRC + +#+RESULTS: test +: 4 + +Paragraph" + (narrow-to-region (point) (save-excursion (forward-line 4) (point))) + (org-babel-execute-src-block) + (should-not (re-search-forward "^#\\+RESULTS:" nil t)) + (widen) + (should (should (re-search-forward "^: 3" nil t))))) + + (provide 'test-ob) ;;; test-ob ends here diff --git a/testing/lisp/test-org-clock.el b/testing/lisp/test-org-clock.el new file mode 100644 index 000000000..2dc2150dd --- /dev/null +++ b/testing/lisp/test-org-clock.el @@ -0,0 +1,152 @@ +;;; test-org-clock.el --- Tests for org-clock.el + +;; Copyright (C) 2012 Nicolas Goaziou + +;; Author: Nicolas Goaziou + +;; Released under the GNU General Public License version 3 +;; see: http://www.gnu.org/licenses/gpl-3.0.html + +;;;; Comments + + + +;;; Code: + +(defun org-test-clock-create-timestamp (input &optional inactive with-time) + "Create a timestamp out of a date/time prompt string. + +INPUT is a string as expected in a date/time prompt, i.e \"+2d\" +or \"2/5\". + +When optional argument INACTIVE is non-nil, return an inactive +timestamp. When optional argument WITH-TIME is non-nil, also +insert hours and minutes. + +Return the timestamp as a string." + (org-element-interpret-data + (let ((time (decode-time + (apply 'encode-time + (mapcar (lambda (el) (or el 0)) + (org-read-date-analyze + input nil (decode-time (current-time)))))))) + (list 'timestamp + (list :type (if inactive 'inactive 'active) + :minute-start (and with-time (nth 1 time)) + :hour-start (and with-time (nth 2 time)) + :day-start (nth 3 time) + :month-start (nth 4 time) + :year-start (nth 5 time)))))) + +(defun org-test-clock-create-clock (input1 &optional input2) + "Create a clock line out of two date/time prompts. + +INPUT1 and INPUT2 are strings as expected in a date/time prompt, +i.e \"+2d\" or \"2/5\". They respectively refer to start and end +range. INPUT2 can be omitted if clock hasn't finished yet. + +Return the clock line as a string." + (let* ((beg (org-test-clock-create-timestamp input1 t t)) + (end (and input2 (org-test-clock-create-timestamp input2 t t))) + (sec-diff (and input2 (floor (- (org-time-string-to-seconds end) + (org-time-string-to-seconds beg)))))) + (concat org-clock-string " " beg + (when end + (concat "--" end " => " + (format "%2d:%02d" + (/ sec-diff 3600) + (/ (mod sec-diff 3600) 60)))) + "\n"))) + +(defun test-org-clock-clocktable-contents-at-point (options) + "Return contents of a clocktable at point. +OPTIONS is a string of clocktable options. Caption is ignored in +contents. The clocktable doesn't appear in the buffer." + (save-excursion + (insert "#+BEGIN: clocktable " options "\n") + (insert "#+END: clocktable\n")) + (unwind-protect + (save-excursion + (org-update-dblock) + (forward-line) + ;; Skip caption. + (when (looking-at "#\\+CAPTION:") (forward-line)) + (buffer-substring (point) + (progn (search-forward "#+END: clocktable") + (match-beginning 0)))) + ;; Remove clocktable. + (delete-region (point) + (progn (search-forward "#+END: clocktable") + (forward-line) + (point))))) + + + +;;; Clocktable + +(ert-deftest test-org-clock/clocktable () + "Test clocktable specifications." + ;; Relative time: Previous two days. + (should + (equal + "| Headline | Time | | +|------------------------------+---------+-------| +| *Total time* | *16:00* | | +|------------------------------+---------+-------| +| Relative times in clocktable | 16:00 | | +| Foo | | 5:00 | +| Bar | | 11:00 | +" + (org-test-with-temp-text "* Relative times in clocktable\n** Foo\n** Bar\n" + (progn + ;; Install Clock lines in "Foo". + (search-forward "** Foo") + (forward-line) + (insert (org-test-clock-create-clock "-2d 8:00" "-2d 13:00")) + (insert (org-test-clock-create-clock ". 8:00" "13:00")) + ;; Install Clock lines in "Bar". + (search-forward "** Bar") + (forward-line) + (insert (org-test-clock-create-clock "-2d 15:00" "-2d 18:00")) + (insert (org-test-clock-create-clock "-1d 8:00" "-1d 13:00")) + (insert (org-test-clock-create-clock "-1d 15:00" "-1d 18:00")) + (insert (org-test-clock-create-clock ". 15:00")) + ;; Previous two days. + (goto-char (point-min)) + (forward-line) + (test-org-clock-clocktable-contents-at-point + ":tstart \"\" :tend \"\" :indent nil"))))) + ;; Relative time: Yesterday until now. + (should + (equal + "| Headline | Time | | +|------------------------------+---------+------| +| *Total time* | *13:00* | | +|------------------------------+---------+------| +| Relative times in clocktable | 13:00 | | +| Foo | | 5:00 | +| Bar | | 8:00 | +" + (org-test-with-temp-text "* Relative times in clocktable\n** Foo\n** Bar\n" + (progn + ;; Install Clock lines in "Foo". + (search-forward "** Foo") + (forward-line) + (insert (org-test-clock-create-clock "-2d 8:00" "-2d 13:00")) + (insert (org-test-clock-create-clock ". 8:00" "13:00")) + ;; Install Clock lines in "Bar". + (search-forward "** Bar") + (forward-line) + (insert (org-test-clock-create-clock "-2d 15:00" "-2d 18:00")) + (insert (org-test-clock-create-clock "-1d 8:00" "-1d 13:00")) + (insert (org-test-clock-create-clock "-1d 15:00" "-1d 18:00")) + (insert (org-test-clock-create-clock ". 15:00")) + ;; Previous two days. + (goto-char (point-min)) + (forward-line) + (test-org-clock-clocktable-contents-at-point + ":tstart \"\" :tend \"\" :indent nil")))))) + + +(provide 'test-org-clock) +;;; test-org-clock.el end here diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 29e1af8cd..7c8b08288 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -63,7 +63,14 @@ Some other text (should-not (org-test-with-temp-text "#+BEGIN_CENTER\n\\alpha\n#+END_CENTER" (org-element-map - (org-element-parse-buffer) 'entity 'identity nil nil 'center-block)))) + (org-element-parse-buffer) 'entity 'identity nil nil 'center-block))) + ;; Use WITH-AFFILIATED argument. + (should + (equal + '("a" "1" "b" "2") + (org-test-with-temp-text "#+CAPTION[a]: 1\n#+CAPTION[b]: 2\nParagraph" + (org-element-map + (org-element-at-point) 'plain-text 'identity nil nil nil t))))) @@ -71,12 +78,16 @@ Some other text (ert-deftest test-org-element/put-property () "Test `org-element-put-property' specifications." + ;; Standard test. (org-test-with-temp-text "* Headline\n *a*" (let ((tree (org-element-parse-buffer))) (org-element-put-property (org-element-map tree 'bold 'identity nil t) :test 1) (should (org-element-property - :test (org-element-map tree 'bold 'identity nil t)))))) + :test (org-element-map tree 'bold 'identity nil t))))) + ;; Put property on a string. + (should + (org-element-property :test (org-element-put-property "Paragraph" :test t)))) (ert-deftest test-org-element/set-contents () "Test `org-element-set-contents' specifications." @@ -167,10 +178,16 @@ Some other text :name (org-test-with-temp-text "#+NAME: para\nParagraph" (org-element-at-point))))) + (should + (= 1 + (org-element-property + :begin + (org-test-with-temp-text "#+NAME: para\nParagraph" + (org-element-at-point))))) ;; Parse multiple keywords. (should (equal - '("line1" "line2") + '("line2" "line1") (org-element-property :attr_ascii (org-test-with-temp-text @@ -179,15 +196,36 @@ Some other text ;; Parse "parsed" keywords. (should (equal - '("caption") + '(("caption")) (org-test-with-temp-text "#+CAPTION: caption\nParagraph" (car (org-element-property :caption (org-element-at-point)))))) ;; Parse dual keywords. (should (equal - '(("long") "short") + '((("long") "short")) (org-test-with-temp-text "#+CAPTION[short]: long\nParagraph" - (org-element-property :caption (org-element-at-point)))))) + (org-element-property :caption (org-element-at-point))))) + ;; Allow multiple caption keywords. + (should + (equal + '((("l2") "s2") (("l1") "s1")) + (org-test-with-temp-text "#+CAPTION[s1]: l1\n#+CAPTION[s2]: l2\nParagraph" + (org-element-property :caption (org-element-at-point))))) + (should + (equal + '((("l1")) (nil "s1")) + (org-test-with-temp-text "#+CAPTION[s1]:\n#+CAPTION: l1\nParagraph" + (org-element-property :caption (org-element-at-point))))) + ;; Corner case: orphaned keyword at the end of an element. + (should + (eq 'keyword + (org-test-with-temp-text "- item\n #+name: name\nSome paragraph" + (progn (search-forward "name") + (org-element-type (org-element-at-point)))))) + (should-not + (org-test-with-temp-text "- item\n #+name: name\nSome paragraph" + (progn (search-forward "Some") + (org-element-property :name (org-element-at-point)))))) ;;;; Babel Call @@ -257,22 +295,24 @@ Some other text ;; Running clock. (let* ((org-clock-string "CLOCK:") (clock (org-test-with-temp-text "CLOCK: [2012-01-01 sun. 00:01]" - (org-element-map - (org-element-parse-buffer) 'clock 'identity nil t)))) + (org-element-at-point)))) (should (eq (org-element-property :status clock) 'running)) - (should (equal (org-element-property :value clock) - "[2012-01-01 sun. 00:01]")) - (should-not (org-element-property :time clock))) + (should + (equal (org-element-property :raw-value + (org-element-property :value clock)) + "[2012-01-01 sun. 00:01]")) + (should-not (org-element-property :duration clock))) ;; Closed clock. (let* ((org-clock-string "CLOCK:") - (clock (org-test-with-temp-text " -CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01" - (org-element-map - (org-element-parse-buffer) 'clock 'identity nil t)))) + (clock + (org-test-with-temp-text + "CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01" + (org-element-at-point)))) (should (eq (org-element-property :status clock) 'closed)) - (should (equal (org-element-property :value clock) + (should (equal (org-element-property :raw-value + (org-element-property :value clock)) "[2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02]")) - (should (equal (org-element-property :time clock) "0:01")))) + (should (equal (org-element-property :duration clock) "0:01")))) ;;;; Code @@ -368,6 +408,23 @@ CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01" (org-element-parse-buffer) 'comment-block 'identity nil t)))) +;;;; Diary Sexp + +(ert-deftest test-org-element/diary-sexp-parser () + "Test `diary-sexp' parser." + ;; Standard test. + (should + (eq 'diary-sexp + (org-test-with-temp-text + "%%(org-anniversary 1956 5 14)(2) Arthur Dent is %d years old" + (org-element-type (org-element-at-point))))) + ;; Diary sexp must live at beginning of line + (should-not + (eq 'diary-sexp + (org-test-with-temp-text " %%(org-bbdb-anniversaries)" + (org-element-type (org-element-at-point)))))) + + ;;;; Drawer (ert-deftest test-org-element/drawer-parser () @@ -667,10 +724,10 @@ CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01" (org-element-parse-buffer) 'footnote-definition 'identity nil t))) ;; Footnote with more contents (should - (= 28 + (= 29 (org-element-property :end - (org-test-with-temp-text "[fn:1] Definition\n| a | b |" + (org-test-with-temp-text "[fn:1] Definition\n\n| a | b |" (org-element-map (org-element-parse-buffer) 'footnote-definition 'identity nil t))))) @@ -817,6 +874,17 @@ CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01" ;; Test tag removal. (should (equal (org-element-property :tags headline) '("test"))))))) +(ert-deftest test-org-element/headline-properties () + "Test properties from property drawer." + ;; All properties from property drawer have their symbol upper + ;; cased. + (should + (org-test-with-temp-text "* Headline\n:PROPERTIES:\n:foo: bar\n:END:" + (org-element-property :FOO (org-element-at-point)))) + (should-not + (org-test-with-temp-text "* Headline\n:PROPERTIES:\n:foo: bar\n:END:" + (org-element-property :foo (org-element-at-point))))) + ;;;; Horizontal Rule @@ -886,8 +954,8 @@ CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01" (org-test-with-temp-text "*************** TODO Task" (org-element-property :todo-keyword - (org-element-map - (org-element-parse-buffer) 'inlinetask 'identity nil t)))))) + (org-element-map (org-element-parse-buffer) 'inlinetask + 'identity nil t)))))) ;; Planning info. (should (equal @@ -897,8 +965,7 @@ CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01" DEADLINE: <2012-03-29 thu.>" (org-element-property :deadline - (org-element-map - (org-element-parse-buffer) 'inlinetask 'identity nil t))))) + (org-element-map (org-element-parse-buffer) 'inlinetask 'identity nil t))))) ;; Priority. (should (equal @@ -908,7 +975,7 @@ DEADLINE: <2012-03-29 thu.>" (org-element-property :priority (org-element-map - (org-element-parse-buffer) 'inlinetask 'identity nil t))))) + (org-element-parse-buffer) 'inlinetask 'identity nil t))))) ;; Tags. (should (equal @@ -918,7 +985,26 @@ DEADLINE: <2012-03-29 thu.>" (org-element-property :tags (org-element-map - (org-element-parse-buffer) 'inlinetask 'identity nil t)))))))) + (org-element-parse-buffer) 'inlinetask 'identity nil t))))) + ;; Regular properties are accessed through upper case keywords. + (should + (org-test-with-temp-text " +*************** Task +:PROPERTIES: +:foo: bar +:END: +*************** END" + (forward-line) + (org-element-property :FOO (org-element-at-point)))) + (should-not + (org-test-with-temp-text " +*************** Task +:PROPERTIES: +:foo: bar +:END: +*************** END" + (forward-line) + (org-element-property :foo (org-element-at-point))))))) ;;;; Italic @@ -1107,7 +1193,7 @@ e^{i\\pi}+1=0 (ert-deftest test-org-element/link-parser () "Test `link' parser." - ;; 1. Radio target. + ;; Radio target. (should (equal "radio" @@ -1115,18 +1201,18 @@ e^{i\\pi}+1=0 (org-element-property :type (org-element-map - (let ((org-target-link-regexp "radio")) (org-element-parse-buffer)) - 'link 'identity nil t))))) - ;; 2. Standard link. + (let ((org-target-link-regexp "radio")) (org-element-parse-buffer)) + 'link 'identity nil t))))) + ;; Standard link. ;; - ;; 2.1. With description. + ;; ... with description. (should (equal '("Orgmode.org") (org-test-with-temp-text "[[http://orgmode.org][Orgmode.org]]" (org-element-contents (org-element-map (org-element-parse-buffer) 'link 'identity nil t))))) - ;; 2.2. Without description. + ;; ... without description. (should (equal "http" @@ -1134,7 +1220,7 @@ e^{i\\pi}+1=0 (org-element-property :type (org-element-map (org-element-parse-buffer) 'link 'identity nil t))))) - ;; 2.3. With expansion. + ;; ... with expansion. (should (equal "//orgmode.org/worg" @@ -1143,7 +1229,7 @@ e^{i\\pi}+1=0 (org-element-property :path (org-element-map (org-element-parse-buffer) 'link 'identity nil t)))))) - ;; 2.4. With translation. + ;; ... with translation. (should (equal "127.0.0.1" @@ -1152,9 +1238,9 @@ e^{i\\pi}+1=0 (let ((org-link-translation-function 'link-translate)) (org-element-property :path - (org-element-map - (org-element-parse-buffer) 'link 'identity nil t))))))) - ;; 2.5. Id link. + (org-element-map (org-element-parse-buffer) 'link + 'identity nil t))))))) + ;; ... id link. (should (equal "id" @@ -1162,7 +1248,7 @@ e^{i\\pi}+1=0 (org-element-property :type (org-element-map (org-element-parse-buffer) 'link 'identity nil t))))) - ;; 2.6. Custom-id link. + ;; ... custom-id link. (should (equal "custom-id" @@ -1170,7 +1256,7 @@ e^{i\\pi}+1=0 (org-element-property :type (org-element-map (org-element-parse-buffer) 'link 'identity nil t))))) - ;; 2.7 Coderef link. + ;; ... coderef link. (should (equal "coderef" @@ -1178,7 +1264,7 @@ e^{i\\pi}+1=0 (org-element-property :type (org-element-map (org-element-parse-buffer) 'link 'identity nil t))))) - ;; 2.8 Fuzzy link. + ;; ... fuzzy link. (should (equal "fuzzy" @@ -1186,14 +1272,55 @@ e^{i\\pi}+1=0 (org-element-property :type (org-element-map (org-element-parse-buffer) 'link 'identity nil t))))) - ;; 3. Plain link. + ;; ... file-type link with search option. + (should + (equal + '(("file" "projects.org" "*task title")) + (org-test-with-temp-text "[[file:projects.org::*task title]]" + (org-element-map (org-element-parse-buffer) 'link + (lambda (l) (list (org-element-property :type l) + (org-element-property :path l) + (org-element-property :search-option l))))))) + ;; ... file-type link with application. + (should + (equal + '(("file" "projects.org" "docview")) + (org-test-with-temp-text "[[docview:projects.org]]" + (org-element-map (org-element-parse-buffer) 'link + (lambda (l) (list (org-element-property :type l) + (org-element-property :path l) + (org-element-property :application l))))))) + ;; Plain link. (should (org-test-with-temp-text "A link: http://orgmode.org" (org-element-map (org-element-parse-buffer) 'link 'identity))) - ;; 4. Angular link. + ;; Angular link. (should (org-test-with-temp-text "A link: " - (org-element-map (org-element-parse-buffer) 'link 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'link 'identity nil t))) + ;; Link abbreviation. + (should + (equal "http" + (org-test-with-temp-text + "#+LINK: orgmode http://www.orgmode.org/\n[[orgmode:#docs]]" + (progn (org-mode-restart) + (goto-char (point-max)) + (org-element-property :type (org-element-context)))))) + ;; Link abbreviation in a secondary string. + (should + (equal "http" + (org-test-with-temp-text + "#+LINK: orgmode http://www.orgmode.org/\n* H [[orgmode:#docs]]" + (progn (org-mode-restart) + (org-element-map (org-element-parse-buffer) 'link + (lambda (link) (org-element-property :type link)) + nil t nil t))))) + ;; Plain links are allowed as description of regular links. + (should + (equal "file" + (org-test-with-temp-text "[[http://orgmode.org][file:unicorn.jpg]]" + (search-forward "file:") + (org-element-property :type (org-element-context)))))) ;;;; Macro @@ -1218,9 +1345,45 @@ e^{i\\pi}+1=0 (should (equal '("C-,") (org-test-with-temp-text "{{{macro(C-\\,)}}}" + (org-element-property :args (org-element-context))))) + ;; Allow to escape escaping character. + (should + (equal '("C-\\" "") + (org-test-with-temp-text "{{{macro(C-\\\\,)}}}" + (org-element-property :args (org-element-context))))) + ;; No need to escape backslashes elsewhere. + (should + (equal '("\\") + (org-test-with-temp-text "{{{macro(\\)}}}" (org-element-property :args (org-element-context)))))) +;;;; Node Property + +(ert-deftest test-org-element/node-property () + "Test `node-property' parser." + ;; Standard test. + (should + (equal '("abc" "value") + (org-test-with-temp-text ":PROPERTIES:\n:abc: value\n:END:" + (progn (forward-line) + (let ((element (org-element-at-point))) + (list (org-element-property :key element) + (org-element-property :value element))))))) + ;; Value should be trimmed. + (should + (equal "value" + (org-test-with-temp-text ":PROPERTIES:\n:abc: value \n:END:" + (progn (forward-line) + (let ((element (org-element-at-point))) + (org-element-property :value element)))))) + ;; A node property requires to be wrapped within a property drawer. + (should-not + (eq 'node-property + (org-test-with-temp-text ":abc: value" + (org-element-type (org-element-at-point)))))) + + ;;;; Paragraph (ert-deftest test-org-element/paragraph-parser () @@ -1309,26 +1472,29 @@ Outside list" (ert-deftest test-org-element/planning-parser () "Test `planning' parser." (should - (equal - (org-element-property - :closed - (org-test-with-temp-text "CLOSED: [2012-03-29 thu.]" - (org-element-map (org-element-parse-buffer) 'planning 'identity nil t))) - "2012-03-29 thu.")) + (equal "[2012-03-29 thu.]" + (org-element-property + :raw-value + (org-element-property + :closed + (org-test-with-temp-text "CLOSED: [2012-03-29 thu.]" + (org-element-at-point)))))) (should - (equal - (org-element-property - :deadline - (org-test-with-temp-text "DEADLINE: <2012-03-29 thu.>" - (org-element-map (org-element-parse-buffer) 'planning 'identity nil t))) - "2012-03-29 thu.")) + (equal "<2012-03-29 thu.>" + (org-element-property + :raw-value + (org-element-property + :deadline + (org-test-with-temp-text "DEADLINE: <2012-03-29 thu.>" + (org-element-at-point)))))) (should - (equal - (org-element-property - :scheduled - (org-test-with-temp-text "SCHEDULED: <2012-03-29 thu.>" - (org-element-map (org-element-parse-buffer) 'planning 'identity nil t))) - "2012-03-29 thu."))) + (equal "<2012-03-29 thu.>" + (org-element-property + :raw-value + (org-element-property + :scheduled + (org-test-with-temp-text "SCHEDULED: <2012-03-29 thu.>" + (org-element-at-point))))))) ;;;; Property Drawer @@ -1531,12 +1697,6 @@ Outside list" (should (org-test-with-temp-text "a_{b}" (org-element-map (org-element-parse-buffer) 'subscript 'identity))) - ;; At the beginning of an item. - (should - (eq 'subscript - (org-test-with-temp-text "- _b" - (progn (search-forward "_") - (org-element-type (org-element-context)))))) ;; Multiple subscripts in a paragraph. (should (= 2 @@ -1557,12 +1717,6 @@ Outside list" (should (org-test-with-temp-text "a^{b}" (org-element-map (org-element-parse-buffer) 'superscript 'identity))) - ;; At the beginning of an item. - (should - (eq 'superscript - (org-test-with-temp-text "- ^b" - (progn (search-forward "^") - (org-element-type (org-element-context)))))) ;; Multiple superscript in a paragraph. (should (= 2 @@ -1634,30 +1788,58 @@ Outside list" ;; Active timestamp. (should (org-test-with-temp-text "<2012-03-29 16:40>" - (eq (org-element-property :type - (org-element-map - (org-element-parse-buffer) - 'timestamp 'identity nil t)) - 'active))) + (eq (org-element-property :type (org-element-context)) 'active))) + (should-not + (org-test-with-temp-text "<2012-03-29 Thu>" + (let ((timestamp (org-element-context))) + (or (org-element-property :hour-start timestamp) + (org-element-property :minute-start timestamp))))) + (should + (equal '(2012 3 29 16 40) + (org-test-with-temp-text "<2012-03-29 Thu 16:40>" + (let ((object (org-element-context))) + (list (org-element-property :year-start object) + (org-element-property :month-start object) + (org-element-property :day-start object) + (org-element-property :hour-start object) + (org-element-property :minute-start object)))))) ;; Inactive timestamp. (should - (org-test-with-temp-text "[2012-03-29 16:40]" - (eq (org-element-property :type - (org-element-map - (org-element-parse-buffer) - 'timestamp 'identity nil t)) - 'inactive))) + (org-test-with-temp-text "[2012-03-29 Thu 16:40]" + (eq (org-element-property :type (org-element-context)) 'inactive))) + ;; Time range. + (should + (equal '(2012 3 29 16 40 7 30) + (org-test-with-temp-text "<2012-03-29 Thu 7:30-16:40>" + (let ((object (org-element-context))) + (list (org-element-property :year-end object) + (org-element-property :month-end object) + (org-element-property :day-end object) + (org-element-property :hour-end object) + (org-element-property :minute-end object) + (org-element-property :hour-start object) + (org-element-property :minute-start object)))))) + (should + (eq 'active-range + (org-test-with-temp-text "<2012-03-29 Thu 7:30-16:40>" + (org-element-property :type (org-element-context))))) ;; Date range. (should - (org-test-with-temp-text "[2012-03-29 16:40]--[2012-03-29 16:41]" - (eq (org-element-property :type - (org-element-map - (org-element-parse-buffer) - 'timestamp 'identity nil t)) - 'inactive-range))) + (org-test-with-temp-text "[2012-03-29 Thu 16:40]--[2012-03-29 Thu 16:41]" + (eq (org-element-property :type (org-element-context)) 'inactive-range))) + (should-not + (org-test-with-temp-text "[2011-07-14 Thu]--[2012-03-29 Thu]" + (let ((timestamp (org-element-context))) + (or (org-element-property :hour-end timestamp) + (org-element-property :minute-end timestamp))))) + ;; With repeater. + (should + (eq 'catch-up + (org-test-with-temp-text "<2012-03-29 Thu ++1y>" + (org-element-property :repeater-type (org-element-context))))) ;; Timestamps are not planning elements. (should-not - (org-test-with-temp-text "SCHEDULED: <2012-03-29 16:40>" + (org-test-with-temp-text "SCHEDULED: <2012-03-29 Thu 16:40>" (org-element-map (org-element-parse-buffer) 'timestamp 'identity)))) @@ -1747,20 +1929,27 @@ Outside list" (should (equal (org-element-interpret-data - '(org-data nil (paragraph (:attr_ascii ("line1" "line2")) "Paragraph"))) + '(org-data nil (paragraph (:attr_ascii ("line2" "line1")) "Paragraph"))) "#+ATTR_ASCII: line1\n#+ATTR_ASCII: line2\nParagraph\n")) ;; Interpret parsed keywords. (should (equal (org-element-interpret-data - '(org-data nil (paragraph (:caption ("caption")) "Paragraph"))) + '(org-data nil (paragraph (:caption (("caption"))) "Paragraph"))) "#+CAPTION: caption\nParagraph\n")) ;; Interpret dual keywords. (should (equal (org-element-interpret-data - '(org-data nil (paragraph (:caption (("long") "short")) "Paragraph"))) - "#+CAPTION[short]: long\nParagraph\n"))) + '(org-data nil (paragraph (:caption ((("long") "short"))) "Paragraph"))) + "#+CAPTION[short]: long\nParagraph\n")) + ;; Interpret multiple parsed dual keywords. + (should + (equal + (org-element-interpret-data + '(org-data nil (paragraph + (:caption ((("l2") "s2") (("l1") "s1"))) "Paragraph"))) + "#+CAPTION[s1]: l1\n#+CAPTION[s2]: l2\nParagraph\n"))) (ert-deftest test-org-element/center-block-interpreter () "Test center block interpreter." @@ -1959,6 +2148,14 @@ CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01")) "#+BEGIN_COMMENT\nTest\n#+END_COMMENT") "#+BEGIN_COMMENT\nTest\n#+END_COMMENT\n"))) +(ert-deftest test-org-element/diary-sexp () + "Test diary-sexp interpreter." + (should + (equal + (org-test-parse-and-interpret + "%%(org-anniversary 1956 5 14)(2) Arthur Dent is %d years old") + "%%(org-anniversary 1956 5 14)(2) Arthur Dent is %d years old\n"))) + (ert-deftest test-org-element/example-block-interpreter () "Test example block interpreter." ;; Without switches. @@ -2014,9 +2211,9 @@ CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01")) (equal (org-test-parse-and-interpret "* Headline -CLOSED: [2012-01-01] DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01>") +DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01> CLOSED: [2012-01-01]") "* Headline -CLOSED: [2012-01-01] DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01>\n")))) +DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01> CLOSED: [2012-01-01]\n")))) (ert-deftest test-org-element/property-drawer-interpreter () "Test property drawer interpreter." @@ -2071,25 +2268,75 @@ CLOSED: [2012-01-01] DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01>\n")))) (ert-deftest test-org-element/timestamp-interpreter () "Test timestamp interpreter." ;; Active. - (should (equal (org-test-parse-and-interpret "<2012-03-29 16:40>") - "<2012-03-29 16:40>\n")) + (should (equal (org-test-parse-and-interpret "<2012-03-29 thu. 16:40>") + "<2012-03-29 thu. 16:40>\n")) + (should + (string-match "<2012-03-29 .* 16:40>" + (org-element-timestamp-interpreter + '(timestamp + (:type active :year-start 2012 :month-start 3 :day-start 29 + :hour-start 16 :minute-start 40)) nil))) ;; Inactive. - (should (equal (org-test-parse-and-interpret "[2012-03-29 16:40]") - "[2012-03-29 16:40]\n")) + (should (equal (org-test-parse-and-interpret "[2012-03-29 thu. 16:40]") + "[2012-03-29 thu. 16:40]\n")) + (should + (string-match + "\\[2012-03-29 .* 16:40\\]" + (org-element-timestamp-interpreter + '(timestamp + (:type inactive :year-start 2012 :month-start 3 :day-start 29 + :hour-start 16 :minute-start 40)) nil))) ;; Active range. (should (equal (org-test-parse-and-interpret - "<2012-03-29 16:40>--<2012-03-29 16:41>") - "<2012-03-29 16:40>--<2012-03-29 16:41>\n")) + "<2012-03-29 thu. 16:40>--<2012-03-29 thu. 16:41>") + "<2012-03-29 thu. 16:40>--<2012-03-29 thu. 16:41>\n")) + (should + (string-match + "<2012-03-29 .* 16:40>--<2012-03-29 .* 16:41>" + (org-element-timestamp-interpreter + '(timestamp + (:type active-range :year-start 2012 :month-start 3 :day-start 29 + :hour-start 16 :minute-start 40 :year-end 2012 :month-end 3 + :day-end 29 :hour-end 16 :minute-end 41)) nil))) ;; Inactive range. (should (equal (org-test-parse-and-interpret - "[2012-03-29 16:40]--[2012-03-29 16:41]") - "[2012-03-29 16:40]--[2012-03-29 16:41]\n")) + "[2012-03-29 thu. 16:40]--[2012-03-29 thu. 16:41]") + "[2012-03-29 thu. 16:40]--[2012-03-29 thu. 16:41]\n")) + (should + (string-match + "\\[2012-03-29 .* 16:40\\]--\\[2012-03-29 .* 16:41\\]" + (org-element-timestamp-interpreter + '(timestamp + (:type inactive-range :year-start 2012 :month-start 3 :day-start 29 + :hour-start 16 :minute-start 40 :year-end 2012 :month-end 3 + :day-end 29 :hour-end 16 :minute-end 41)) nil))) ;; Diary. (should (equal (org-test-parse-and-interpret "<%%diary-float t 4 2>") "<%%diary-float t 4 2>\n")) ;; Timestamp with repeater interval. - (should (equal (org-test-parse-and-interpret "<2012-03-29 +1y>") - "<2012-03-29 +1y>\n"))) + (should (equal (org-test-parse-and-interpret "<2012-03-29 thu. +1y>") + "<2012-03-29 thu. +1y>\n")) + (should + (string-match + "<2012-03-29 .* \\+1y>" + (org-element-timestamp-interpreter + '(timestamp + (:type active :year-start 2012 :month-start 3 :day-start 29 + :repeater-type cumulate :repeater-value 1 :repeater-unit year)) + nil))) + ;; Timestamp range with repeater interval + (should (equal (org-test-parse-and-interpret + "<2012-03-29 Thu +1y>--<2012-03-30 Thu +1y>") + "<2012-03-29 Thu +1y>--<2012-03-30 Thu +1y>\n")) + (should + (string-match + "<2012-03-29 .* \\+1y>--<2012-03-30 .* \\+1y>" + (org-element-timestamp-interpreter + '(timestamp + (:type active-range :year-start 2012 :month-start 3 :day-start 29 + :year-end 2012 :month-end 3 :day-end 30 :repeater-type cumulate + :repeater-value 1 :repeater-unit year)) + nil)))) (ert-deftest test-org-element/verse-block-interpreter () "Test verse block interpretation." @@ -2456,7 +2703,7 @@ Paragraph \\alpha." (org-test-with-temp-text "- Para1\n\n- Para2" (progn (forward-line) (org-element-type - (let ((org-empty-line-terminates-plain-lists nil)) + (let ((org-list-empty-line-terminates-plain-lists nil)) (org-element-at-point))))))) ;; Special case: at the last blank line in a plain list, return it ;; instead of the last item. @@ -2505,6 +2752,24 @@ Paragraph \\alpha." (org-test-with-temp-text "| a | b {{{macro}}} |" (progn (search-forward "b") (org-element-type (org-element-context)))))) + ;; Find objects in document keywords. + (should + (eq 'macro + (org-test-with-temp-text "#+DATE: {{{macro}}}" + (progn (search-forward "{") + (org-element-type (org-element-context)))))) + ;; Do not find objects in table rules. + (should + (eq 'table-row + (org-test-with-temp-text "| a | b |\n+---+---+\n| c | d |" + (forward-line) + (org-element-type (org-element-context))))) + ;; Find objects in parsed affiliated keywords. + (should + (eq 'macro + (org-test-with-temp-text "#+CAPTION: {{{macro}}}\n| a | b |." + (progn (search-forward "{") + (org-element-type (org-element-context)))))) ;; Correctly set `:parent' property. (should (eq 'paragraph @@ -2518,7 +2783,14 @@ Paragraph \\alpha." (org-test-with-temp-text "<>{{{test}}}" (progn (search-forward "{") (backward-char) - (org-element-type (org-element-context))))))) + (org-element-type (org-element-context)))))) + ;; Test optional argument. + (should + (eq 'underline + (org-test-with-temp-text "Some *text with _underline_ text*" + (progn + (search-forward "under") + (org-element-type (org-element-context (org-element-at-point)))))))) (provide 'test-org-element) diff --git a/testing/lisp/test-org-exp.el b/testing/lisp/test-org-exp.el deleted file mode 100644 index e207a52f3..000000000 --- a/testing/lisp/test-org-exp.el +++ /dev/null @@ -1,31 +0,0 @@ -;;; test-org-exp.el --- tests for org-exp.el - -;; Copyright (c) 2010-2013 Eric Schulte -;; Authors: Eric Schulte - -;; This file is not part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: -(ert-deftest test-org-exp/stripping-commas () - "Test the stripping of commas from within blocks during export." - (org-test-at-id "76d3a083-67fa-4506-a41d-837cc48158b5" - ;; don't strip internal commas - (org-narrow-to-subtree) - (should (string-match - ", 2" - (org-export-as-ascii nil nil 'string))))) - -(provide 'test-org-exp) diff --git a/testing/lisp/test-org-export.el b/testing/lisp/test-org-export.el deleted file mode 100644 index 093a423d0..000000000 --- a/testing/lisp/test-org-export.el +++ /dev/null @@ -1,1669 +0,0 @@ -;;; test-org-export.el --- Tests for org-export.el - -;; Copyright (C) 2012, 2013 Nicolas Goaziou - -;; Author: Nicolas Goaziou - -;; This file is not part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Code: - -(unless (featurep 'org-export) - (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 ((,(intern (format "org-%s-translate-alist" backend)) - ',(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))) - -(defmacro org-test-with-parsed-data (data &rest body) - "Execute body with parsed data available. - -DATA is a string containing the data to be parsed. BODY is the -body to execute. Parse tree is available under the `tree' -variable, and communication channel under `info'. - -This function calls `org-export-collect-tree-properties'. As -such, `:ignore-list' (for `org-element-map') and -`:parse-tree' (for `org-export-get-genealogy') properties are -already filled in `info'." - (declare (debug (form body)) (indent 1)) - `(org-test-with-temp-text ,data - (let* ((tree (org-element-parse-buffer)) - (info (org-export-collect-tree-properties - tree (org-export-get-environment)))) - ,@body))) - - - -;;; Tests - -(ert-deftest test-org-export/parse-option-keyword () - "Test reading all standard #+OPTIONS: items." - (should - (equal - (org-export--parse-option-keyword - "H:1 num:t \\n:t timestamp:t arch:t author:t creator:t d:t email:t - *:t e:t ::t f:t pri:t -:t ^:t toc:t |:t tags:t tasks:t <:t todo:t inline:nil") - '(:headline-levels - 1 :preserve-breaks t :section-numbers t :time-stamp-file t - :with-archived-trees t :with-author t :with-creator t :with-drawers t - :with-email t :with-emphasize t :with-entities t :with-fixed-width t - :with-footnotes t :with-inlinetasks nil :with-priority t - :with-special-strings t :with-sub-superscript t :with-toc t :with-tables t - :with-tags t :with-tasks t :with-timestamps t :with-todo-keywords t))) - ;; Test some special values. - (should - (equal - (org-export--parse-option-keyword - "arch:headline creator:comment d:(\"TEST\") - ^:{} toc:1 tags:not-in-toc tasks:todo num:2 <:active") - '( :section-numbers - 2 - :with-archived-trees headline :with-creator comment - :with-drawers ("TEST") :with-sub-superscript {} :with-toc 1 - :with-tags not-in-toc :with-tasks todo :with-timestamps active)))) - -(ert-deftest test-org-export/get-inbuffer-options () - "Test reading all standard export keywords." - (should - (equal - (org-test-with-temp-text "#+AUTHOR: Me, Myself and I -#+CREATOR: Idem -#+DATE: Today -#+DESCRIPTION: Testing -#+DESCRIPTION: with two lines -#+EMAIL: some@email.org -#+EXCLUDE_TAGS: noexport invisible -#+KEYWORDS: test -#+LANGUAGE: en -#+SELECT_TAGS: export -#+TITLE: Some title -#+TITLE: with spaces" - (org-export--get-inbuffer-options)) - '(:author - ("Me, Myself and I") :creator "Idem" :date ("Today") - :description "Testing\nwith two lines" :email "some@email.org" - :exclude-tags ("noexport" "invisible") :keywords "test" :language "en" - :select-tags ("export") :title ("Some title with spaces"))))) - -(ert-deftest test-org-export/get-subtree-options () - "Test setting options from headline's properties." - ;; EXPORT_TITLE. - (org-test-with-temp-text "#+TITLE: Title -* Headline - :PROPERTIES: - :EXPORT_TITLE: Subtree Title - :END: -Paragraph" - (forward-line) - (should (equal (plist-get (org-export-get-environment nil t) :title) - '("Subtree Title")))) - :title - '("subtree-title") - ;; EXPORT_OPTIONS. - (org-test-with-temp-text "#+OPTIONS: H:1 -* Headline - :PROPERTIES: - :EXPORT_OPTIONS: H:2 - :END: -Paragraph" - (forward-line) - (should - (= 2 (plist-get (org-export-get-environment nil t) :headline-levels)))) - ;; EXPORT_DATE. - (org-test-with-temp-text "#+DATE: today -* Headline - :PROPERTIES: - :EXPORT_DATE: 29-03-2012 - :END: -Paragraph" - (forward-line) - (should (equal (plist-get (org-export-get-environment nil t) :date) - '("29-03-2012")))) - ;; Export properties are case-insensitive. - (org-test-with-temp-text "* Headline - :PROPERTIES: - :EXPORT_Date: 29-03-2012 - :END: -Paragraph" - (should (equal (plist-get (org-export-get-environment nil t) :date) - '("29-03-2012"))))) - -(ert-deftest test-org-export/handle-options () - "Test if export options have an impact on output." - ;; Test exclude tags. - (org-test-with-temp-text "* Head1 :noexport:" - (org-test-with-backend test - (should - (equal (org-export-as 'test nil nil nil '(:exclude-tags ("noexport"))) - "")))) - ;; Test include tags. - (org-test-with-temp-text " -* Head1 -* Head2 -** Sub-Head2.1 :export: -*** Sub-Head2.1.1 -* Head2" - (org-test-with-backend test - (should - (equal - "* Head2\n** Sub-Head2.1 :export:\n*** Sub-Head2.1.1\n" - (let ((org-tags-column 0)) - (org-export-as 'test nil nil nil '(:select-tags ("export")))))))) - ;; Test mixing include tags and exclude tags. - (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"))))))) - ;; Ignore tasks. - (let ((org-todo-keywords '((sequence "TODO" "DONE")))) - (org-test-with-temp-text "* TODO Head1" - (org-test-with-backend test - (should (equal (org-export-as 'test nil nil nil '(:with-tasks nil)) - ""))))) - (let ((org-todo-keywords '((sequence "TODO" "DONE")))) - (org-test-with-temp-text "* TODO Head1" - (org-test-with-backend test - (should (equal (org-export-as 'test nil nil nil '(:with-tasks t)) - "* TODO Head1\n"))))) - ;; 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))))))) - ;; 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"))))) - ;; Timestamps. - (org-test-with-temp-text "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>" - (org-test-with-backend test - (should - (equal (org-export-as 'test nil nil nil '(:with-timestamps t)) - "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>\n")) - (should - (equal (org-export-as 'test nil nil nil '(:with-timestamps nil)) "")) - (should - (equal (org-export-as 'test nil nil nil '(:with-timestamps active)) - "<2012-04-29 sun. 10:45>\n")) - (should - (equal (org-export-as 'test nil nil nil '(:with-timestamps inactive)) - "[2012-04-29 sun. 10:45]\n")))) - ;; 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)) ""))))) - ;; 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-plannings t)) - "CLOSED: [2012-04-29 sun. 10:45]\n")) - (should - (equal (org-export-as 'test nil nil nil '(:with-plannings nil)) - ""))))) - ;; 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))))) - "")) - (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))))) - "")))) - -(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) "")))))) - -(ert-deftest test-org-export/export-scope () - "Test all export scopes." - (org-test-with-temp-text " -* Head1 -** 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")) - ;; Body only. - (flet ((org-test-template (body info) (format "BEGIN\n%sEND" body))) - (push '(template . org-test-template) org-test-translate-alist) - (should (equal (org-export-as 'test nil nil 'body-only) - "* Head1\n** Head2\ntext\n*** Head3\n")) - (should (equal (org-export-as 'test) - "BEGIN\n* Head1\n** Head2\ntext\n*** Head3\nEND"))) - ;; 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 with a code block calling another block outside. - (org-test-with-temp-text " -* Head1 -#+BEGIN_SRC emacs-lisp :noweb yes :exports results -<> -#+END_SRC -* Head2 -#+NAME: test -#+BEGIN_SRC emacs-lisp -\(+ 1 2) -#+END_SRC" - (org-test-with-backend test - (forward-line 1) - (should (equal (org-export-as 'test 'subtree) ": 3\n"))))) - -(ert-deftest test-org-export/expand-include () - "Test file inclusion in an Org buffer." - ;; Full insertion with recursive inclusion. - (org-test-with-temp-text - (format "#+INCLUDE: \"%s/examples/include.org\"" org-test-dir) - (org-export-expand-include-keyword) - (should (equal (buffer-string) - "Small Org file with an include keyword. - -#+BEGIN_SRC emacs-lisp :exports results\n(+ 2 1)\n#+END_SRC - -Success! - -* Heading -body\n"))) - ;; Localized insertion. - (org-test-with-temp-text - (format "#+INCLUDE: \"%s/examples/include.org\" :lines \"1-2\"" - org-test-dir) - (org-export-expand-include-keyword) - (should (equal (buffer-string) - "Small Org file with an include keyword.\n"))) - ;; Insertion with constraints on headlines level. - (org-test-with-temp-text - (format - "* Top heading\n#+INCLUDE: \"%s/examples/include.org\" :lines \"9-\"" - org-test-dir) - (org-export-expand-include-keyword) - (should (equal (buffer-string) "* Top heading\n** Heading\nbody\n"))) - ;; Inclusion within an example block. - (org-test-with-temp-text - (format "#+INCLUDE: \"%s/examples/include.org\" :lines \"1-2\" example" - org-test-dir) - (org-export-expand-include-keyword) - (should - (equal - (buffer-string) - "#+BEGIN_EXAMPLE\nSmall Org file with an include keyword.\n#+END_EXAMPLE\n"))) - ;; Inclusion within a src-block. - (org-test-with-temp-text - (format - "#+INCLUDE: \"%s/examples/include.org\" :lines \"4-5\" src emacs-lisp" - org-test-dir) - (org-export-expand-include-keyword) - (should (equal (buffer-string) - "#+BEGIN_SRC emacs-lisp\n(+ 2 1)\n#+END_SRC\n")))) - -(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"))))))) - -(ert-deftest test-org-export/before-parsing-hook () - "Test `org-export-before-parsing-hook'." - (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) - (org-map-entries - (lambda () - (delete-region (point) (progn (forward-line) (point))))))))) - (should (equal (org-export-as 'test) "Body 1\nBody 2\n")))))) - - - -;;; Affiliated Keywords - -(ert-deftest test-org-export/read-attribute () - "Test `org-export-read-attribute' specifications." - ;; Standard test. - (should - (equal - (org-export-read-attribute - :attr_html - (org-test-with-temp-text "#+ATTR_HTML: :a 1 :b 2\nParagraph" - (org-element-at-point))) - '(:a 1 :b 2))) - ;; Return nil on empty attribute. - (should-not - (org-export-read-attribute - :attr_html - (org-test-with-temp-text "Paragraph" (org-element-at-point))))) - - - -;;; Export Snippets - -(ert-deftest test-org-export/export-snippet () - "Test export snippets transcoding." - (org-test-with-temp-text "@@test:A@@@@t:B@@" - (org-test-with-backend test - (let ((org-test-translate-alist - (cons (cons 'export-snippet - (lambda (snippet contents info) - (when (eq (org-export-snippet-backend snippet) 'test) - (org-element-property :value snippet)))) - org-test-translate-alist))) - (let ((org-export-snippet-translation-alist nil)) - (should (equal (org-export-as 'test) "A\n"))) - (let ((org-export-snippet-translation-alist '(("t" . "test")))) - (should (equal (org-export-as 'test) "AB\n"))))))) - - - -;;; Footnotes - -(ert-deftest test-org-export/footnotes () - "Test footnotes specifications." - (let ((org-footnote-section nil) - (org-export-with-footnotes t)) - ;; 1. Read every type of footnote. - (should - (equal - '((1 . "A\n") (2 . "B") (3 . "C") (4 . "D")) - (org-test-with-parsed-data - "Text[fn:1] [1] [fn:label:C] [fn::D]\n\n[fn:1] A\n\n[1] B" - (org-element-map - tree 'footnote-reference - (lambda (ref) - (let ((def (org-export-get-footnote-definition ref info))) - (cons (org-export-get-footnote-number ref info) - (if (eq (org-element-property :type ref) 'inline) (car def) - (car (org-element-contents - (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)) - (org-element-map - tree 'footnote-reference - (lambda (ref) - (when (org-export-footnote-first-reference-p ref info) - (cons (org-export-get-footnote-number ref info) - (org-element-property :label ref)))) - info)))) - ;; 3. Test nested footnote in invisible definitions. - (org-test-with-temp-text "Text[1]\n\n[1] B [2]\n\n[2] C." - ;; Hide definitions. - (narrow-to-region (point) (point-at-eol)) - (let* ((tree (org-element-parse-buffer)) - (info (org-combine-plists - `(:parse-tree ,tree) - (org-export-collect-tree-properties - tree (org-export-get-environment))))) - ;; Both footnotes should be seen. - (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]. - -\[fn:2] B [fn:3] [fn::D]. - -\[fn:3] C." - (should (= (length (org-export-collect-footnote-definitions tree info)) - 4))) - ;; 5. Test export of footnotes defined outside parsing scope. - (org-test-with-temp-text "[fn:1] Out of scope -* Title -Paragraph[fn:1]" - (org-test-with-backend test - (let ((org-test-translate-alist - (cons (cons 'footnote-reference - (lambda (fn contents info) - (org-element-interpret-data - (org-export-get-footnote-definition fn info)))) - org-test-translate-alist))) - (forward-line) - (should (equal "ParagraphOut of scope\n" - (org-export-as 'test 'subtree)))))))) - - - -;;; Headlines and Inlinetasks - -(ert-deftest test-org-export/get-relative-level () - "Test `org-export-get-relative-level' specifications." - ;; Standard test. - (should - (equal '(1 2) - (let ((org-odd-levels-only nil)) - (org-test-with-parsed-data "* Headline 1\n** Headline 2" - (org-element-map - tree 'headline - (lambda (h) (org-export-get-relative-level h info)) - info))))) - ;; Missing levels - (should - (equal '(1 3) - (let ((org-odd-levels-only nil)) - (org-test-with-parsed-data "** Headline 1\n**** Headline 2" - (org-element-map - tree 'headline - (lambda (h) (org-export-get-relative-level h info)) - info)))))) - -(ert-deftest test-org-export/low-level-p () - "Test `org-export-low-level-p' specifications." - (should - (equal - '(no yes) - (let ((org-odd-levels-only nil)) - (org-test-with-parsed-data "* Headline 1\n** Headline 2" - (org-element-map - tree 'headline - (lambda (h) (if (org-export-low-level-p h info) 'yes 'no)) - (plist-put info :headline-levels 1))))))) - -(ert-deftest test-org-export/get-headline-number () - "Test `org-export-get-headline-number' specifications." - ;; Standard test. - (should - (equal - '((1) (1 1)) - (let ((org-odd-levels-only nil)) - (org-test-with-parsed-data "* Headline 1\n** Headline 2" - (org-element-map - tree 'headline - (lambda (h) (org-export-get-headline-number h info)) - info))))) - ;; Missing levels are replaced with 0. - (should - (equal - '((1) (1 0 1)) - (let ((org-odd-levels-only nil)) - (org-test-with-parsed-data "* Headline 1\n*** Headline 2" - (org-element-map - tree 'headline - (lambda (h) (org-export-get-headline-number h info)) - info)))))) - -(ert-deftest test-org-export/numbered-headline-p () - "Test `org-export-numbered-headline-p' specifications." - ;; If `:section-numbers' is nil, never number headlines. - (should-not - (org-test-with-parsed-data "* Headline" - (org-element-map - tree 'headline - (lambda (h) (org-export-numbered-headline-p h info)) - (plist-put info :section-numbers nil)))) - ;; If `:section-numbers' is a number, only number headlines with - ;; a level greater that it. - (should - (equal - '(yes no) - (org-test-with-parsed-data "* Headline 1\n** Headline 2" - (org-element-map - tree 'headline - (lambda (h) (if (org-export-numbered-headline-p h info) 'yes 'no)) - (plist-put info :section-numbers 1))))) - ;; Otherwise, headlines are always numbered. - (should - (org-test-with-parsed-data "* Headline" - (org-element-map - tree 'headline - (lambda (h) (org-export-numbered-headline-p h info)) - (plist-put info :section-numbers t))))) - -(ert-deftest test-org-export/number-to-roman () - "Test `org-export-number-to-roman' specifications." - ;; If number is negative, return it as a string. - (should (equal (org-export-number-to-roman -1) "-1")) - ;; Otherwise, return it as a roman number. - (should (equal (org-export-number-to-roman 1449) "MCDXLIX"))) - -(ert-deftest test-org-export/get-tags () - "Test `org-export-get-tags' specifications." - (let ((org-export-exclude-tags '("noexport")) - (org-export-select-tags '("export"))) - ;; Standard test: tags which are not a select tag, an exclude tag, - ;; or specified as optional argument shouldn't be ignored. - (should - (org-test-with-parsed-data "* Headline :tag:" - (org-export-get-tags (org-element-map tree 'headline 'identity info t) - info))) - ;; Exclude tags are removed. - (should-not - (org-test-with-parsed-data "* Headline :noexport:" - (org-export-get-tags (org-element-map tree 'headline 'identity info t) - info))) - ;; Select tags are removed. - (should-not - (org-test-with-parsed-data "* Headline :export:" - (org-export-get-tags (org-element-map tree 'headline 'identity info t) - info))) - (should - (equal - '("tag") - (org-test-with-parsed-data "* Headline :tag:export:" - (org-export-get-tags (org-element-map tree 'headline 'identity info t) - info)))) - ;; Tags provided in the optional argument are also ignored. - (should-not - (org-test-with-parsed-data "* Headline :ignore:" - (org-export-get-tags (org-element-map tree 'headline 'identity info t) - info '("ignore")))))) - -(ert-deftest test-org-export/first-sibling-p () - "Test `org-export-first-sibling-p' specifications." - ;; Standard test. - (should - (equal - '(yes yes no) - (org-test-with-parsed-data "* Headline\n** Headline 2\n** Headline 3" - (org-element-map - tree 'headline - (lambda (h) (if (org-export-first-sibling-p h info) 'yes 'no)) - info)))) - ;; Ignore headlines not exported. - (should - (equal - '(yes) - (let ((org-export-exclude-tags '("ignore"))) - (org-test-with-parsed-data "* Headline :ignore:\n* Headline 2" - (org-element-map - tree 'headline - (lambda (h) (if (org-export-first-sibling-p h info) 'yes 'no)) - info)))))) - -(ert-deftest test-org-export/last-sibling-p () - "Test `org-export-last-sibling-p' specifications." - ;; Standard test. - (should - (equal - '(yes no yes) - (org-test-with-parsed-data "* Headline\n** Headline 2\n** Headline 3" - (org-element-map - tree 'headline - (lambda (h) (if (org-export-last-sibling-p h info) 'yes 'no)) - info)))) - ;; Ignore headlines not exported. - (should - (equal - '(yes) - (let ((org-export-exclude-tags '("ignore"))) - (org-test-with-parsed-data "* Headline\n* Headline 2 :ignore:" - (org-element-map - tree 'headline - (lambda (h) (if (org-export-last-sibling-p h info) 'yes 'no)) - info)))))) - - - -;;; Links - -(ert-deftest test-org-export/get-coderef-format () - "Test `org-export-get-coderef-format' specifications." - ;; A link without description returns "%s" - (should (equal (org-export-get-coderef-format "(ref:line)" nil) - "%s")) - ;; Return "%s" when path is matched within description. - (should (equal (org-export-get-coderef-format "path" "desc (path)") - "desc %s")) - ;; Otherwise return description. - (should (equal (org-export-get-coderef-format "path" "desc") - "desc"))) - -(ert-deftest test-org-export/inline-image-p () - "Test `org-export-inline-image-p' specifications." - (should - (org-export-inline-image-p - (org-test-with-temp-text "[[#id]]" - (org-element-map - (org-element-parse-buffer) 'link 'identity nil t)) - '(("custom-id" . "id"))))) - -(ert-deftest test-org-export/fuzzy-link () - "Test fuzzy links specifications." - ;; 1. Links to invisible (keyword) targets should be ignored. - (org-test-with-parsed-data - "Paragraph.\n#+TARGET: Test\n[[Test]]" - (should-not - (org-element-map - tree 'link - (lambda (link) - (org-export-get-ordinal - (org-export-resolve-fuzzy-link link info) info)) info))) - ;; 2. Link to an headline should return headline's number. - (org-test-with-parsed-data - "Paragraph.\n* Head1\n* Head2\n* Head3\n[[Head2]]" - (should - ;; Note: Headline's number is in fact a list of numbers. - (equal '(2) - (org-element-map - tree 'link - (lambda (link) - (org-export-get-ordinal - (org-export-resolve-fuzzy-link link info) info)) info t)))) - ;; 3. Link to a target in an item should return item's number. - (org-test-with-parsed-data - "- Item1\n - Item11\n - <>Item12\n- Item2\n\n\n[[test]]" - (should - ;; Note: Item's number is in fact a list of numbers. - (equal '(1 2) - (org-element-map - tree 'link - (lambda (link) - (org-export-get-ordinal - (org-export-resolve-fuzzy-link link info) info)) info t)))) - ;; 4. Link to a target in a footnote should return footnote's - ;; number. - (org-test-with-parsed-data " -Paragraph[1][2][fn:lbl3:C<>][[test]][[target]]\n[1] A\n\n[2] <>B" - (should - (equal '(2 3) - (org-element-map - tree 'link - (lambda (link) - (org-export-get-ordinal - (org-export-resolve-fuzzy-link link info) info)) info)))) - ;; 5. Link to a named element should return sequence number of that - ;; element. - (org-test-with-parsed-data - "#+NAME: tbl1\n|1|2|\n#+NAME: tbl2\n|3|4|\n#+NAME: tbl3\n|5|6|\n[[tbl2]]" - (should - (= 2 - (org-element-map - tree 'link - (lambda (link) - (org-export-get-ordinal - (org-export-resolve-fuzzy-link link info) info)) info t)))) - ;; 6. Link to a target not within an item, a table, a footnote - ;; reference or definition should return section number. - (org-test-with-parsed-data - "* Head1\n* Head2\nParagraph<>\n* Head3\n[[target]]" - (should - (equal '(2) - (org-element-map - tree 'link - (lambda (link) - (org-export-get-ordinal - (org-export-resolve-fuzzy-link link info) info)) info t))))) - -(ert-deftest test-org-export/resolve-coderef () - "Test `org-export-resolve-coderef' specifications." - (let ((org-coderef-label-format "(ref:%s)")) - ;; 1. A link to a "-n -k -r" block returns line number. - (org-test-with-parsed-data - "#+BEGIN_EXAMPLE -n -k -r\nText (ref:coderef)\n#+END_EXAMPLE" - (should (= (org-export-resolve-coderef "coderef" info) 1))) - (org-test-with-parsed-data - "#+BEGIN_SRC emacs-lisp -n -k -r\n(+ 1 1) (ref:coderef)\n#+END_SRC" - (should (= (org-export-resolve-coderef "coderef" info) 1))) - ;; 2. A link to a "-n -r" block returns line number. - (org-test-with-parsed-data - "#+BEGIN_EXAMPLE -n -r\nText (ref:coderef)\n#+END_EXAMPLE" - (should (= (org-export-resolve-coderef "coderef" info) 1))) - (org-test-with-parsed-data - "#+BEGIN_SRC emacs-lisp -n -r\n(+ 1 1) (ref:coderef)\n#+END_SRC" - (should (= (org-export-resolve-coderef "coderef" info) 1))) - ;; 3. A link to a "-n" block returns coderef. - (org-test-with-parsed-data - "#+BEGIN_SRC emacs-lisp -n\n(+ 1 1) (ref:coderef)\n#+END_SRC" - (should (equal (org-export-resolve-coderef "coderef" info) "coderef"))) - (org-test-with-parsed-data - "#+BEGIN_EXAMPLE -n\nText (ref:coderef)\n#+END_EXAMPLE" - (should (equal (org-export-resolve-coderef "coderef" info) "coderef"))) - ;; 4. A link to a "-r" block returns line number. - (org-test-with-parsed-data - "#+BEGIN_SRC emacs-lisp -r\n(+ 1 1) (ref:coderef)\n#+END_SRC" - (should (= (org-export-resolve-coderef "coderef" info) 1))) - (org-test-with-parsed-data - "#+BEGIN_EXAMPLE -r\nText (ref:coderef)\n#+END_EXAMPLE" - (should (= (org-export-resolve-coderef "coderef" info) 1))) - ;; 5. A link to a block without a switch returns coderef. - (org-test-with-parsed-data - "#+BEGIN_SRC emacs-lisp\n(+ 1 1) (ref:coderef)\n#+END_SRC" - (should (equal (org-export-resolve-coderef "coderef" info) "coderef"))) - (org-test-with-parsed-data - "#+BEGIN_EXAMPLE\nText (ref:coderef)\n#+END_EXAMPLE" - (should (equal (org-export-resolve-coderef "coderef" info) "coderef"))) - ;; 6. Correctly handle continued line numbers. A "+n" switch - ;; should resume numbering from previous block with numbered - ;; lines, ignoring blocks not numbering lines in the process. - ;; A "-n" switch resets count. - (org-test-with-parsed-data " -#+BEGIN_EXAMPLE -n -Text. -#+END_EXAMPLE - -#+BEGIN_SRC emacs-lisp -\(- 1 1) -#+END_SRC - -#+BEGIN_SRC emacs-lisp +n -r -\(+ 1 1) (ref:addition) -#+END_SRC - -#+BEGIN_EXAMPLE -n -r -Another text. (ref:text) -#+END_EXAMPLE" - (should (= (org-export-resolve-coderef "addition" info) 2)) - (should (= (org-export-resolve-coderef "text" info) 1))) - ;; 7. Recognize coderef with user-specified syntax. - (org-test-with-parsed-data - "#+BEGIN_EXAMPLE -l \"[ref:%s]\"\nText. [ref:text]\n#+END_EXAMPLE" - (should (equal (org-export-resolve-coderef "text" info) "text"))))) - -(ert-deftest test-org-export/resolve-fuzzy-link () - "Test `org-export-resolve-fuzzy-link' specifications." - ;; 1. Match target objects. - (org-test-with-parsed-data "<> [[target]]" - (should - (org-export-resolve-fuzzy-link - (org-element-map tree 'link 'identity info t) info))) - ;; 2. Match target elements. - (org-test-with-parsed-data "#+TARGET: target\n[[target]]" - (should - (org-export-resolve-fuzzy-link - (org-element-map tree 'link 'identity info t) info))) - ;; 3. Match named elements. - (org-test-with-parsed-data "#+NAME: target\nParagraph\n\n[[target]]" - (should - (org-export-resolve-fuzzy-link - (org-element-map tree 'link 'identity info t) info))) - ;; 4. Match exact headline's name. - (org-test-with-parsed-data "* My headline\n[[My headline]]" - (should - (org-export-resolve-fuzzy-link - (org-element-map tree 'link 'identity info t) info))) - ;; 5. Targets objects have priority over named elements and headline - ;; titles. - (org-test-with-parsed-data - "* target\n#+NAME: target\n<>\n\n[[target]]" - (should - (eq 'target - (org-element-type - (org-export-resolve-fuzzy-link - (org-element-map tree 'link 'identity info t) info))))) - ;; 6. Named elements have priority over headline titles. - (org-test-with-parsed-data - "* target\n#+NAME: target\nParagraph\n\n[[target]]" - (should - (eq 'paragraph - (org-element-type - (org-export-resolve-fuzzy-link - (org-element-map tree 'link 'identity info t) info))))) - ;; 7. If link's path starts with a "*", only match headline titles, - ;; though. - (org-test-with-parsed-data - "* target\n#+NAME: target\n<>\n\n[[*target]]" - (should - (eq 'headline - (org-element-type - (org-export-resolve-fuzzy-link - (org-element-map tree 'link 'identity info t) info))))) - ;; 8. Return nil if no match. - (org-test-with-parsed-data "[[target]]" - (should-not - (org-export-resolve-fuzzy-link - (org-element-map tree 'link 'identity info t) info)))) - -(ert-deftest test-org-export/resolve-id-link () - "Test `org-export-resolve-id-link' specifications." - ;; 1. Regular test for custom-id link. - (org-test-with-parsed-data "* Headline1 -:PROPERTIES: -:CUSTOM-ID: test -:END: -* Headline 2 -\[[#test]]" - (should - (org-export-resolve-id-link - (org-element-map tree 'link 'identity info t) info))) - ;; 2. Failing test for custom-id link. - (org-test-with-parsed-data "* Headline1 -:PROPERTIES: -:CUSTOM-ID: test -:END: -* Headline 2 -\[[#no-match]]" - (should-not - (org-export-resolve-id-link - (org-element-map tree 'link 'identity info t) info))) - ;; 3. Test for internal id target. - (org-test-with-parsed-data "* Headline1 -:PROPERTIES: -:ID: aaaa -:END: -* Headline 2 -\[[id:aaaa]]" - (should - (org-export-resolve-id-link - (org-element-map tree 'link 'identity info t) info))) - ;; 4. Test for external id target. - (org-test-with-parsed-data "[[id:aaaa]]" - (should - (org-export-resolve-id-link - (org-element-map tree 'link 'identity info t) - (org-combine-plists info '(:id-alist (("aaaa" . "external-file")))))))) - -(ert-deftest test-org-export/resolve-radio-link () - "Test `org-export-resolve-radio-link' specifications." - ;; Standard test. - (org-test-with-temp-text "<<>> radio" - (org-update-radio-target-regexp) - (should - (let* ((tree (org-element-parse-buffer)) - (info `(:parse-tree ,tree))) - (org-export-resolve-radio-link - (org-element-map tree 'link 'identity info t) - info)))) - ;; Radio target with objects. - (org-test-with-temp-text "<<>> radio \\alpha" - (org-update-radio-target-regexp) - (should - (let* ((tree (org-element-parse-buffer)) - (info `(:parse-tree ,tree))) - (org-export-resolve-radio-link - (org-element-map tree 'link 'identity info t) - info))))) - - - -;;; Macro - -(ert-deftest test-org-export/define-macro () - "Try defining various Org macro using in-buffer #+MACRO: keyword." - ;; Parsed macro. - (should (equal (org-test-with-temp-text "#+MACRO: one 1" - (org-export--get-inbuffer-options)) - '(:macro-one ("1")))) - ;; Evaled macro. - (should (equal (org-test-with-temp-text "#+MACRO: two (eval (+ 1 1))" - (org-export--get-inbuffer-options)) - '(:macro-two ("(eval (+ 1 1))")))) - ;; Incomplete macro. - (should-not (org-test-with-temp-text "#+MACRO: three" - (org-export--get-inbuffer-options))) - ;; Macro with newline character. - (should (equal (org-test-with-temp-text "#+MACRO: four a\\nb" - (org-export--get-inbuffer-options)) - '(:macro-four ("a\nb")))) - ;; Macro with protected newline character. - (should (equal (org-test-with-temp-text "#+MACRO: five a\\\\nb" - (org-export--get-inbuffer-options)) - '(:macro-five ("a\\nb")))) - ;; Recursive macro. - (org-test-with-temp-text "#+MACRO: six 6\n#+MACRO: seven 1 + {{{six}}}" - (should - (equal - (org-export--get-inbuffer-options) - '(:macro-six - ("6") - :macro-seven - ("1 + " (macro (:key "six" :value "{{{six}}}" :args nil :begin 5 :end 14 - :post-blank 0 :parent nil)))))))) - -(ert-deftest test-org-export/expand-macro () - "Test `org-export-expand-macro' specifications." - ;; Standard test. - (should - (equal - "some text" - (org-test-with-parsed-data "#+MACRO: macro some text\n{{{macro}}}" - (org-export-expand-macro - (org-element-map tree 'macro 'identity info t) info)))) - ;; Macro with arguments. - (should - (equal - "some text" - (org-test-with-parsed-data "#+MACRO: macro $1 $2\n{{{macro(some,text)}}}" - (org-export-expand-macro - (org-element-map tree 'macro 'identity info t) info)))) - ;; Macro with "eval" - (should - (equal - "3" - (org-test-with-parsed-data "#+MACRO: add (eval (+ $1 $2))\n{{{add(1,2)}}}" - (org-export-expand-macro - (org-element-map tree 'macro 'identity info t) info)))) - ;; Nested macros. - (should - (equal - "inner outer" - (org-test-with-parsed-data - "#+MACRO: in inner\n#+MACRO: out {{{in}}} outer\n{{{out}}}" - (flet ((translate-macro (macro contents info) - (org-export-expand-macro macro info))) - (org-export-expand-macro - (org-element-map tree 'macro 'identity info t) - (org-combine-plists - info `(:translate-alist ((macro . translate-macro)))))))))) - - - -;;; Src-block and example-block - -(ert-deftest test-org-export/unravel-code () - "Test `org-export-unravel-code' function." - (let ((org-coderef-label-format "(ref:%s)")) - ;; 1. Code without reference. - (org-test-with-temp-text "#+BEGIN_EXAMPLE\n(+ 1 1)\n#+END_EXAMPLE" - (should (equal (org-export-unravel-code (org-element-at-point)) - '("(+ 1 1)\n")))) - ;; 2. Code with reference. - (org-test-with-temp-text - "#+BEGIN_EXAMPLE\n(+ 1 1) (ref:test)\n#+END_EXAMPLE" - (should (equal (org-export-unravel-code (org-element-at-point)) - '("(+ 1 1)\n" (1 . "test"))))) - ;; 3. Code with user-defined reference. - (org-test-with-temp-text - "#+BEGIN_EXAMPLE -l \"[ref:%s]\"\n(+ 1 1) [ref:test]\n#+END_EXAMPLE" - (should (equal (org-export-unravel-code (org-element-at-point)) - '("(+ 1 1)\n" (1 . "test"))))) - ;; 4. Code references keys are relative to the current block. - (org-test-with-temp-text " -#+BEGIN_EXAMPLE -n -\(+ 1 1) -#+END_EXAMPLE -#+BEGIN_EXAMPLE +n -\(+ 2 2) -\(+ 3 3) (ref:one) -#+END_EXAMPLE" - (goto-line 5) - (should (equal (org-export-unravel-code (org-element-at-point)) - '("(+ 2 2)\n(+ 3 3)\n" (2 . "one"))))))) - - - -;;; Tables - -(ert-deftest test-org-export/special-column () - "Test if the table's special column is properly recognized." - ;; 1. First column is special if it contains only a special marking - ;; characters or empty cells. - (org-test-with-temp-text " -| ! | 1 | -| | 2 |" - (should - (org-export-table-has-special-column-p - (org-element-map - (org-element-parse-buffer) 'table 'identity nil 'first-match)))) - ;; 2. If the column contains anything else, it isn't special. - (org-test-with-temp-text " -| ! | 1 | -| b | 2 |" - (should-not - (org-export-table-has-special-column-p - (org-element-map - (org-element-parse-buffer) 'table 'identity nil 'first-match)))) - ;; 3. Special marking characters are "#", "^", "*", "_", "/", "$" - ;; and "!". - (org-test-with-temp-text " -| # | 1 | -| ^ | 2 | -| * | 3 | -| _ | 4 | -| / | 5 | -| $ | 6 | -| ! | 7 |" - (should - (org-export-table-has-special-column-p - (org-element-map - (org-element-parse-buffer) 'table 'identity nil 'first-match)))) - ;; 4. A first column with only empty cells isn't considered as - ;; special. - (org-test-with-temp-text " -| | 1 | -| | 2 |" - (should-not - (org-export-table-has-special-column-p - (org-element-map - (org-element-parse-buffer) 'table 'identity nil 'first-match))))) - -(ert-deftest test-org-export/table-row-is-special-p () - "Test `org-export-table-row-is-special-p' specifications." - ;; 1. A row is special if it has a special marking character in the - ;; special column. - (org-test-with-parsed-data "| ! | 1 |" - (should - (org-export-table-row-is-special-p - (org-element-map tree 'table-row 'identity nil 'first-match) info))) - ;; 2. A row is special when its first field is "/" - (org-test-with-parsed-data " -| / | 1 | -| a | b |" - (should - (org-export-table-row-is-special-p - (org-element-map tree 'table-row 'identity nil 'first-match) info))) - ;; 3. A row only containing alignment cookies is also considered as - ;; special. - (org-test-with-parsed-data "| <5> | | | |" - (should - (org-export-table-row-is-special-p - (org-element-map tree 'table-row 'identity nil 'first-match) info))) - ;; 4. Everything else isn't considered as special. - (org-test-with-parsed-data "| \alpha | | c |" - (should-not - (org-export-table-row-is-special-p - (org-element-map tree 'table-row 'identity nil 'first-match) info))) - ;; 5. Table's rules are never considered as special rows. - (org-test-with-parsed-data "|---+---|" - (should-not - (org-export-table-row-is-special-p - (org-element-map tree 'table-row 'identity nil 'first-match) info)))) - -(ert-deftest test-org-export/has-header-p () - "Test `org-export-table-has-header-p' specifications." - ;; 1. With an header. - (org-test-with-parsed-data " -| a | b | -|---+---| -| c | d |" - (should - (org-export-table-has-header-p - (org-element-map tree 'table 'identity info 'first-match) - info))) - ;; 2. Without an header. - (org-test-with-parsed-data " -| a | b | -| c | d |" - (should-not - (org-export-table-has-header-p - (org-element-map tree 'table 'identity info 'first-match) - info))) - ;; 3. Don't get fooled with starting and ending rules. - (org-test-with-parsed-data " -|---+---| -| a | b | -| c | d | -|---+---|" - (should-not - (org-export-table-has-header-p - (org-element-map tree 'table 'identity info 'first-match) - info)))) - -(ert-deftest test-org-export/table-row-group () - "Test `org-export-table-row-group' specifications." - ;; 1. A rule creates a new group. - (org-test-with-parsed-data " -| a | b | -|---+---| -| 1 | 2 |" - (should - (equal - '(1 nil 2) - (mapcar (lambda (row) (org-export-table-row-group row info)) - (org-element-map tree 'table-row 'identity))))) - ;; 2. Special rows are ignored in count. - (org-test-with-parsed-data " -| / | < | > | -|---|---+---| -| | 1 | 2 |" - (should - (equal - '(nil nil 1) - (mapcar (lambda (row) (org-export-table-row-group row info)) - (org-element-map tree 'table-row 'identity))))) - ;; 3. Double rules also are ignored in count. - (org-test-with-parsed-data " -| a | b | -|---+---| -|---+---| -| 1 | 2 |" - (should - (equal - '(1 nil nil 2) - (mapcar (lambda (row) (org-export-table-row-group row info)) - (org-element-map tree 'table-row 'identity)))))) - -(ert-deftest test-org-export/table-cell-width () - "Test `org-export-table-cell-width' specifications." - ;; 1. Width is primarily determined by width cookies. If no cookie - ;; is found, cell's width is nil. - (org-test-with-parsed-data " -| / | | <6> | | -| | a | b | c |" - (should - (equal - '(nil 6 7) - (mapcar (lambda (cell) (org-export-table-cell-width cell info)) - (org-element-map tree 'table-cell 'identity info))))) - ;; 2. The last width cookie has precedence. - (org-test-with-parsed-data " -| <6> | -| <7> | -| a |" - (should - (equal - '(7) - (mapcar (lambda (cell) (org-export-table-cell-width cell info)) - (org-element-map tree 'table-cell 'identity info))))) - ;; 3. Valid width cookies must have a specific row. - (org-test-with-parsed-data "| <6> | cell |" - (should - (equal - '(nil nil) - (mapcar (lambda (cell) (org-export-table-cell-width cell info)) - (org-element-map tree 'table-cell 'identity)))))) - -(ert-deftest test-org-export/table-cell-alignment () - "Test `org-export-table-cell-alignment' specifications." - (let ((org-table-number-fraction 0.5) - (org-table-number-regexp "^[0-9]+$")) - ;; 1. Alignment is primarily determined by alignment cookies. - (org-test-with-temp-text "| | | |" - (let* ((tree (org-element-parse-buffer)) - (info `(:parse-tree ,tree))) - (should - (equal - '(left center right) - (mapcar (lambda (cell) (org-export-table-cell-alignment cell info)) - (org-element-map tree 'table-cell 'identity)))))) - ;; 2. The last alignment cookie has precedence. - (org-test-with-parsed-data " -| | -| cell | -| |" - (should - (equal - '(right right right) - (mapcar (lambda (cell) (org-export-table-cell-alignment cell info)) - (org-element-map tree 'table-cell 'identity))))) - ;; 3. If there's no cookie, cell's contents determine alignment. - ;; A column mostly made of cells containing numbers will align - ;; its cells to the right. - (org-test-with-parsed-data " -| 123 | -| some text | -| 12345 |" - (should - (equal - '(right right right) - (mapcar (lambda (cell) - (org-export-table-cell-alignment cell info)) - (org-element-map tree 'table-cell 'identity))))) - ;; 4. Otherwise, they will be aligned to the left. - (org-test-with-parsed-data " -| text | -| some text | -| \alpha |" - (should - (equal - '(left left left) - (mapcar (lambda (cell) - (org-export-table-cell-alignment cell info)) - (org-element-map tree 'table-cell 'identity))))))) - -(ert-deftest test-org-export/table-cell-borders () - "Test `org-export-table-cell-borders' specifications." - ;; 1. Recognize various column groups indicators. - (org-test-with-parsed-data "| / | < | > | <> |" - (should - (equal - '((right bottom top) (left bottom top) (right bottom top) - (right left bottom top)) - (mapcar (lambda (cell) - (org-export-table-cell-borders cell info)) - (org-element-map tree 'table-cell 'identity))))) - ;; 2. Accept shortcuts to define column groups. - (org-test-with-parsed-data "| / | < | < |" - (should - (equal - '((right bottom top) (right left bottom top) (left bottom top)) - (mapcar (lambda (cell) - (org-export-table-cell-borders cell info)) - (org-element-map tree 'table-cell 'identity))))) - ;; 3. A valid column groups row must start with a "/". - (org-test-with-parsed-data " -| | < | -| a | b |" - (should - (equal '((top) (top) (bottom) (bottom)) - (mapcar (lambda (cell) - (org-export-table-cell-borders cell info)) - (org-element-map tree 'table-cell 'identity))))) - ;; 4. Take table rules into consideration. - (org-test-with-parsed-data " -| 1 | -|---| -| 2 |" - (should - (equal '((below top) (bottom above)) - (mapcar (lambda (cell) - (org-export-table-cell-borders cell info)) - (org-element-map tree 'table-cell 'identity))))) - ;; 5. Top and (resp. bottom) rules induce both `top' and `above' - ;; (resp. `bottom' and `below') borders. Any special row is - ;; ignored. - (org-test-with-parsed-data " -|---+----| -| / | | -| | 1 | -|---+----|" - (should - (equal '((bottom below top above)) - (last - (mapcar (lambda (cell) - (org-export-table-cell-borders cell info)) - (org-element-map tree 'table-cell 'identity))))))) - -(ert-deftest test-org-export/table-dimensions () - "Test `org-export-table-dimensions' specifications." - ;; 1. Standard test. - (org-test-with-parsed-data " -| 1 | 2 | 3 | -| 4 | 5 | 6 |" - (should - (equal '(2 . 3) - (org-export-table-dimensions - (org-element-map tree 'table 'identity info 'first-match) info)))) - ;; 2. Ignore horizontal rules and special columns. - (org-test-with-parsed-data " -| / | < | > | -| 1 | 2 | 3 | -|---+---+---| -| 4 | 5 | 6 |" - (should - (equal '(2 . 3) - (org-export-table-dimensions - (org-element-map tree 'table 'identity info 'first-match) info))))) - -(ert-deftest test-org-export/table-cell-address () - "Test `org-export-table-cell-address' specifications." - ;; 1. Standard test: index is 0-based. - (org-test-with-parsed-data "| a | b |" - (should - (equal '((0 . 0) (0 . 1)) - (org-element-map - tree 'table-cell - (lambda (cell) (org-export-table-cell-address cell info)) - info)))) - ;; 2. Special column isn't counted, nor are special rows. - (org-test-with-parsed-data " -| / | <> | -| | c |" - (should - (equal '(0 . 0) - (org-export-table-cell-address - (car (last (org-element-map tree 'table-cell 'identity info))) - info)))) - ;; 3. Tables rules do not count either. - (org-test-with-parsed-data " -| a | -|---| -| b | -|---| -| c |" - (should - (equal '(2 . 0) - (org-export-table-cell-address - (car (last (org-element-map tree 'table-cell 'identity info))) - info)))) - ;; 4. Return nil for special cells. - (org-test-with-parsed-data "| / | a |" - (should-not - (org-export-table-cell-address - (org-element-map tree 'table-cell 'identity nil 'first-match) - info)))) - -(ert-deftest test-org-export/get-table-cell-at () - "Test `org-export-get-table-cell-at' specifications." - ;; 1. Address ignores special columns, special rows and rules. - (org-test-with-parsed-data " -| / | <> | -| | a | -|---+----| -| | b |" - (should - (equal '("b") - (org-element-contents - (org-export-get-table-cell-at - '(1 . 0) - (org-element-map tree 'table 'identity info 'first-match) - info))))) - ;; 2. Return value for a non-existent address is nil. - (org-test-with-parsed-data "| a |" - (should-not - (org-export-get-table-cell-at - '(2 . 2) - (org-element-map tree 'table 'identity info 'first-match) - info))) - (org-test-with-parsed-data "| / |" - (should-not - (org-export-get-table-cell-at - '(0 . 0) - (org-element-map tree 'table 'identity info 'first-match) - info)))) - -(ert-deftest test-org-export/table-cell-starts-colgroup-p () - "Test `org-export-table-cell-starts-colgroup-p' specifications." - ;; 1. A cell at a beginning of a row always starts a column group. - (org-test-with-parsed-data "| a |" - (should - (org-export-table-cell-starts-colgroup-p - (org-element-map tree 'table-cell 'identity info 'first-match) - info))) - ;; 2. Special column should be ignored when determining the - ;; beginning of the row. - (org-test-with-parsed-data " -| / | | -| | a |" - (should - (org-export-table-cell-starts-colgroup-p - (org-element-map tree 'table-cell 'identity info 'first-match) - info))) - ;; 2. Explicit column groups. - (org-test-with-parsed-data " -| / | | < | -| a | b | c |" - (should - (equal - '(yes no yes) - (org-element-map - tree 'table-cell - (lambda (cell) - (if (org-export-table-cell-starts-colgroup-p cell info) 'yes 'no)) - info))))) - -(ert-deftest test-org-export/table-cell-ends-colgroup-p () - "Test `org-export-table-cell-ends-colgroup-p' specifications." - ;; 1. A cell at the end of a row always ends a column group. - (org-test-with-parsed-data "| a |" - (should - (org-export-table-cell-ends-colgroup-p - (org-element-map tree 'table-cell 'identity info 'first-match) - info))) - ;; 2. Special column should be ignored when determining the - ;; beginning of the row. - (org-test-with-parsed-data " -| / | | -| | a |" - (should - (org-export-table-cell-ends-colgroup-p - (org-element-map tree 'table-cell 'identity info 'first-match) - info))) - ;; 3. Explicit column groups. - (org-test-with-parsed-data " -| / | < | | -| a | b | c |" - (should - (equal - '(yes no yes) - (org-element-map - tree 'table-cell - (lambda (cell) - (if (org-export-table-cell-ends-colgroup-p cell info) 'yes 'no)) - info))))) - -(ert-deftest test-org-export/table-row-starts-rowgroup-p () - "Test `org-export-table-row-starts-rowgroup-p' specifications." - ;; 1. A row at the beginning of a table always starts a row group. - ;; So does a row following a table rule. - (org-test-with-parsed-data " -| a | -|---| -| b |" - (should - (equal - '(yes no yes) - (org-element-map - tree 'table-row - (lambda (row) - (if (org-export-table-row-starts-rowgroup-p row info) 'yes 'no)) - info)))) - ;; 2. Special rows should be ignored when determining the beginning - ;; of the row. - (org-test-with-parsed-data " -| / | < | -| | a | -|---+---| -| / | < | -| | b |" - (should - (equal - '(yes no yes) - (org-element-map - tree 'table-row - (lambda (row) - (if (org-export-table-row-starts-rowgroup-p row info) 'yes 'no)) - info))))) - -(ert-deftest test-org-export/table-row-ends-rowgroup-p () - "Test `org-export-table-row-ends-rowgroup-p' specifications." - ;; 1. A row at the end of a table always ends a row group. So does - ;; a row preceding a table rule. - (org-test-with-parsed-data " -| a | -|---| -| b |" - (should - (equal - '(yes no yes) - (org-element-map - tree 'table-row - (lambda (row) - (if (org-export-table-row-ends-rowgroup-p row info) 'yes 'no)) - info)))) - ;; 2. Special rows should be ignored when determining the beginning - ;; of the row. - (org-test-with-parsed-data " -| | a | -| / | < | -|---+---| -| | b | -| / | < |" - (should - (equal - '(yes no yes) - (org-element-map - tree 'table-row - (lambda (row) - (if (org-export-table-row-ends-rowgroup-p row info) 'yes 'no)) - info))))) - -(ert-deftest test-org-export/table-row-starts-header-p () - "Test `org-export-table-row-starts-header-p' specifications." - ;; 1. Only the row starting the first row group starts the table - ;; header. - (org-test-with-parsed-data " -| a | -| b | -|---| -| c |" - (should - (equal - '(yes no no no) - (org-element-map - tree 'table-row - (lambda (row) - (if (org-export-table-row-starts-header-p row info) 'yes 'no)) - info)))) - ;; 2. A row cannot start an header if there's no header in the - ;; table. - (org-test-with-parsed-data " -| a | -|---|" - (should-not - (org-export-table-row-starts-header-p - (org-element-map tree 'table-row 'identity info 'first-match) - info)))) - -(ert-deftest test-org-export/table-row-ends-header-p () - "Test `org-export-table-row-ends-header-p' specifications." - ;; 1. Only the row starting the first row group starts the table - ;; header. - (org-test-with-parsed-data " -| a | -| b | -|---| -| c |" - (should - (equal - '(no yes no no) - (org-element-map - tree 'table-row - (lambda (row) - (if (org-export-table-row-ends-header-p row info) 'yes 'no)) - info)))) - ;; 2. A row cannot start an header if there's no header in the - ;; table. - (org-test-with-parsed-data " -| a | -|---|" - (should-not - (org-export-table-row-ends-header-p - (org-element-map tree 'table-row 'identity info 'first-match) - info)))) - - - -;;; Topology - -(ert-deftest test-org-export/get-next-element () - "Test `org-export-get-next-element' specifications." - ;; Standard test. - (should - (equal "b" - (org-test-with-parsed-data "* Headline\n*a* b" - (org-export-get-next-element - (org-element-map tree 'bold 'identity info t) info)))) - ;; Return nil when no previous element. - (should-not - (org-test-with-parsed-data "* Headline\na *b*" - (org-export-get-next-element - (org-element-map tree 'bold 'identity info t) info))) - ;; Non-exportable elements are ignored. - (should-not - (let ((org-export-with-timestamps nil)) - (org-test-with-parsed-data "\alpha <2012-03-29 Thu>" - (org-export-get-next-element - (org-element-map tree 'entity 'identity info t) info))))) - -(ert-deftest test-org-export/get-previous-element () - "Test `org-export-get-previous-element' specifications." - ;; Standard test. - (should - (equal "a " - (org-test-with-parsed-data "* Headline\na *b*" - (org-export-get-previous-element - (org-element-map tree 'bold 'identity info t) info)))) - ;; Return nil when no previous element. - (should-not - (org-test-with-parsed-data "* Headline\n*a* b" - (org-export-get-previous-element - (org-element-map tree 'bold 'identity info t) info))) - ;; Non-exportable elements are ignored. - (should-not - (let ((org-export-with-timestamps nil)) - (org-test-with-parsed-data "<2012-03-29 Thu> \alpha" - (org-export-get-previous-element - (org-element-map tree 'entity 'identity info t) info))))) - - -(provide 'test-org-export) -;;; test-org-export.el end here diff --git a/testing/lisp/test-org-footnote.el b/testing/lisp/test-org-footnote.el index f55ed843b..5fb7351b7 100644 --- a/testing/lisp/test-org-footnote.el +++ b/testing/lisp/test-org-footnote.el @@ -19,6 +19,58 @@ ;;; Code: +(ert-deftest test-org-footnote/delete () + "Test `org-footnote-delete' specifications." + ;; Regular test. + (should + (equal "Paragraph" + (org-test-with-temp-text "Paragraph[1]\n\n[1] Definition" + (search-forward "[") + (org-footnote-delete) + (org-trim (buffer-string))))) + ;; Remove multiple definitions and references. + (should + (equal "Paragraph and another" + (org-test-with-temp-text + "Paragraph[1] and another[1]\n\n[1] def\n\n[1] def" + (search-forward "[") + (org-footnote-delete) + (org-trim (buffer-string))))) + ;; Delete inline footnotes and all references. + (should + (equal "Para and" + (org-test-with-temp-text "Para[fn:label:def] and[fn:label]" + (search-forward "[") + (org-footnote-delete) + (org-trim (buffer-string))))) + ;; Delete anonymous footnotes. + (should + (equal "Para" + (org-test-with-temp-text "Para[fn::def]" + (search-forward "[") + (org-footnote-delete) + (org-trim (buffer-string))))) + ;; With an argument, delete footnote with specified label. + (should + (equal "Paragraph[1] and another\n\n[1] def" + (let ((org-footnote-section nil)) + (org-test-with-temp-text + "Paragraph[1] and another[2]\n\n[1] def\n\n[2] def2" + (org-footnote-delete "2") + (org-trim (buffer-string)))))) + ;; Error when no argument is specified at point is not at a footnote + ;; reference. + (should-error + (org-test-with-temp-text "Para[1]\n\n[1] Def" + (org-footnote-delete))) + ;; Correctly delete footnotes with multiple paragraphs. + (should + (equal "Para\n\n\nOutside footnote." + (org-test-with-temp-text + "Para[1]\n\n[1] para1\n\npara2\n\n\nOutside footnote." + (org-footnote-delete "1") + (org-trim (buffer-string)))))) + (ert-deftest test-org-footnote/normalize-in-org () "Test specifications for `org-footnote-normalize' in an Org buffer." ;; 1. With a non-nil `org-footnote-section'. @@ -138,21 +190,10 @@ Text[2] "Test `org-footnote-normalize' specifications for buffers not in Org mode." ;; 1. In a non-Org buffer, footnotes definitions are always put at ;; its end. - (let ((org-footnote-tag-for-non-org-mode-files nil)) - (with-temp-buffer - (insert "Paragraph[fn:1][fn:label][1][fn:inline:Inline][fn::Anonymous] + (should + (equal + "Paragraph[1][2][3][4][5] -\[fn:1] Standard - -\[fn:label] Labelled - -\[1] Numbered - -Some additional text.") - (org-footnote-normalize) - (should - (equal (buffer-string) - "Paragraph[1][2][3][4][5] Some additional text. @@ -164,7 +205,21 @@ Some additional text. \[4] Inline -\[5] Anonymous")))) +\[5] Anonymous" + (let ((org-footnote-tag-for-non-org-mode-files nil)) + (with-temp-buffer + (insert "Paragraph[fn:1][fn:label][1][fn:inline:Inline][fn::Anonymous] + +\[fn:1] Standard + +\[fn:label] Labelled + +\[1] Numbered + + +Some additional text.") + (org-footnote-normalize) + (buffer-string))))) ;; 2. With a special tag. (let ((org-footnote-tag-for-non-org-mode-files "Footnotes:")) ;; 2.1. The tag must be inserted before the footnotes, separated @@ -174,12 +229,14 @@ Some additional text. \[fn:1] Standard + Some additional text.") (org-footnote-normalize) (should (equal (buffer-string) "Paragraph[1][2] + Some additional text. Footnotes: diff --git a/testing/lisp/test-org-html.el b/testing/lisp/test-org-html.el deleted file mode 100644 index 492c388e6..000000000 --- a/testing/lisp/test-org-html.el +++ /dev/null @@ -1,44 +0,0 @@ -;;; test-org-html.el --- tests for org-html.el - -;; Copyright (c) David Maus -;; Authors: David Maus - -;; This file is not part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Comments: - -;; Template test file for Org-mode tests - -;;; Code: -(unless (featurep 'org-html) - (signal 'missing-test-dependency "Support for Org-html")) - -(defmacro org-test-html/export-link (name link expected &optional desc opt-plist) - `(ert-deftest ,(intern (concat "test-org-html/export-link/" name)) () - ,(or desc name) - (should - (string= - (org-test-strip-text-props - (org-html-handle-links ,link ,opt-plist)) - ,expected)))) - -(org-test-html/export-link "mailto" "[[mailto:john@example.tld]]" - "mailto:john@example.tld" - "mailto: link without description") - -(provide 'test-org-html) - -;;; test-org-html.el ends here diff --git a/testing/lisp/test-org-list.el b/testing/lisp/test-org-list.el index 01e79bc9f..39cf4819c 100644 --- a/testing/lisp/test-org-list.el +++ b/testing/lisp/test-org-list.el @@ -174,12 +174,12 @@ (let ((org-plain-list-ordered-item-terminator 41)) (org-cycle-list-bullet) (buffer-string))))) - ;; When `org-alphabetical-lists' is non-nil, cycle to alpha bullets. + ;; When `org-list-allow-alphabetical' is non-nil, cycle to alpha bullets. (should (equal "a. item" (org-test-with-temp-text "1) item" (let ((org-plain-list-ordered-item-terminator t) - (org-alphabetical-lists t)) + (org-list-allow-alphabetical t)) (org-cycle-list-bullet) (buffer-string))))) ;; Do not cycle to alpha bullets when list has more than 26 @@ -214,7 +214,7 @@ 26) item 26 27) item 27" (let ((org-plain-list-ordered-item-terminator t) - (org-alphabetical-lists t)) + (org-list-allow-alphabetical t)) (org-cycle-list-bullet) (buffer-substring (point) (line-end-position))))))) @@ -482,7 +482,7 @@ "- item 2\n- item 1\n - sub-item 1"))) ;; Preserve blank lines. (org-test-with-temp-text "- item 1\n\n- item 2" - (let ((org-empty-line-terminates-plain-lists nil)) (org-move-item-down)) + (let ((org-list-empty-line-terminates-plain-lists nil)) (org-move-item-down)) (should (equal (buffer-string) "- item 2\n\n- item 1"))) ;; Error when trying to move the last item... (org-test-with-temp-text "- item 1\n- item 2" @@ -567,7 +567,7 @@ ;; Preserve blank lines. (org-test-with-temp-text "- item 1\n\n- item 2" (search-forward "- item 2") - (let ((org-empty-line-terminates-plain-lists nil)) (org-move-item-up)) + (let ((org-list-empty-line-terminates-plain-lists nil)) (org-move-item-up)) (should (equal (buffer-string) "- item 2\n\n- item 1"))) ;; Error when trying to move the first item... (org-test-with-temp-text "- item 1\n- item 2" @@ -631,10 +631,10 @@ ;; Blank lines specifications. ;; ;; Non-nil `org-blank-before-new-entry': insert a blank line, unless - ;; `org-empty-line-terminates-plain-lists' is non-nil. + ;; `org-list-empty-line-terminates-plain-lists' is non-nil. (should (org-test-with-temp-text "- a" - (let ((org-empty-line-terminates-plain-lists nil) + (let ((org-list-empty-line-terminates-plain-lists nil) (org-blank-before-new-entry '((plain-list-item . t)))) (end-of-line) (org-insert-item) @@ -642,7 +642,7 @@ (looking-at "$")))) (should-not (org-test-with-temp-text "- a" - (let ((org-empty-line-terminates-plain-lists t) + (let ((org-list-empty-line-terminates-plain-lists t) (org-blank-before-new-entry '((plain-list-item . t)))) (end-of-line) (org-insert-item) @@ -651,7 +651,7 @@ ;; Nil `org-blank-before-new-entry': do not insert a blank line. (should-not (org-test-with-temp-text "- a" - (let ((org-empty-line-terminates-plain-lists nil) + (let ((org-list-empty-line-terminates-plain-lists nil) (org-blank-before-new-entry '((plain-list-item . nil)))) (end-of-line) (org-insert-item) @@ -661,7 +661,7 @@ ;; line already in the sole item, do not insert one. (should-not (org-test-with-temp-text "- a" - (let ((org-empty-line-terminates-plain-lists nil) + (let ((org-list-empty-line-terminates-plain-lists nil) (org-blank-before-new-entry '((plain-list-item . auto)))) (end-of-line) (org-insert-item) @@ -671,7 +671,7 @@ ;; line in the sole item, insert another one. (should (org-test-with-temp-text "- a\n\n b" - (let ((org-empty-line-terminates-plain-lists nil) + (let ((org-list-empty-line-terminates-plain-lists nil) (org-blank-before-new-entry '((plain-list-item . auto)))) (goto-char (point-max)) (org-insert-item) @@ -681,7 +681,7 @@ ;; a blank line, preserve it. (should (org-test-with-temp-text "- a\n\n" - (let ((org-empty-line-terminates-plain-lists nil) + (let ((org-list-empty-line-terminates-plain-lists nil) (org-blank-before-new-entry '((plain-list-item . auto)))) (goto-char (point-max)) (org-insert-item) @@ -691,7 +691,7 @@ ;; are already separated by blank lines, insert one. (should (org-test-with-temp-text "- a\n\n- b" - (let ((org-empty-line-terminates-plain-lists nil) + (let ((org-list-empty-line-terminates-plain-lists nil) (org-blank-before-new-entry '((plain-list-item . auto)))) (goto-char (point-max)) (org-insert-item) @@ -699,14 +699,14 @@ (looking-at "$")))) (should (org-test-with-temp-text "- a\n\n- b" - (let ((org-empty-line-terminates-plain-lists nil) + (let ((org-list-empty-line-terminates-plain-lists nil) (org-blank-before-new-entry '((plain-list-item . auto)))) (org-insert-item) (forward-line) (looking-at "$")))) (should (org-test-with-temp-text "- a\n #+BEGIN_EXAMPLE\n\n x\n #+END_EXAMPLE" - (let ((org-empty-line-terminates-plain-lists nil) + (let ((org-list-empty-line-terminates-plain-lists nil) (org-blank-before-new-entry '((plain-list-item . auto)))) (goto-char (point-max)) (org-insert-item) @@ -714,5 +714,115 @@ (looking-at "$"))))) + +;;; Radio Lists + +(ert-deftest test-org-list/send-list () + "Test various checks for `org-list-send-list'." + ;; Error when not at a list item. + (should-error + (org-test-with-temp-text "Not a list item" + (org-list-send-list))) + ;; Error when ORGLST line is not provided. + (should-error + (org-test-with-temp-text "- item" + (org-list-send-list))) + ;; Error when transformation function is unknown. + (should-error + (org-test-with-temp-text "@ignore +#+ORGLST: SEND list unknown-function +- item +@end ignore" + (forward-line 2) + (org-list-send-list))) + ;; Error when receiving location is not defined. + (should-error + (org-test-with-temp-text "@ignore +#+ORGLST: SEND list org-list-to-texinfo +- item +@end ignore" + (forward-line 2) + (org-list-send-list))) + ;; Error when insertion region is ill-formed. + (should-error + (org-test-with-temp-text "@c BEGIN RECEIVE ORGLST list +@ignore +#+ORGLST: SEND list org-list-to-texinfo +- item +@end ignore" + (forward-line 3) + (org-list-send-list)))) + +(ert-deftest test-org-list/to-html () + "Test `org-list-to-html' specifications." + (should + (equal "
      \n
    • a\n
    • \n
    " + (let (org-html-indent) + (with-temp-buffer + (insert " + +") + (goto-char (point-min)) + (re-search-forward "^- a" nil t) + (beginning-of-line) + (org-list-send-list) + (goto-line 2) + (buffer-substring-no-properties + (point) + (progn (re-search-forward "^