diff options
author | Carsten Dominik <carsten.dominik@gmail.com> | 2010-07-19 11:47:27 +0200 |
---|---|---|
committer | Carsten Dominik <carsten.dominik@gmail.com> | 2010-07-19 11:47:27 +0200 |
commit | 86fbb8cad9975f1ecca06c3b49b012e765c6c10f (patch) | |
tree | f0ff504280de25f8a65040ecdeff87ed8833a3d0 /lisp/org | |
parent | 00af0b67f8a98f8bc11465636eb85451151f5025 (diff) | |
download | emacs-86fbb8cad9975f1ecca06c3b49b012e765c6c10f.tar.gz |
Install version 7.01 of Org-mode
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* ob-C.el: New file.
* ob-R.el: New file.
* ob-asymptote.el: New file.
* ob-clojure.el: New file.
* ob-comint.el: New file.
* ob-css.el: New file.
* ob-ditaa.el: New file.
* ob-dot.el: New file.
* ob-emacs-lisp.el: New file.
* ob-eval.el: New file.
* ob-exp.el: New file.
* ob-gnuplot.el: New file.
* ob-haskell.el: New file.
* ob-keys.el: New file.
* ob-latex.el: New file.
* ob-lob.el: New file.
* ob-matlab.el: New file.
* ob-mscgen.el: New file.
* ob-ocaml.el: New file.
* ob-octave.el: New file.
* ob-perl.el: New file.
* ob-python.el: New file.
* ob-ref.el: New file.
* ob-ruby.el: New file.
* ob-sass.el: New file.
* ob-screen.el: New file.
* ob-sh.el: New file.
* ob-sql.el: New file.
* ob-sqlite.el: New file.
* ob-table.el: New file.
* ob-tangle.el: New file.
* ob.el: New file.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-mks.el: New file.
* org-capture.el: New file.
2010-07-19 Christian Egli <christian.egli@sbszh.ch>
* org-taskjuggler.el: New file.
2010-07-19 Matt Lundin <mdl@imapmail.org>
* org-agenda.el (org-search-view): Fixed inclusion of agenda-archives
in org-agenda-text-search-extra-files.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-list.el (org-list-send-list): Locally bind variable
`txt'.
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org.el (org-reload): now also reloading babel files
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-capture.el (org-capture-set-plist): Make sure txt is a string
before calling `string-match'.
(org-capture-templates): Fix customization type.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-preprocess): Make a special case for \nbsp.
(org-latex-entities): Remove the entry for \nbsp.
(org-latex-entities-exceptions): Variable removed.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-capture.el (org-capture-refile): Do not try to manipulate
bookmark list.
* org.el (org-refile): Use the correct bookmark here.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-list.el (org-list-send-list): Parse list from its true beginning.
* org.el (org-ctrl-c-ctrl-c): Maybe send the list when at a list item.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-insert-link): Correctly determine if we should use
a relative path.
2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com>
* org-list.el (org-list-radio-list-templates): Fix templates.
2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com>
* org-list.el (org-list-send-list): regexp defining the start of
a radio list is now on par with the one used for radio tables.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-entities.el (org-entities-help): Add a headline for
the user-defined entities.
2010-07-19 Dirk-Jan C. Binnema <djcb.bulk@gmail.com> (tiny change)
* org-agenda.el (org-agenda-action): Document capture key and add it
to the prompt.
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-latex.el (org-export-latex-listings-langs): added (sqlite "SQL")
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-first-lines): Do not mark
meta lines for removal. Do not remove BABEL config lines during export
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-capture.el (org-capture): Check if
`org-capture-link-is-already-stored' is bound before evaluating.
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org.el: added autoload for org-babel-do-load-languages
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-src.el (org-src-lang-modes): added sqlite to sql-mode
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-feed.el: Change indentation to match coding style
guideline.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-feed.el (org-feed-unescape, org-feed-parse-atom-feed): Load XML
library if necessary.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-beamer.el (org-beamer-amend-header): Standardize the
header cookie for the beamer extra stuff.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-beamer.el (org-beamer-amend-header): Put extra header
last in header.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-exp-blocks.el (org-export-blocks-format-ditaa)
(org-export-blocks-format-dot): Remove text properties of body before
calculating cache hash.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-tabular-environment): New option.
(org-export-latex-tables): Use `org-export-latex-tabular-environment'.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-compat.el (org-version-check): New function.
* org-indent.el (org-indent-mode): Check for exact emacs version.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-capture.el (org-capture-templates): Allow the template
to come from a file or function call.
(org-capture-place-entry): Get the template from file or function.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-agenda.el (org-agenda-bulk-action): Don't create marker for
position if target is entire file.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-autoload): Autoload a few more org-table functions.
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org.el (org-babel-load-languages): adding ob-mscgen
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-latex.el (org-export-latex-tables): format string now
matches options
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org.el (org-babel-load-languages): this variable controls which
languages will be loaded by org-babel. It is customizable through
the customize interface.
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-latex.el (org-export-latex-format-image): updated number of
arguments to allow for an optional short-name
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-indent.el (org-indent-mode): Refuse to turn on prior to Emacs 23.2
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-capture.el (org-capture-set-target-location): Store
exact positions for file+regexp and file+function targets.
(org-capture-place-entry, org-capture-place-item)
(org-capture-place-table-line, org-capture-place-plain-text): Respect
exact positions.
(org-capture-finalize): Make sure we are at the beginning of a line
when fixing the empty lines after the entry.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-entry-get-with-inheritance): New argument LITERAL-NIL.
(org-entry-get): Pass `literal-nil' into
`org-entry-get-with-inheritance'.
(org-todo): React to nil values of the LOGGING property.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-default-notes-file): Update docstring
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-link-frame-setup): Use `org-gnus-no-new-news' as default.
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-exp.el (org-export-attach-captions-and-attributes): adding
a shortname attribute to caption strings under the symbol name
org-caption-shortn.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-switchb): Renamed from `org-iswitchb'. Improve
docstring.
(org-iswitchb): New alias.
(org-ido-switchb): Make alias point to `org-switchb'.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-capture.el (org-capture-fill-template): Respect
time-of-day preference in template prompt.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-feed.el (org-feed-unescape): Remove superfluous lambda.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-wl.el (org-wl-disable-folder-check): New customization
variable.
(org-wl-open): Disable folder check depending on
`org-wl-disable-folder-check'.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-capture.el (org-capture-set-target-location): Fix
file+function interpretation.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-feed.el (org-feed-parse-rss-entry): Unescape rss element
content.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-feed.el (xml-entity-alist): Declare variable
`xml-entity-alist' for byte compiler.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-feed.el (org-feed-unescape): New function. Unescape
protected entities.
(org-feed-parse-atom-entry): Use function for atom:content
type text and html.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-feed.el (org-feed-parse-rss-feed): Ignore case of rss
element names.
2010-07-19 Bernt Hansen <bernt@norang.ca>
* org.el (org-time-string-to-absolute): Ignore cyclic repeater
when displaying items on todays agenda date.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-get-progress): Avoid reusing previous
value of EXTRA.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-publish.el (org-publish-initialize-cache): Make
timestamp directory, the entire path to it.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-handle-comments): Make sure to check
for protection in the comment line, and not in the line after it.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-html.el (org-export-html-preprocess): Call org-format-latex,
possibly with a protect-only argument.
* org.el (org-format-latex): New argument PROTECT-ONLY.
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-exp.el (org-export-handle-table-metalines): this function
removes table specific meta-lines, now that we aren't wiping
everything that looks remotely like a comment at the end of the
export process we have to be sure to catch all of the specific lines
in org-exp.el
2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com>
* org-exp.el: (org-export-select-backend-specific-text) Properly
get rid of #+Backend and #+ATTR_Backend specifics to backends not
matching the one we're exporting to.
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* Makefile (lisp/org-install.el): replacing babel files in
construction of org-install.el
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-table.el (orgtbl-to-generic): added the :remove-newlines
option which will strip newline characters from the text of table
cells and replace then with "\n"
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-confirm-shell-link-function):
(org-confirm-elisp-link-function): Limit the values that can be set by
file variables.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-compute-latex-and-specials-regexp): Deal with
string elements by discarding them.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-iswitchb): Make sure to use at least iswitchb.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-capture.el (org-capture-position-for-last-stored):
org-capture-bookmark-last-stored-position): New functions.
(org-capture-place-table-line): Better error catching.
(org-capture-place-item):
(org-capture-place-entry):
(org-capture-place-plain-text): Call
`org-capture-position-for-last-stored'.
(org-capture-finalize): Just call
`org-capture-bookmark-last-stored-position'.
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-exp.el (org-export-mark-blockquote-verse-center): fixed
small bug, now grabbing match data before overwritten by looking-at
this fixes a problem with remainders of #+end_quote lines appearing
in exported output
2010-07-19 David Maus <dmaus@ictsoc.de>
* org.el (org-link-frame-setup): Add customization option for
Wanderlust.
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-latex.el (org-export-latex-fixed-width): now checking
org-example rather than org-protected on verbatim export, because by
default all ": " prefixed lines are marked protected
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-latex.el (org-export-latex-fixed-width): check for
protection before wrapping ": " lines as verbatim
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-exp.el (org-export-handle-comments): check for protection
before removing comments
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-entities.el (org-entities): Restructure the list.
(org-entities-help): Turn the help output into a buffer
in Org-mode, so that it becomes easier to find a symbol
in the structure.
(org-entities-create-table): Deal with new structure.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-agenda.el (org-write-agenda): Use backquotes to expand
`flet' at compile time.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-entry-properties): Make sure that standard property
names are used even if the user has customized time keywords.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-macs.el (org-not-nil): Return the value if not interpreted
as nil.
* org.el (org-entry-get):
(org-entry-get-with-inheritance): Interpret the value "nil"
as nil for properties.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-switch-to-buffer-other-window): Return the buffer.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-macs.el (org-not-nil): New function.
* org.el (org-block-todo-from-children-or-siblings-or-parent):
Use `org-not-nil' to interpret a property value of nil.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-truely-invisible-p): New function.
(org-beginning-of-line): Use `org-truely-invisible-p'.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-get-timestamps): No errors
while getting TODO state.
(org-agenda-highlight-todo): No error when no keyword has
been matched.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-timestamp-change): New optional argument UPDOWN.
Use this to identify calls from org-timestamp-up/down, so that we can
skip by rounding minutes in this case.
(org-timestamp-up):
(org-timestamp-down):
(org-timestamp-up-day):
(org-timestamp-down-day): Call org-timestamp-change with the
updown argument.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-action): Make `c' key call org-capture.
* org-capture.el: New file.
* org-compat.el (org-get-x-clipboard): Function moved here from
remember.el.
* org-mks.el: New file
* org.el (org-set-regexps-and-options): Allow statistic cookies as
part of complex headlines.
(org-find-olp): New argument THIS-BUFFER. When set, assume that the
OLP does not contain a file name.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-mode): Set `comment-start' instead of changing the
syntax of the `#' character.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-format-source-code-or-example): Mark examples
by a property. o
* org-html.el (org-export-html-close-lists-maybe): Check if raw
HTML stuff was actually made from an example
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* Makefile (LISPF): let's not compile files that won't often be used.
2010-07-19 Bastien Guerry <bzg@altern.org>
* org-latex.el: items are no longer skipped when their first line
ends on a protected element.
* org-list.el: protected environments looking like lists are not
exported anymore.
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-exp-blocks.el (org-export-blocks-preprocess):
cleanup trailing newline after block
2010-07-19 Bastien Guerry <bzg@altern.org>
* org-exp.el: comment regexp now matches documentation. No more
protection check when deleting comments before export.
2010-07-19 Bastien Guerry <bzg@altern.org>
* org-exp.el (org-export-preprocess-string):
now using `org-export-handle-include-files-recurse' to resolve
included files
2010-07-19 Bastien Guerry <bzg@altern.org>
* org-agenda.el (org-agenda-get-deadlines):
(org-agenda-get-scheduled):
* org.el (org-time-string-to-seconds):
For deadline and scheduled agenda display ignore the cyclic repeater
when calculating how many days late the task is. If you have a weekly
task and miss the date the agenda view will show more than a week late
now instead of resetting on the cyclic repeating date. This makes it
much more obvious when you missed a repeating task after the repeater.
2010-07-19 Bastien Guerry <bzg@altern.org>
* org-exp.el (org-export-mark-blockquote-verse-center):
Consider environments that end at eob.
2010-07-19 Mikael Fornius <mfo@abc.se>
* org.el (org-raise-scripts): Do not fontify sub/superscripts of text
with face `org-special-keyword'. Makes property keys as :LAST_REPEAT:
display correctly.
2010-07-19 Mikael Fornius <mfo@abc.se>
* org.el (org-at-property-p): Use save-match-data macro instead of let.
2010-07-19 Mikael Fornius <mfo@abc.se>
* org.el (test): Removed unused test function.
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-exp-blocks.el (org-export-blocks-preprocess): fixed typo
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-exp-blocks.el (org-export-blocks-postblock-hook): adding
documentation to and turning into a defcustom
2010-07-19 Eric Schulte <schulte.eric@gmail.com>
* org-exp.el (org-get-file-contents): by un-setting prefix1 to ""
instead of to nil we avoid errors when :prefix1 is defined, but
prefix is not.
2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com>
* org-latex.el (org-export-latex-preprocess): Environments coming
from latex backend specific instructions (#+LaTeX) are already
protected and won't be treated as normal environments.
2010-07-19 Bastien Guerry <bzg@altern.org>
* org-timer.el (org-timer-set-timer): Fix typo in the docstring.
2010-07-19 Bastien Guerry <bzg@altern.org>
* org-timer.el (org-timer-set-timer): Use a prefix argument.
See the docstring of the function.
2010-07-19 Bastien Guerry <bzg@altern.org>
* org-timer.el (org-timer-set-timer): Fix bug about cancelling
timers.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-w3m.el (org-w3m-copy-for-org-mode)
(org-w3m-get-next-link-start, org-w3m-get-prev-link-start):
Get text property directly, not using macro `w3m-anchor'.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-emph-re): Document the match groups.
2010-07-19 Bernt Hansen <bernt@norang.ca>
* org-clock.el (org-clock-in): Set `org-clock-clocking-in' to
t before calling `org-clock-out', so that that function can
know its call context.
2010-07-19 Bastien Guerry <bzg@altern.org>
* org-timer.el (org-timer-default-timer): New variable.
(org-timer-set-timer): Use the new variable. Also offer the
possibility to replace the current timer by a new one.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-kill-note-or-show-branches): Hide subtree before
exposing the headings.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-add-planning-info): Remove the empty line also
if there is no whitespace at all in there.
* org-table.el (org-table-align): Fix alignment of strings
with invisible characters.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org.el (org-refile-cache-get): Return empty list of targets
when cache was cleared.
(org-clone-subtree-with-time-shift): Maybe create ID property
in cloned subtrees.
(org-clone-delete-id): New customization variable.
(org-clone-subtree-with-time-shift): Use customization
variable `org-clone-delete-id'.
(org-clone-subtree-with-time-shift): Remove empty property
drawer in cloned subtrees.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-refile-use-cache): New option.
(org-refile-cache, org-refile-markers): New variable.
(org-refile-marker, org-refile-cache-clear)
(org-refile-cache-check-set, org-refile-cache-put)
(org-refile-cache-get): New function.
(org-get-refile-targets): Use the refile cache.
* org-clock.el (org-clock-sum): Don't include running clock if
the time block is wrong.
2010-07-19 John Wiegley <jwiegley@gmail.com>
* org-clock.el (org-clock-clock-in, org-clock-in): Added
parameter `start-time'.
(org-clock-resolve-clock): Added parameter `clock-out-time'.
If set, and resolve-to is a past time, then the clock out
event occurs at `clock-out-time' rather than at `resolve-to'.
In this case, `resolve-to' becomes the clock in time.
(org-clock-jump-to-current-clock): Created new global command
to reveal the current clock.
(org-clock-resolve): Added new commands g/G and j/J, and a
help window describing all commands and their meaning.
(org-clock-resolve-expert): New customization variable.
(org-find-open-clocks): Fixed a bug that caused discovered
clocks not to match up with the currently active clock.
(org-resolve-clocks): Changed the argument
`also-non-dangling-p' to `only-dangling-p', since due to a bug
this was the default behavior all along.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-id.el (org-id-uuid): New function. Return string with
random (version 4) UUID.
(org-id-method): Make 'uuid the new default value.
(org-id-new): Use `org-id-uuid' if call to uuidgen program
does not return a UUID.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-format-image): Add support
for multicolumn figures in LaTeX.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org.el (org-clone-subtree-with-time-shift): Remove ID
property of original subtree in cloned subtrees.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-format-source-code-or-example):
XEmacs compatibility.
* org-latex.el (org-export-latex-tables): Accept comma in
align string.
* org-docbook.el (org-export-docbook-xslt-stylesheet): New option.
(org-export-docbook-xslt-proc-command): Fix docstring.
(org-export-docbook-xsl-fo-proc-command): Fix docstring.
(org-export-as-docbook-pdf): Improve
formatting of the xslt command.
* org-exp.el (org-infile-export-plist): Check for XSLT setting.
* org.el (org-file-contents): Improve error message.
(org-set-regexps-and-options): Remove spaces at both ends.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-docbook.el (org-export-as-docbook-pdf): Improve
formatting of the xslt command.
2010-07-19 Sebastian Rose <sebastian_rose@gmx.de>
* org-publish.el (org-publish-cache): Use one big hashmap for
each project defined in `org-publish-project-alist'.
(initialize-files-alist): Function removed.
(org-publish-validate-link): Function removed.
(org-publish-get-base-files): Add variable `sitemap-requested'
to avoid sorting where possible.
(org-publish-get-files): Function removed.
(org-publish-get-project-from-filename): Make independent of
file list.
(org-publish-file): New argument NO-CACHE.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-beginning-of-defun, org-end-of-defun): New
functions.
(org-mode): Install the `org-beginning-of-defun' and
`org-end-of-defun' functions.
(org-pretty-entities): New option.
(org-toggle-pretty-entities): New command.
(org-fontify-entities): New function.
(org-startup-options): New keywords for pretty entities.
(org-set-font-lock-defaults): Call the pretty entities
function.
* org-latex.el (org-export-latex-keywords-maybe): Protect the
TODO markup.
2010-07-19 Mikael Fornius <mfo@abc.se>
* org-habit.el (org-habit-build-graph): Help-echo date when
mouse is over stars.
2010-07-19 Jan Böker <jan.boecker@jboecker.de>
* org.el (org-file-apps): Improve docstring to reflect
grouping matches
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-set-startup-visibility): Fix empty line display.
* org-latex.el (org-export-latex-links): Use the formatting
function of the link type, if it is available.
* org-table.el (org-table-get-remote-range): Return to
original buffer when retrieving remote reference.
* org.el (org-display-inline-images): Do the entire buffer,
not just the narrowed region. Clear the cache.
(org-display-inline-images): Match mode file paths.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-wl.el (org-wl-store-link-folder): Don't throw error when
called on WL folder group.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-replace-escapes): Make sure the cdr is not nil.
(org-read-date): Make `M-v' and `C-v' scroll the popup calendar.
(org-mode): Revert comment syntax changes.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-sparse-tree): Make `C-c / t' search for all TODO
keywords, and `C-c / T' for a specific one.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-mode): Fix comment syntax settings.
* org-src.el (org-edit-src-allow-write-back-p): Define
variable.
* org.el (org-inline-image-overlays): New variable.
(org-toggle-inline-images, org-display-inline-images)
(org-remove-inline-images): New commands.
(org-mode-map): Define a key for `org-toggle-inline-images'.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-wl.el (org-wl-message-field): New function. Return
content of header field in message entity.
(org-wl-store-link): Call `org-wl-store-link-folder' or
`org-wl-store-link-message' depending on major-mode.
(org-wl-store-link-folder): New function. Store link to
Wanderlust folder.
(org-wl-store-link-message): New function. Store link to
Wanderlust message.
(org-wl-store-link-message): Store link to message while
visiting message.
(org-wl-open): Don't try to jump to message when opening a
folder link.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org.el (org-replace-escapes): Avoid infinite loop when
replace string contains escape sequence it replaces.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-crypt.el (org-crypt-key-for-heading): Use symmetric
encryption when now key is set.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-table.el (org-table-recalculate-buffer-tables)
(org-table-iterate-buffer-tables): New commands.
* org.el (org-check-for-hidden): When there is a region, skip
the check.
2010-07-19 Dan Davison <davison@stats.ox.ac.uk>
* org-src.el (org-edit-src-code): allow-write-back-p had
erroneously been omitted from let binding
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-sorting-choice): New sorting type alpha.
(org-cmp-alpha): New defsubst.
(org-em): New defsubst.
(org-entries-lessp): Only compute needed comparisons.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-html.el (org-format-org-table-html): Test all columns
for number content.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-treat-sub-super-char): Make
sure parenthesis matching is consistent.
* org-table.el (org-table-colgroup-line-p)
(org-table-cookie-line-p): New functions.
* org-exp.el (org-table-clean-before-export): Better tests for
colgroup and cookie lines.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-goto): Push a mark before changing
the position.
* org-footnote.el (org-footnote): New group.
(org-footnote-section)
(org-footnote-tag-for-non-org-mode-files): Fix typos.
* org-list.el (org-end-of-item-text-before-children): Also do
the right thing at the end of a file.
* org.el (org-set-packages-alist, org-get-packages-alist): New
function.
(org-export-latex-default-packages-alist)
(org-export-latex-packages-alist): Add extra flag to
each package, indicating if it should be used for snippets.
(org-create-formula-image): Add the snippet argument.
(org-splice-latex-header): New argument SNIPPET-P, pass it
through to `org-latex-packages-to-string'.
(org-latex-packages-to-string): New argument SNIPPET-P.
* org-latex.el (org-export-latex-make-header): Add the snippet
argument.
* org-docbook.el (org-export-as-docbook): Implement ordered
lists starting at some offset.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-link-types, org-open-at-point): Add doi links.
* org-ascii.el (org-export-ascii-preprocess): Remove list
startcounter cookies.
* org-list.el (org-renumber-ordered-list): Respect counter
start values.
* org-latex.el (org-export-latex-lists): Accept ordered list
item offset cookie.
* org-html.el (org-export-as-html): Accept ordered list
item offset cookie.
* org-indent.el (org-indent-mode): Turn off `indent-tabs-mode'
which messes up alignment of tags.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-clock-cancel, org-clock-out): Make sure
the modeline display is removed.
* org-exp.el (org-export-format-drawer-function): Fix
docstring.
* org-agenda.el (org-agenda-refile): New optional argument
NO-UPDATE.
(org-agenda-refile): Call `org-agenda-redo' unless NO-UPDATE
is set.
(org-agenda-bulk-action): Call the refile command with updates
suppressed - but arrange for `org-agenda-redo' to be called at
the end.
* org.el (org-mode): Make table mapping quiet.
(org-table-map-tables): New optional argument QUIETLY.
* org-ascii.el (org-export-ascii-preprocess): Make table
mapping quiet.
* org-html.el (org-export-as-html, org-html-level-start): Change
XHTML IDs to not use dots.
* org-exp.el (org-export-define-heading-targets): Change
XHTML IDs to not use dots.
* org-docbook.el (org-export-docbook-level-start): Change
XHTML IDs to not use dots.
* org-latex.el (org-export-as-latex): Make sure that the
result buffer is in latex-mode.
* org.el (org-shiftup-final-hook, org-shiftdown-final-hook)
(org-shiftleft-final-hook, org-shiftright-final-hook): New
hooks.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-table.el (org-table-justify-field-maybe): Make sure that
inserting a value does not turn a line into a hline.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-clock-sum): New argument HEADLINE-FILTER.
(org-clock-sum): Add property to selected headlines.
(org-dblock-write:clocktable): Make tags matcher.
* org.el (org-set-autofill-regexps): XEmacs compatibility.
* org-latex.el (org-export-latex-set-initial-vars): Allow "-"
in latex class definitions
* org.el (org-shiftup-hook, org-shiftdown-hook)
(org-shiftleft-hook, org-shiftright-hook): New hooks.
* org-entities.el (org-entities): Use \land and \lor for logical
operators.
* org.el (org-shiftmetaleft, org-shiftmetaright): Call the subtree
indentation commands.
(org-hidden-tree-error): New defsubst.
(org-metaleft, org-metaright): Check for hidden stuff and throw an
error.
(org-check-for-hidden): New function.
* org-list.el (org-item-re): New function.
(org-at-item-p): Use `org-item-re'.
(org-end-of-item-text-before-children): New function.
(org-outdent-item, org-indent-item): Arrange for leaving the
subtree alone.
(org-outdent-item-tree, org-indent-item-tree): New argument
NO-SUBTREE.
(org-indent-item-tree): Use `org-end-of-item-text-before-children'
to find the end for processing while ignoring the subtree.
* org-publish.el (org-publish-sitemap-sort-alphabetically)
(org-publish-sitemap-sort-folders)
(org-publish-sitemap-sort-ignore-case): New options.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-publish.el (org-publish-compare-directory-files): Fix sorting.
* org-compat.el (org-get-x-clipboard-compat): Use (featurep 'xemacs).
* org-publish.el (org-publish-project-alist): Update docstring.
(org-publish-file-title-cache): New variable.
(org-publish-initialize-files-alist): Initialize
`org-publish-initialize-files-alist' to nil.
(org-publish-sort-directory-files): New function.
(org-publish-projects): Access the new properties.
(org-publish-find-title): Use the file title cache.
(org-publish-find-title): Build the file title cache.
(org-publish-get-base-files-1): Sort files.
(org-publish-aux-preprocess): Do not throw an error when before
the first headline. Allow an empty target, meaning to link just
to the file.
(org-publish-index-generate-theindex.inc): Check if there is
actually a target and only then add it to the link.
(org-publish-projects): Fix a remaining issue with the last commit
* org-html.el (org-export-as-html): Treat verse as open/close
paragraph.
(org-export-html-close-lists-maybe): Allow to splice raw HTML into
and out of lists.
2010-07-19 Dan Davison <davison@stats.ox.ac.uk>
* org-src.el (org-edit-src-code): Allow the org-src edit buffer to
be used in a read-only mode.
(org-edit-src-code): Different message in read-only mode
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-src.el (org-edit-src-find-region-and-lang): Test for
table.el as late as possible.
* org-colview-xemacs.el: Make sure this file is never loaded into
Emacs. Remove all tests for XEmacs.
* org-colview.el: Make sure this file is never loaded into XEmacs.
* org-agenda.el (org-highlight, org-unhighlight): Use direct
overlay calls.
* org.el (org-key): Apply the translations defined in
`org-xemacs-key-equivalents'.
* org-mouse.el (org-mode-hook): Use `org-defkey'.
* org-compat.el (org-xemacs-key-equivalents): New constant.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-inlinetask.el (org-inlinetask-defaut-state): New option.
(org-inlinetask-insert-task): Use `org-inlinetask-defaut-state'.
Obey `org-odd-levels-only'.
* org-compat.el (org-find-overlays): Use overlays-in/at.
* org.el (org-remove-empty-overlays-at)
(org-outline-overlay-data, org-hide-block-toggle)
(org-format-latex, org-context): Use overlays-in/at.
* org-src.el (org-edit-src-exit): Use overlays-in/at.
* org-agenda.el (org-agenda-mark-clocking-task)
(org-agenda-fontify-priorities, org-agenda-dim-blocked-tasks)
(org-agenda-entry-text-hide)
(org-agenda-fix-tags-filter-overlays-at)
(org-agenda-bulk-remove-overlays): Use overlays-in/at.
* org-compat.el (org-overlays-at): Function removed.
(org-overlays-in): Function removed.
2010-07-19 Bastien Guerry <bzg@altern.org>
* org-clock.el (org-clock-set-current): Just return the headline
itself, strip the TODO keyword, the priority cookie and the tags.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-compat.el (org-xemacs-without-invisibility): New macro.
(org-xemacs-without-invisibility): New macro.
(org-indent-to-column, org-indent-line-to, org-move-to-column):
Redefine using the macro `org-xemacs-without-invisibility'.
* org.el (org-mode, org-org-menu): Use `add-to-invisibility-spec'.
* org-table.el (orgtbl-mode): Use `add-to-invisibility-spec'.
* org-compat.el (org-make-overlay, org-delete-overlay)
(org-overlay-start, org-overlay-end, org-overlay-put)
(org-overlay-get, org-overlay-move, org-overlay-buffer): Functions
removed.
(org-add-to-invisibility-spec): Function removed.
* org-html.el (org-export-as-html-and-open): Add argument to
kill-buffer.
* org-habit.el (require): `calendar' is now required already by
org.el on top level.
* org-clock.el (require): `calendar' is now required already by
org.el on top level.
* org-agenda.el (require, org-timeline, org-agenda-list)
(org-todo-list, org-agenda-to-appt): `calendar' is now required
already by org.el on top level.
* org.el (org-export-latex-fix-inputenc): Declare function.
* org-agenda.el (org-agenda-goto-calendar): Do not bind obsolete
variables.
* org.el (calendar): Require calendar now on top level in org.el
and define aliases to new variables when needed.
(org-read-date, org-goto-calendar): Do not bind obsolete
variables.
* org-clock.el (org-clock-out, org-clock-cancel): Get rid of
compilation warning, add comment that this cannot be done with
`with-current-buffer'.
* org-wl.el (org-wl-open): Use `with-current-buffer'.
* org.el (overlay, org-remove-empty-overlays-at)
(org-outline-overlay-data, org-set-outline-overlay-data)
(org-show-block-all, org-hide-block-toggle)
(org-highlight-new-match, org-remove-occur-highlights)
(org-tags-overlay, org-fast-tag-selection, org-date-ovl)
(org-read-date, org-read-date-display, org-eval-in-calendar)
(org-format-latex, org-context)
(org-speedbar-restriction-lock-overlay)
(org-speedbar-set-agenda-restriction): Use the normal overlay API.
* org-table.el (org-table-add-rectangle-overlay)
(org-table-remove-rectangle-highlight)
(org-table-overlay-coordinates)
(org-table-toggle-coordinate-overlays): Use the normal overlay
API.
* org-src.el (org-edit-src-code, org-edit-fixed-width-region)
(org-edit-src-exit, org-src-mode-configure-edit-buffer): Use the
normal overlay API.
* org-colview.el (org-columns-new-overlay)
(org-columns-display-here, org-columns-remove-overlays)
(org-columns-edit-value, org-columns-next-allowed-value)
(org-columns-update): Use the normal overlay API.
* org-clock.el (org-clock-out, org-clock-cancel)
(org-clock-put-overlay, org-clock-remove-overlays): Use the normal
overlay API.
* org-agenda.el (org-agenda-mark-filtered-text)
(org-agenda-mark-clocking-task, org-agenda-fontify-priorities)
(org-agenda-dim-blocked-tasks, org-agenda-entry-text-show-here)
(org-agenda-entry-text-hide)
(org-agenda-restriction-lock-overlay)
(org-agenda-set-restriction-lock)
(org-agenda-filter-by-tag-hide-line)
(org-agenda-fix-tags-filter-overlays-at)
(org-agenda-filter-by-tag-show-all, org-hl)
(org-agenda-goto-calendar, org-agenda-bulk-mark)
(org-agenda-bulk-remove-overlays): Use the normal overlay API.
* org-freemind.el (org-freemind-from-org-mode-node)
(org-freemind-from-org-mode, )
(org-freemind-from-org-sparse-tree, org-freemind-to-org-mode): Use
interactive-p instead of called-interactively, because this is
backward compatible with older Emacsen I still support..
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-define-heading-targets): Fix bug in
regexp finding ID and CUSTOM_ID properties.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-footnote.el (org-footnote-goto-previous-reference): Renamed
from `org-footnote-goto-next-reference'.
* org.el (org-auto-repeat-maybe): Only record LAST_REPEAT if
org-log-repeat is non-nil, or if there is clocking data in the
entry.
* org-crypt.el (org-encrypt-entry): Improve mapping behavior.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-align-all-tags): New command.
2010-07-19 David Maus <dmaus@ictsoc.de>
* org-wl.el (org-wl-link-remove-filter): New customizable
variable. If non-nil, filter conditions are stripped when storing
link to message in filter folder.
(org-wl-shimbun-prefer-web-links): New customizable variable. If
non-nil, links to shimbun messages are created as web links to
message source.
(org-wl-nntp-prefer-web-links): New customizable variable. If
non-nil, links to nntp message are created as web links to gmane
or googlegroups.
(org-wl-namazu-default-index): New customizable variable.
Directory of namazu search index that should be used as default
when opening a link in a search folder.
(org-wl-folder-types): New constant. Wanderlust folder type
indicators.
(org-wl-folder-type): New function. Return type of Wanderlust
folder.
(org-wl-store-link): Create web links for shimbun or nntp messages
and strip filter conditions depending on customizable variables.
(org-wl-open): Open namazu search folder for message when called
with prefix.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-remove-if, org-remove-if-not): New functions.
(org-open-file): Use internal remove-if functions.
2010-07-19 Jan Böcker <jan.boecker@jboecker.de>
* org.el (org-file-apps-entry-match-against-dlink-p): new function.
(org-file-apps-ex): remove variable.
(org-open-file): Integrate org-file-apps-ex functionality back
into org-file-apps, and decide whether to match a regexp against
the link or the filename using org-file-apps-entry-uses-grouping-p.
2010-07-19 Jan Böcker <jan.boecker@jboecker.de>
* org.el (org-file-apps-ex): new variable.
(org-open-file): Before considering org-file-apps, first match the
regexps from org-file-apps-ex against the whole link. See
docstring of org-file-apps-ex.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-export-latex-default-packages-alist): Remove
microtype package.
(org-todo-repeat-to-state): New variable.
(org-auto-repeat-maybe): Allow user-selected target states.
(org-default-properties): Add the new property REPEAT_TO_STATE.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org-mobile.el (org-mobile-check-setup): Make sure that there is
a binary to compute checksums.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi: Add macros to get plain quotes in PDF output.
List additional contributors.
(Capture): New section, replaces the section about remember.
(Working With Source Code): New chapter, focused on documenting Org
Babel.
(Code evaluation security): New section.
(MobileOrg): Document DropBox support.
(TaskJuggler export): Document taskjuggler and Gantt chart support.
(Special symbols): Show how to display UTF8 characters for entities.
(Global TODO list): Clarify the use of the "M" key and the differences
to the "m" key.
(RSS Feeds): Mention Atom feeds as well.
(Setting tags): Remove paragraph about
`org-complete-tags-always-offer-all-agenda-tags'.
Diffstat (limited to 'lisp/org')
88 files changed, 14946 insertions, 2655 deletions
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 9c3c879046c..fe66321d4e6 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,1220 @@ +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * ob-C.el: New file. + * ob-R.el: New file. + * ob-asymptote.el: New file. + * ob-clojure.el: New file. + * ob-comint.el: New file. + * ob-css.el: New file. + * ob-ditaa.el: New file. + * ob-dot.el: New file. + * ob-emacs-lisp.el: New file. + * ob-eval.el: New file. + * ob-exp.el: New file. + * ob-gnuplot.el: New file. + * ob-haskell.el: New file. + * ob-keys.el: New file. + * ob-latex.el: New file. + * ob-lob.el: New file. + * ob-matlab.el: New file. + * ob-mscgen.el: New file. + * ob-ocaml.el: New file. + * ob-octave.el: New file. + * ob-perl.el: New file. + * ob-python.el: New file. + * ob-ref.el: New file. + * ob-ruby.el: New file. + * ob-sass.el: New file. + * ob-screen.el: New file. + * ob-sh.el: New file. + * ob-sql.el: New file. + * ob-sqlite.el: New file. + * ob-table.el: New file. + * ob-tangle.el: New file. + * ob.el: New file. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mks.el: New file. + * org-capture.el: New file. + +2010-07-19 Christian Egli <christian.egli@sbszh.ch> + + * org-taskjuggler.el: New file. + +2010-07-19 Matt Lundin <mdl@imapmail.org> + + * org-agenda.el (org-search-view): Fixed inclusion of agenda-archives + in org-agenda-text-search-extra-files. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-list.el (org-list-send-list): Locally bind variable + `txt'. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-reload): now also reloading babel files + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-set-plist): Make sure txt is a string + before calling `string-match'. + (org-capture-templates): Fix customization type. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-preprocess): Make a special case for \nbsp. + (org-latex-entities): Remove the entry for \nbsp. + (org-latex-entities-exceptions): Variable removed. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-refile): Do not try to manipulate + bookmark list. + + * org.el (org-refile): Use the correct bookmark here. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-list-send-list): Parse list from its true beginning. + + * org.el (org-ctrl-c-ctrl-c): Maybe send the list when at a list item. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-insert-link): Correctly determine if we should use + a relative path. + +2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-radio-list-templates): Fix templates. + +2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-list.el (org-list-send-list): regexp defining the start of + a radio list is now on par with the one used for radio tables. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-entities.el (org-entities-help): Add a headline for + the user-defined entities. + +2010-07-19 Dirk-Jan C. Binnema <djcb.bulk@gmail.com> (tiny change) + + * org-agenda.el (org-agenda-action): Document capture key and add it + to the prompt. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-listings-langs): added (sqlite "SQL") + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-first-lines): Do not mark + meta lines for removal. Do not remove BABEL config lines during export + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-capture.el (org-capture): Check if + `org-capture-link-is-already-stored' is bound before evaluating. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org.el: added autoload for org-babel-do-load-languages + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-src.el (org-src-lang-modes): added sqlite to sql-mode + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el: Change indentation to match coding style + guideline. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-unescape, org-feed-parse-atom-feed): Load XML + library if necessary. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-amend-header): Standardize the + header cookie for the beamer extra stuff. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-beamer.el (org-beamer-amend-header): Put extra header + last in header. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-exp-blocks.el (org-export-blocks-format-ditaa) + (org-export-blocks-format-dot): Remove text properties of body before + calculating cache hash. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-tabular-environment): New option. + (org-export-latex-tables): Use `org-export-latex-tabular-environment'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-compat.el (org-version-check): New function. + + * org-indent.el (org-indent-mode): Check for exact emacs version. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-templates): Allow the template + to come from a file or function call. + (org-capture-place-entry): Get the template from file or function. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-agenda-bulk-action): Don't create marker for + position if target is entire file. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-autoload): Autoload a few more org-table functions. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-babel-load-languages): adding ob-mscgen + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-tables): format string now + matches options + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org.el (org-babel-load-languages): this variable controls which + languages will be loaded by org-babel. It is customizable through + the customize interface. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-format-image): updated number of + arguments to allow for an optional short-name + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-indent.el (org-indent-mode): Refuse to turn on prior to Emacs 23.2 + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-set-target-location): Store + exact positions for file+regexp and file+function targets. + (org-capture-place-entry, org-capture-place-item) + (org-capture-place-table-line, org-capture-place-plain-text): Respect + exact positions. + (org-capture-finalize): Make sure we are at the beginning of a line + when fixing the empty lines after the entry. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-entry-get-with-inheritance): New argument LITERAL-NIL. + (org-entry-get): Pass `literal-nil' into + `org-entry-get-with-inheritance'. + (org-todo): React to nil values of the LOGGING property. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-default-notes-file): Update docstring + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-link-frame-setup): Use `org-gnus-no-new-news' as default. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-attach-captions-and-attributes): adding + a shortname attribute to caption strings under the symbol name + org-caption-shortn. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-switchb): Renamed from `org-iswitchb'. Improve + docstring. + (org-iswitchb): New alias. + (org-ido-switchb): Make alias point to `org-switchb'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-fill-template): Respect + time-of-day preference in template prompt. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-unescape): Remove superfluous lambda. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-disable-folder-check): New customization + variable. + (org-wl-open): Disable folder check depending on + `org-wl-disable-folder-check'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-set-target-location): Fix + file+function interpretation. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-parse-rss-entry): Unescape rss element + content. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (xml-entity-alist): Declare variable + `xml-entity-alist' for byte compiler. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-unescape): New function. Unescape + protected entities. + (org-feed-parse-atom-entry): Use function for atom:content + type text and html. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-feed.el (org-feed-parse-rss-feed): Ignore case of rss + element names. + +2010-07-19 Bernt Hansen <bernt@norang.ca> + + * org.el (org-time-string-to-absolute): Ignore cyclic repeater + when displaying items on todays agenda date. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-get-progress): Avoid reusing previous + value of EXTRA. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-initialize-cache): Make + timestamp directory, the entire path to it. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-handle-comments): Make sure to check + for protection in the comment line, and not in the line after it. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-export-html-preprocess): Call org-format-latex, + possibly with a protect-only argument. + + * org.el (org-format-latex): New argument PROTECT-ONLY. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-handle-table-metalines): this function + removes table specific meta-lines, now that we aren't wiping + everything that looks remotely like a comment at the end of the + export process we have to be sure to catch all of the specific lines + in org-exp.el + +2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-exp.el: (org-export-select-backend-specific-text) Properly + get rid of #+Backend and #+ATTR_Backend specifics to backends not + matching the one we're exporting to. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * Makefile (lisp/org-install.el): replacing babel files in + construction of org-install.el + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-table.el (orgtbl-to-generic): added the :remove-newlines + option which will strip newline characters from the text of table + cells and replace then with "\n" + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-confirm-shell-link-function): + (org-confirm-elisp-link-function): Limit the values that can be set by + file variables. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-compute-latex-and-specials-regexp): Deal with + string elements by discarding them. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-iswitchb): Make sure to use at least iswitchb. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-capture.el (org-capture-position-for-last-stored): + org-capture-bookmark-last-stored-position): New functions. + (org-capture-place-table-line): Better error catching. + (org-capture-place-item): + (org-capture-place-entry): + (org-capture-place-plain-text): Call + `org-capture-position-for-last-stored'. + (org-capture-finalize): Just call + `org-capture-bookmark-last-stored-position'. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-mark-blockquote-verse-center): fixed + small bug, now grabbing match data before overwritten by looking-at + this fixes a problem with remainders of #+end_quote lines appearing + in exported output + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org.el (org-link-frame-setup): Add customization option for + Wanderlust. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-fixed-width): now checking + org-example rather than org-protected on verbatim export, because by + default all ": " prefixed lines are marked protected + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-latex.el (org-export-latex-fixed-width): check for + protection before wrapping ": " lines as verbatim + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-export-handle-comments): check for protection + before removing comments + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-entities.el (org-entities): Restructure the list. + (org-entities-help): Turn the help output into a buffer + in Org-mode, so that it becomes easier to find a symbol + in the structure. + (org-entities-create-table): Deal with new structure. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-agenda.el (org-write-agenda): Use backquotes to expand + `flet' at compile time. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-entry-properties): Make sure that standard property + names are used even if the user has customized time keywords. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el (org-not-nil): Return the value if not interpreted + as nil. + + * org.el (org-entry-get): + (org-entry-get-with-inheritance): Interpret the value "nil" + as nil for properties. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-switch-to-buffer-other-window): Return the buffer. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el (org-not-nil): New function. + + * org.el (org-block-todo-from-children-or-siblings-or-parent): + Use `org-not-nil' to interpret a property value of nil. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-truely-invisible-p): New function. + (org-beginning-of-line): Use `org-truely-invisible-p'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-get-timestamps): No errors + while getting TODO state. + (org-agenda-highlight-todo): No error when no keyword has + been matched. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-timestamp-change): New optional argument UPDOWN. + Use this to identify calls from org-timestamp-up/down, so that we can + skip by rounding minutes in this case. + (org-timestamp-up): + (org-timestamp-down): + (org-timestamp-up-day): + (org-timestamp-down-day): Call org-timestamp-change with the + updown argument. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-action): Make `c' key call org-capture. + + * org-capture.el: New file. + + * org-compat.el (org-get-x-clipboard): Function moved here from + remember.el. + + * org-mks.el: New file + + * org.el (org-set-regexps-and-options): Allow statistic cookies as + part of complex headlines. + (org-find-olp): New argument THIS-BUFFER. When set, assume that the + OLP does not contain a file name. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-mode): Set `comment-start' instead of changing the + syntax of the `#' character. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): Mark examples + by a property. o + + * org-html.el (org-export-html-close-lists-maybe): Check if raw + HTML stuff was actually made from an example + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * Makefile (LISPF): let's not compile files that won't often be used. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-latex.el: items are no longer skipped when their first line + ends on a protected element. + + * org-list.el: protected environments looking like lists are not + exported anymore. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-export-blocks-preprocess): + cleanup trailing newline after block + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-exp.el: comment regexp now matches documentation. No more + protection check when deleting comments before export. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-exp.el (org-export-preprocess-string): + now using `org-export-handle-include-files-recurse' to resolve + included files + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-agenda.el (org-agenda-get-deadlines): + (org-agenda-get-scheduled): + + * org.el (org-time-string-to-seconds): + For deadline and scheduled agenda display ignore the cyclic repeater + when calculating how many days late the task is. If you have a weekly + task and miss the date the agenda view will show more than a week late + now instead of resetting on the cyclic repeating date. This makes it + much more obvious when you missed a repeating task after the repeater. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-exp.el (org-export-mark-blockquote-verse-center): + Consider environments that end at eob. + +2010-07-19 Mikael Fornius <mfo@abc.se> + + * org.el (org-raise-scripts): Do not fontify sub/superscripts of text + with face `org-special-keyword'. Makes property keys as :LAST_REPEAT: + display correctly. + +2010-07-19 Mikael Fornius <mfo@abc.se> + + * org.el (org-at-property-p): Use save-match-data macro instead of let. + +2010-07-19 Mikael Fornius <mfo@abc.se> + + * org.el (test): Removed unused test function. + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-export-blocks-preprocess): fixed typo + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp-blocks.el (org-export-blocks-postblock-hook): adding + documentation to and turning into a defcustom + +2010-07-19 Eric Schulte <schulte.eric@gmail.com> + + * org-exp.el (org-get-file-contents): by un-setting prefix1 to "" + instead of to nil we avoid errors when :prefix1 is defined, but + prefix is not. + +2010-07-19 Nicolas Goaziou <n.goaziou@gmail.com> + + * org-latex.el (org-export-latex-preprocess): Environments coming + from latex backend specific instructions (#+LaTeX) are already + protected and won't be treated as normal environments. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-set-timer): Fix typo in the docstring. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-set-timer): Use a prefix argument. + See the docstring of the function. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-set-timer): Fix bug about cancelling + timers. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-w3m.el (org-w3m-copy-for-org-mode) + (org-w3m-get-next-link-start, org-w3m-get-prev-link-start): + Get text property directly, not using macro `w3m-anchor'. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-emph-re): Document the match groups. + +2010-07-19 Bernt Hansen <bernt@norang.ca> + + * org-clock.el (org-clock-in): Set `org-clock-clocking-in' to + t before calling `org-clock-out', so that that function can + know its call context. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-timer.el (org-timer-default-timer): New variable. + (org-timer-set-timer): Use the new variable. Also offer the + possibility to replace the current timer by a new one. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-kill-note-or-show-branches): Hide subtree before + exposing the headings. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-add-planning-info): Remove the empty line also + if there is no whitespace at all in there. + + * org-table.el (org-table-align): Fix alignment of strings + with invisible characters. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org.el (org-refile-cache-get): Return empty list of targets + when cache was cleared. + (org-clone-subtree-with-time-shift): Maybe create ID property + in cloned subtrees. + (org-clone-delete-id): New customization variable. + (org-clone-subtree-with-time-shift): Use customization + variable `org-clone-delete-id'. + (org-clone-subtree-with-time-shift): Remove empty property + drawer in cloned subtrees. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-refile-use-cache): New option. + (org-refile-cache, org-refile-markers): New variable. + (org-refile-marker, org-refile-cache-clear) + (org-refile-cache-check-set, org-refile-cache-put) + (org-refile-cache-get): New function. + (org-get-refile-targets): Use the refile cache. + + * org-clock.el (org-clock-sum): Don't include running clock if + the time block is wrong. + +2010-07-19 John Wiegley <jwiegley@gmail.com> + + * org-clock.el (org-clock-clock-in, org-clock-in): Added + parameter `start-time'. + (org-clock-resolve-clock): Added parameter `clock-out-time'. + If set, and resolve-to is a past time, then the clock out + event occurs at `clock-out-time' rather than at `resolve-to'. + In this case, `resolve-to' becomes the clock in time. + (org-clock-jump-to-current-clock): Created new global command + to reveal the current clock. + (org-clock-resolve): Added new commands g/G and j/J, and a + help window describing all commands and their meaning. + (org-clock-resolve-expert): New customization variable. + (org-find-open-clocks): Fixed a bug that caused discovered + clocks not to match up with the currently active clock. + (org-resolve-clocks): Changed the argument + `also-non-dangling-p' to `only-dangling-p', since due to a bug + this was the default behavior all along. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-id.el (org-id-uuid): New function. Return string with + random (version 4) UUID. + (org-id-method): Make 'uuid the new default value. + (org-id-new): Use `org-id-uuid' if call to uuidgen program + does not return a UUID. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-format-image): Add support + for multicolumn figures in LaTeX. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org.el (org-clone-subtree-with-time-shift): Remove ID + property of original subtree in cloned subtrees. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): + XEmacs compatibility. + + * org-latex.el (org-export-latex-tables): Accept comma in + align string. + + * org-docbook.el (org-export-docbook-xslt-stylesheet): New option. + (org-export-docbook-xslt-proc-command): Fix docstring. + (org-export-docbook-xsl-fo-proc-command): Fix docstring. + (org-export-as-docbook-pdf): Improve + formatting of the xslt command. + + * org-exp.el (org-infile-export-plist): Check for XSLT setting. + + * org.el (org-file-contents): Improve error message. + (org-set-regexps-and-options): Remove spaces at both ends. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-docbook.el (org-export-as-docbook-pdf): Improve + formatting of the xslt command. + +2010-07-19 Sebastian Rose <sebastian_rose@gmx.de> + + * org-publish.el (org-publish-cache): Use one big hashmap for + each project defined in `org-publish-project-alist'. + (initialize-files-alist): Function removed. + (org-publish-validate-link): Function removed. + (org-publish-get-base-files): Add variable `sitemap-requested' + to avoid sorting where possible. + (org-publish-get-files): Function removed. + (org-publish-get-project-from-filename): Make independent of + file list. + (org-publish-file): New argument NO-CACHE. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-beginning-of-defun, org-end-of-defun): New + functions. + (org-mode): Install the `org-beginning-of-defun' and + `org-end-of-defun' functions. + (org-pretty-entities): New option. + (org-toggle-pretty-entities): New command. + (org-fontify-entities): New function. + (org-startup-options): New keywords for pretty entities. + (org-set-font-lock-defaults): Call the pretty entities + function. + + * org-latex.el (org-export-latex-keywords-maybe): Protect the + TODO markup. + +2010-07-19 Mikael Fornius <mfo@abc.se> + + * org-habit.el (org-habit-build-graph): Help-echo date when + mouse is over stars. + +2010-07-19 Jan Böker <jan.boecker@jboecker.de> + + * org.el (org-file-apps): Improve docstring to reflect + grouping matches + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-set-startup-visibility): Fix empty line display. + + * org-latex.el (org-export-latex-links): Use the formatting + function of the link type, if it is available. + + * org-table.el (org-table-get-remote-range): Return to + original buffer when retrieving remote reference. + + * org.el (org-display-inline-images): Do the entire buffer, + not just the narrowed region. Clear the cache. + (org-display-inline-images): Match mode file paths. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-store-link-folder): Don't throw error when + called on WL folder group. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-replace-escapes): Make sure the cdr is not nil. + (org-read-date): Make `M-v' and `C-v' scroll the popup calendar. + (org-mode): Revert comment syntax changes. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-sparse-tree): Make `C-c / t' search for all TODO + keywords, and `C-c / T' for a specific one. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-mode): Fix comment syntax settings. + + * org-src.el (org-edit-src-allow-write-back-p): Define + variable. + + * org.el (org-inline-image-overlays): New variable. + (org-toggle-inline-images, org-display-inline-images) + (org-remove-inline-images): New commands. + (org-mode-map): Define a key for `org-toggle-inline-images'. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-message-field): New function. Return + content of header field in message entity. + (org-wl-store-link): Call `org-wl-store-link-folder' or + `org-wl-store-link-message' depending on major-mode. + (org-wl-store-link-folder): New function. Store link to + Wanderlust folder. + (org-wl-store-link-message): New function. Store link to + Wanderlust message. + (org-wl-store-link-message): Store link to message while + visiting message. + (org-wl-open): Don't try to jump to message when opening a + folder link. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org.el (org-replace-escapes): Avoid infinite loop when + replace string contains escape sequence it replaces. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-crypt.el (org-crypt-key-for-heading): Use symmetric + encryption when now key is set. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-recalculate-buffer-tables) + (org-table-iterate-buffer-tables): New commands. + + * org.el (org-check-for-hidden): When there is a region, skip + the check. + +2010-07-19 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): allow-write-back-p had + erroneously been omitted from let binding + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-sorting-choice): New sorting type alpha. + (org-cmp-alpha): New defsubst. + (org-em): New defsubst. + (org-entries-lessp): Only compute needed comparisons. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-html.el (org-format-org-table-html): Test all columns + for number content. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-treat-sub-super-char): Make + sure parenthesis matching is consistent. + + * org-table.el (org-table-colgroup-line-p) + (org-table-cookie-line-p): New functions. + + * org-exp.el (org-table-clean-before-export): Better tests for + colgroup and cookie lines. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-goto): Push a mark before changing + the position. + + * org-footnote.el (org-footnote): New group. + (org-footnote-section) + (org-footnote-tag-for-non-org-mode-files): Fix typos. + + * org-list.el (org-end-of-item-text-before-children): Also do + the right thing at the end of a file. + + * org.el (org-set-packages-alist, org-get-packages-alist): New + function. + (org-export-latex-default-packages-alist) + (org-export-latex-packages-alist): Add extra flag to + each package, indicating if it should be used for snippets. + (org-create-formula-image): Add the snippet argument. + (org-splice-latex-header): New argument SNIPPET-P, pass it + through to `org-latex-packages-to-string'. + (org-latex-packages-to-string): New argument SNIPPET-P. + + * org-latex.el (org-export-latex-make-header): Add the snippet + argument. + + * org-docbook.el (org-export-as-docbook): Implement ordered + lists starting at some offset. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-link-types, org-open-at-point): Add doi links. + + * org-ascii.el (org-export-ascii-preprocess): Remove list + startcounter cookies. + + * org-list.el (org-renumber-ordered-list): Respect counter + start values. + + * org-latex.el (org-export-latex-lists): Accept ordered list + item offset cookie. + + * org-html.el (org-export-as-html): Accept ordered list + item offset cookie. + + * org-indent.el (org-indent-mode): Turn off `indent-tabs-mode' + which messes up alignment of tags. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-cancel, org-clock-out): Make sure + the modeline display is removed. + + * org-exp.el (org-export-format-drawer-function): Fix + docstring. + + * org-agenda.el (org-agenda-refile): New optional argument + NO-UPDATE. + (org-agenda-refile): Call `org-agenda-redo' unless NO-UPDATE + is set. + (org-agenda-bulk-action): Call the refile command with updates + suppressed - but arrange for `org-agenda-redo' to be called at + the end. + + * org.el (org-mode): Make table mapping quiet. + (org-table-map-tables): New optional argument QUIETLY. + + * org-ascii.el (org-export-ascii-preprocess): Make table + mapping quiet. + + * org-html.el (org-export-as-html, org-html-level-start): Change + XHTML IDs to not use dots. + + * org-exp.el (org-export-define-heading-targets): Change + XHTML IDs to not use dots. + + * org-docbook.el (org-export-docbook-level-start): Change + XHTML IDs to not use dots. + + * org-latex.el (org-export-as-latex): Make sure that the + result buffer is in latex-mode. + + * org.el (org-shiftup-final-hook, org-shiftdown-final-hook) + (org-shiftleft-final-hook, org-shiftright-final-hook): New + hooks. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-justify-field-maybe): Make sure that + inserting a value does not turn a line into a hline. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-sum): New argument HEADLINE-FILTER. + (org-clock-sum): Add property to selected headlines. + (org-dblock-write:clocktable): Make tags matcher. + + * org.el (org-set-autofill-regexps): XEmacs compatibility. + + * org-latex.el (org-export-latex-set-initial-vars): Allow "-" + in latex class definitions + + * org.el (org-shiftup-hook, org-shiftdown-hook) + (org-shiftleft-hook, org-shiftright-hook): New hooks. + + * org-entities.el (org-entities): Use \land and \lor for logical + operators. + + * org.el (org-shiftmetaleft, org-shiftmetaright): Call the subtree + indentation commands. + (org-hidden-tree-error): New defsubst. + (org-metaleft, org-metaright): Check for hidden stuff and throw an + error. + (org-check-for-hidden): New function. + + * org-list.el (org-item-re): New function. + (org-at-item-p): Use `org-item-re'. + (org-end-of-item-text-before-children): New function. + (org-outdent-item, org-indent-item): Arrange for leaving the + subtree alone. + (org-outdent-item-tree, org-indent-item-tree): New argument + NO-SUBTREE. + (org-indent-item-tree): Use `org-end-of-item-text-before-children' + to find the end for processing while ignoring the subtree. + + * org-publish.el (org-publish-sitemap-sort-alphabetically) + (org-publish-sitemap-sort-folders) + (org-publish-sitemap-sort-ignore-case): New options. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-compare-directory-files): Fix sorting. + + * org-compat.el (org-get-x-clipboard-compat): Use (featurep 'xemacs). + + * org-publish.el (org-publish-project-alist): Update docstring. + (org-publish-file-title-cache): New variable. + (org-publish-initialize-files-alist): Initialize + `org-publish-initialize-files-alist' to nil. + (org-publish-sort-directory-files): New function. + (org-publish-projects): Access the new properties. + (org-publish-find-title): Use the file title cache. + (org-publish-find-title): Build the file title cache. + (org-publish-get-base-files-1): Sort files. + (org-publish-aux-preprocess): Do not throw an error when before + the first headline. Allow an empty target, meaning to link just + to the file. + (org-publish-index-generate-theindex.inc): Check if there is + actually a target and only then add it to the link. + (org-publish-projects): Fix a remaining issue with the last commit + + * org-html.el (org-export-as-html): Treat verse as open/close + paragraph. + (org-export-html-close-lists-maybe): Allow to splice raw HTML into + and out of lists. + +2010-07-19 Dan Davison <davison@stats.ox.ac.uk> + + * org-src.el (org-edit-src-code): Allow the org-src edit buffer to + be used in a read-only mode. + (org-edit-src-code): Different message in read-only mode + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-src.el (org-edit-src-find-region-and-lang): Test for + table.el as late as possible. + + * org-colview-xemacs.el: Make sure this file is never loaded into + Emacs. Remove all tests for XEmacs. + + * org-colview.el: Make sure this file is never loaded into XEmacs. + + * org-agenda.el (org-highlight, org-unhighlight): Use direct + overlay calls. + + * org.el (org-key): Apply the translations defined in + `org-xemacs-key-equivalents'. + + * org-mouse.el (org-mode-hook): Use `org-defkey'. + + * org-compat.el (org-xemacs-key-equivalents): New constant. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-inlinetask.el (org-inlinetask-defaut-state): New option. + (org-inlinetask-insert-task): Use `org-inlinetask-defaut-state'. + Obey `org-odd-levels-only'. + + * org-compat.el (org-find-overlays): Use overlays-in/at. + + * org.el (org-remove-empty-overlays-at) + (org-outline-overlay-data, org-hide-block-toggle) + (org-format-latex, org-context): Use overlays-in/at. + + * org-src.el (org-edit-src-exit): Use overlays-in/at. + + * org-agenda.el (org-agenda-mark-clocking-task) + (org-agenda-fontify-priorities, org-agenda-dim-blocked-tasks) + (org-agenda-entry-text-hide) + (org-agenda-fix-tags-filter-overlays-at) + (org-agenda-bulk-remove-overlays): Use overlays-in/at. + + * org-compat.el (org-overlays-at): Function removed. + (org-overlays-in): Function removed. + +2010-07-19 Bastien Guerry <bzg@altern.org> + + * org-clock.el (org-clock-set-current): Just return the headline + itself, strip the TODO keyword, the priority cookie and the tags. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-compat.el (org-xemacs-without-invisibility): New macro. + (org-xemacs-without-invisibility): New macro. + (org-indent-to-column, org-indent-line-to, org-move-to-column): + Redefine using the macro `org-xemacs-without-invisibility'. + + * org.el (org-mode, org-org-menu): Use `add-to-invisibility-spec'. + + * org-table.el (orgtbl-mode): Use `add-to-invisibility-spec'. + + * org-compat.el (org-make-overlay, org-delete-overlay) + (org-overlay-start, org-overlay-end, org-overlay-put) + (org-overlay-get, org-overlay-move, org-overlay-buffer): Functions + removed. + (org-add-to-invisibility-spec): Function removed. + + * org-html.el (org-export-as-html-and-open): Add argument to + kill-buffer. + + * org-habit.el (require): `calendar' is now required already by + org.el on top level. + + * org-clock.el (require): `calendar' is now required already by + org.el on top level. + + * org-agenda.el (require, org-timeline, org-agenda-list) + (org-todo-list, org-agenda-to-appt): `calendar' is now required + already by org.el on top level. + + * org.el (org-export-latex-fix-inputenc): Declare function. + + * org-agenda.el (org-agenda-goto-calendar): Do not bind obsolete + variables. + + * org.el (calendar): Require calendar now on top level in org.el + and define aliases to new variables when needed. + (org-read-date, org-goto-calendar): Do not bind obsolete + variables. + + * org-clock.el (org-clock-out, org-clock-cancel): Get rid of + compilation warning, add comment that this cannot be done with + `with-current-buffer'. + + * org-wl.el (org-wl-open): Use `with-current-buffer'. + + * org.el (overlay, org-remove-empty-overlays-at) + (org-outline-overlay-data, org-set-outline-overlay-data) + (org-show-block-all, org-hide-block-toggle) + (org-highlight-new-match, org-remove-occur-highlights) + (org-tags-overlay, org-fast-tag-selection, org-date-ovl) + (org-read-date, org-read-date-display, org-eval-in-calendar) + (org-format-latex, org-context) + (org-speedbar-restriction-lock-overlay) + (org-speedbar-set-agenda-restriction): Use the normal overlay API. + + * org-table.el (org-table-add-rectangle-overlay) + (org-table-remove-rectangle-highlight) + (org-table-overlay-coordinates) + (org-table-toggle-coordinate-overlays): Use the normal overlay + API. + + * org-src.el (org-edit-src-code, org-edit-fixed-width-region) + (org-edit-src-exit, org-src-mode-configure-edit-buffer): Use the + normal overlay API. + + * org-colview.el (org-columns-new-overlay) + (org-columns-display-here, org-columns-remove-overlays) + (org-columns-edit-value, org-columns-next-allowed-value) + (org-columns-update): Use the normal overlay API. + + * org-clock.el (org-clock-out, org-clock-cancel) + (org-clock-put-overlay, org-clock-remove-overlays): Use the normal + overlay API. + + * org-agenda.el (org-agenda-mark-filtered-text) + (org-agenda-mark-clocking-task, org-agenda-fontify-priorities) + (org-agenda-dim-blocked-tasks, org-agenda-entry-text-show-here) + (org-agenda-entry-text-hide) + (org-agenda-restriction-lock-overlay) + (org-agenda-set-restriction-lock) + (org-agenda-filter-by-tag-hide-line) + (org-agenda-fix-tags-filter-overlays-at) + (org-agenda-filter-by-tag-show-all, org-hl) + (org-agenda-goto-calendar, org-agenda-bulk-mark) + (org-agenda-bulk-remove-overlays): Use the normal overlay API. + + * org-freemind.el (org-freemind-from-org-mode-node) + (org-freemind-from-org-mode, ) + (org-freemind-from-org-sparse-tree, org-freemind-to-org-mode): Use + interactive-p instead of called-interactively, because this is + backward compatible with older Emacsen I still support.. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-define-heading-targets): Fix bug in + regexp finding ID and CUSTOM_ID properties. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-footnote.el (org-footnote-goto-previous-reference): Renamed + from `org-footnote-goto-next-reference'. + + * org.el (org-auto-repeat-maybe): Only record LAST_REPEAT if + org-log-repeat is non-nil, or if there is clocking data in the + entry. + + * org-crypt.el (org-encrypt-entry): Improve mapping behavior. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-align-all-tags): New command. + +2010-07-19 David Maus <dmaus@ictsoc.de> + + * org-wl.el (org-wl-link-remove-filter): New customizable + variable. If non-nil, filter conditions are stripped when storing + link to message in filter folder. + (org-wl-shimbun-prefer-web-links): New customizable variable. If + non-nil, links to shimbun messages are created as web links to + message source. + (org-wl-nntp-prefer-web-links): New customizable variable. If + non-nil, links to nntp message are created as web links to gmane + or googlegroups. + (org-wl-namazu-default-index): New customizable variable. + Directory of namazu search index that should be used as default + when opening a link in a search folder. + (org-wl-folder-types): New constant. Wanderlust folder type + indicators. + (org-wl-folder-type): New function. Return type of Wanderlust + folder. + (org-wl-store-link): Create web links for shimbun or nntp messages + and strip filter conditions depending on customizable variables. + (org-wl-open): Open namazu search folder for message when called + with prefix. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-remove-if, org-remove-if-not): New functions. + (org-open-file): Use internal remove-if functions. + +2010-07-19 Jan Böcker <jan.boecker@jboecker.de> + + * org.el (org-file-apps-entry-match-against-dlink-p): new function. + (org-file-apps-ex): remove variable. + (org-open-file): Integrate org-file-apps-ex functionality back + into org-file-apps, and decide whether to match a regexp against + the link or the filename using org-file-apps-entry-uses-grouping-p. + +2010-07-19 Jan Böcker <jan.boecker@jboecker.de> + + * org.el (org-file-apps-ex): new variable. + (org-open-file): Before considering org-file-apps, first match the + regexps from org-file-apps-ex against the whole link. See + docstring of org-file-apps-ex. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-export-latex-default-packages-alist): Remove + microtype package. + (org-todo-repeat-to-state): New variable. + (org-auto-repeat-maybe): Allow user-selected target states. + (org-default-properties): Add the new property REPEAT_TO_STATE. + +2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mobile.el (org-mobile-check-setup): Make sure that there is + a binary to compute checksums. + 2010-06-26 Carsten Dominik <carsten.dominik@gmail.com> * org-agenda.el (org-agenda-goto-calendar): Do not bind obsolete diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el new file mode 100644 index 00000000000..086079f9082 --- /dev/null +++ b/lisp/org/ob-C.el @@ -0,0 +1,198 @@ +;;; ob-C.el --- org-babel functions for C and similar languages + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating C code. +;; +;; very limited implementation: +;; - currently only support :results output +;; - not much in the way of error feedback + +;;; Code: +(require 'ob) +(require 'ob-eval) +(require 'org) +(require 'cc-mode) + +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) + +(add-to-list 'org-babel-tangle-lang-exts '("c++" . "cpp")) + +(defvar org-babel-default-header-args:C '()) + +(defvar org-babel-C-compiler "gcc" + "Command used to compile a C source code file into an + executable.") + +(defvar org-babel-c++-compiler "g++" + "Command used to compile a c++ source code file into an + executable.") + +(defvar org-babel-c-variant nil + "Internal variable used to hold which type of C (e.g. C or C++) +is currently being evaluated.") + +(defun org-babel-execute:cpp (body params) + "Execute BODY according to PARAMS. This function calls +`org-babel-execute:C'." + (org-babel-execute:C body params)) + +(defun org-babel-execute:c++ (body params) + "Execute a block of C++ code with org-babel. This function is +called by `org-babel-execute-src-block'." + (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params))) + +(defun org-babel-expand-body:c++ (body params &optional processed-params) + "Expand a block of C++ code with org-babel according to it's +header arguments (calls `org-babel-C-expand')." + (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params processed-params))) + +(defun org-babel-execute:C (body params) + "Execute a block of C code with org-babel. This function is +called by `org-babel-execute-src-block'." + (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params))) + +(defun org-babel-expand-body:c (body params &optional processed-params) + "Expand a block of C code with org-babel according to it's +header arguments (calls `org-babel-C-expand')." + (let ((org-babel-c-variant 'c)) (org-babel-C-expand body params processed-params))) + +(defun org-babel-C-execute (body params) + "This function should only be called by `org-babel-execute:C' +or `org-babel-execute:c++'." + (let* ((processed-params (org-babel-process-params params)) + (tmp-src-file (make-temp-file "org-babel-C-src" nil + (cond + ((equal org-babel-c-variant 'c) ".c") + ((equal org-babel-c-variant 'cpp) ".cpp")))) + (tmp-bin-file (make-temp-file "org-babel-C-bin")) + (tmp-out-file (make-temp-file "org-babel-C-out")) + (cmdline (cdr (assoc :cmdline params))) + (flags (cdr (assoc :flags params))) + (full-body (org-babel-C-expand body params)) + (compile + (progn + (with-temp-file tmp-src-file (insert full-body)) + (org-babel-eval + (format "%s -o %s %s %s" + (cond + ((equal org-babel-c-variant 'c) org-babel-C-compiler) + ((equal org-babel-c-variant 'cpp) org-babel-c++-compiler)) + tmp-bin-file + (mapconcat 'identity + (if (listp flags) flags (list flags)) " ") + tmp-src-file) "")))) + ((lambda (results) + (org-babel-reassemble-table + (if (member "vector" (nth 2 processed-params)) + (let ((tmp-file (make-temp-file "ob-c"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file)) + (org-babel-read results)) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params))))) + (org-babel-trim + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) + +(defun org-babel-C-expand (body params &optional processed-params) + "Expand a block of C or C++ code with org-babel according to +it's header arguments." + (let ((vars (nth 1 (or processed-params + (org-babel-process-params params)))) + (main-p (not (string= (cdr (assoc :main params)) "no"))) + (includes (or (cdr (assoc :includes params)) + (org-babel-read (org-entry-get nil "includes" t)))) + (defines (org-babel-read + (or (cdr (assoc :defines params)) + (org-babel-read (org-entry-get nil "defines" t)))))) + (org-babel-trim + (mapconcat 'identity + (list + ;; includes + (mapconcat + (lambda (inc) (format "#include %s" inc)) + (if (listp includes) includes (list includes)) "\n") + ;; defines + (mapconcat + (lambda (inc) (format "#define %s" inc)) + (if (listp defines) defines (list defines)) "\n") + ;; variables + (mapconcat 'org-babel-C-var-to-C vars "\n") + ;; body + (if main-p + (org-babel-C-ensure-main-wrap body) + body) "\n") "\n")))) + +(defun org-babel-C-ensure-main-wrap (body) + "Wrap body in a \"main\" function call if none exists." + (if (string-match "^[ \t]*[intvod]+[ \t]*main[ \t]*(.*)" body) + body + (format "int main() {\n%s\n}\n" body))) + +(defun org-babel-prep-session:C (session params) + "This function does nothing as C is a compiled language with no +support for sessions" + (error "C is a compiled languages -- no support for sessions")) + +(defun org-babel-load-session:C (session body params) + "This function does nothing as C is a compiled language with no +support for sessions" + (error "C is a compiled languages -- no support for sessions")) + +;; helper functions + +(defun org-babel-C-var-to-C (pair) + "Convert an elisp val into a string of C code specifying a var +of the same value." + ;; TODO list support + (let ((var (car pair)) + (val (cdr pair))) + (when (symbolp val) + (setq val (symbol-name val)) + (when (= (length val) 1) + (setq val (string-to-char val)))) + (cond + ((integerp val) + (format "int %S = %S;" var val)) + ((floatp val) + (format "double %S = %S;" var val)) + ((or (characterp val)) + (format "char %S = '%S';" var val)) + ((stringp val) + (format "char %S[%d] = \"%s\";" + var (+ 1 (length val)) val)) + (t + (format "u32 %S = %S;" var val))))) + + +(provide 'ob-C) + +;; arch-tag: 8f49e462-54e3-417b-9a8d-423864893b37 + +;;; ob-C.el ends here diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el new file mode 100644 index 00000000000..105862c1571 --- /dev/null +++ b/lisp/org/ob-R.el @@ -0,0 +1,279 @@ +;;; ob-R.el --- org-babel functions for R code evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research, R, statistics +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating R code + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function orgtbl-to-tsv "ob-table" (table params)) +(declare-function R "ext:essd-r" (&optional start-args)) +(declare-function inferior-ess-send-input "ext:ess-inf" ()) + +(defconst org-babel-header-arg-names:R + '(width height bg units pointsize antialias quality compression + res type family title fonts version paper encoding + pagecentre colormodel useDingbats horizontal) + "R-specific header arguments.") + +(defvar org-babel-default-header-args:R '()) + +(defvar org-babel-R-command "R --slave --no-save" + "Name of command to use for executing R code.") + +(defun org-babel-expand-body:R (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let* ((processed-params (or processed-params + (org-babel-process-params params))) + (vars (mapcar + (lambda (i) + (cons (car (nth i (nth 1 processed-params))) + (org-babel-reassemble-table + (cdr (nth i (nth 1 processed-params))) + (cdr (nth i (nth 4 processed-params))) + (cdr (nth i (nth 5 processed-params)))))) + (number-sequence 0 (1- (length (nth 1 processed-params)))))) + (out-file (cdr (assoc :file params)))) + (mapconcat ;; define any variables + #'org-babel-trim + ((lambda (inside) + (if out-file + (append + (list (org-babel-R-construct-graphics-device-call out-file params)) + inside + (list "dev.off()")) + inside)) + (append + (mapcar + (lambda (pair) + (org-babel-R-assign-elisp + (car pair) (cdr pair) + (equal "yes" (cdr (assoc :colnames params))) + (equal "yes" (cdr (assoc :rownames params))))) + vars) + (list body))) "\n"))) + +(defun org-babel-execute:R (body params) + "Execute a block of R code. +This function is called by `org-babel-execute-src-block'." + (save-excursion + (let* ((processed-params (org-babel-process-params params)) + (result-type (nth 3 processed-params)) + (session (org-babel-R-initiate-session + (first processed-params) params)) + (colnames-p (cdr (assoc :colnames params))) + (rownames-p (cdr (assoc :rownames params))) + (out-file (cdr (assoc :file params))) + (full-body (org-babel-expand-body:R body params processed-params)) + (result + (org-babel-R-evaluate + session full-body result-type + (or (equal "yes" colnames-p) + (org-babel-pick-name (nth 4 processed-params) colnames-p)) + (or (equal "yes" rownames-p) + (org-babel-pick-name (nth 5 processed-params) rownames-p))))) + (message "result is %S" result) + (or out-file result)))) + +(defun org-babel-prep-session:R (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-R-initiate-session session params)) + (vars (org-babel-ref-variables params)) + (var-lines + (mapcar + (lambda (pair) (org-babel-R-assign-elisp + (car pair) (cdr pair) + (equal (cdr (assoc :colnames params)) "yes") + (equal (cdr (assoc :rownames params)) "yes"))) + vars))) + (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:R (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:R 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-R-quote-tsv-field (s) + "Quote field S for export to R." + (if (stringp s) + (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") + (format "%S" s))) + +(defun org-babel-R-assign-elisp (name value colnames-p rownames-p) + "Construct R code assigning the elisp VALUE to a variable named NAME." + (if (listp value) + (let ((transition-file (make-temp-file "org-babel-R-import"))) + ;; ensure VALUE has an orgtbl structure (depth of at least 2) + (unless (listp (car value)) (setq value (list value))) + (with-temp-file (org-babel-maybe-remote-file transition-file) + (insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field))) + (insert "\n")) + (format "%s <- read.table(\"%s\", header=%s, row.names=%s, sep=\"\\t\", as.is=TRUE)" + name transition-file + (if (or (eq (nth 1 value) 'hline) colnames-p) "TRUE" "FALSE") + (if rownames-p "1" "NULL"))) + (format "%s <- %s" name (org-babel-R-quote-tsv-field value)))) + +(defun org-babel-R-initiate-session (session params) + "If there is not a current R process then create one." + (unless (string= session "none") + (let ((session (or session "*R*")) + (ess-ask-for-ess-directory (not (cdr (assoc :dir params))))) + (if (org-babel-comint-buffer-livep session) + session + (save-window-excursion + (require 'ess) (R) + (rename-buffer + (if (bufferp session) + (buffer-name session) + (if (stringp session) + session + (buffer-name)))) + (current-buffer)))))) + +(defun org-babel-R-construct-graphics-device-call (out-file params) + "Construct the call to the graphics device." + (let ((devices + '((:bmp . "bmp") + (:jpg . "jpeg") + (:jpeg . "jpeg") + (:tiff . "tiff") + (:png . "png") + (:svg . "svg") + (:pdf . "pdf") + (:ps . "postscript") + (:postscript . "postscript"))) + (allowed-args '(:width :height :bg :units :pointsize + :antialias :quality :compression :res + :type :family :title :fonts :version + :paper :encoding :pagecentre :colormodel + :useDingbats :horizontal)) + (device (and (string-match ".+\\.\\([^.]+\\)" out-file) + (match-string 1 out-file))) + (extra-args (cdr (assq :R-dev-args params))) filearg args) + (setq device (or (and device (cdr (assq (intern (concat ":" device)) + devices))) "png")) + (setq filearg + (if (member device '("pdf" "postscript" "svg")) "file" "filename")) + (setq args (mapconcat + (lambda (pair) + (if (member (car pair) allowed-args) + (format ",%s=%s" + (substring (symbol-name (car pair)) 1) + (cdr pair)) "")) + params "")) + (format "%s(%s=\"%s\"%s%s%s)" + device filearg out-file args + (if extra-args "," "") (or extra-args "")))) + +(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'") +(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"") +(defvar org-babel-R-wrapper-method "main <- function ()\n{\n%s\n} +write.table(main(), file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)") +(defvar org-babel-R-wrapper-lastvar "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)") + +(defun org-babel-R-evaluate + (session body result-type column-names-p row-names-p) + "Pass BODY to the R 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." + (if (not session) + ;; external process evaluation + (case result-type + (output (org-babel-eval org-babel-R-command body)) + (value + (let ((tmp-file (make-temp-file "org-babel-R-results-"))) + (org-babel-eval org-babel-R-command + (format org-babel-R-wrapper-method + body tmp-file + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE"))) + (org-babel-R-process-value-result + (org-babel-import-elisp-from-file + (org-babel-maybe-remote-file tmp-file)) column-names-p)))) + ;; comint session evaluation + (case result-type + (value + (let ((tmp-file (make-temp-file "org-babel-R")) + broke) + (org-babel-comint-with-output (session org-babel-R-eoe-output) + (insert (mapconcat + #'org-babel-chomp + (list + body + (format org-babel-R-wrapper-lastvar + tmp-file + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE")) + org-babel-R-eoe-indicator) "\n")) + (inferior-ess-send-input)) + (org-babel-R-process-value-result + (org-babel-import-elisp-from-file + (org-babel-maybe-remote-file tmp-file)) column-names-p))) + (output + (mapconcat + #'org-babel-chomp + (butlast + (delq nil + (mapcar + #'identity + (org-babel-comint-with-output (session org-babel-R-eoe-output) + (insert (mapconcat #'org-babel-chomp + (list body org-babel-R-eoe-indicator) + "\n")) + (inferior-ess-send-input)))) 2) "\n"))))) + +(defun org-babel-R-process-value-result (result column-names-p) + "R-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-R) + +;; arch-tag: cd4c7298-503b-450f-a3c2-f3e74b630237 + +;;; ob-R.el ends here diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el new file mode 100644 index 00000000000..043bc4c5ff7 --- /dev/null +++ b/lisp/org/ob-asymptote.el @@ -0,0 +1,161 @@ +;;; ob-asymptote.el --- org-babel functions for asymptote evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating asymptote source code. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in asymptote +;; +;; 2) we are generally only going to return results of type "file" +;; +;; 3) we are adding the "file" and "cmdline" header arguments, if file +;; is omitted then the -V option is passed to the asy command for +;; interactive viewing + +;;; Requirements: + +;; - The asymptote program :: http://asymptote.sourceforge.net/ +;; +;; - asy-mode :: Major mode for editing asymptote files + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function org-combine-plists "org" (&rest plists)) + +(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy")) + +(defvar org-babel-default-header-args:asymptote + '((:results . "file") (:exports . "results")) + "Default arguments when evaluating an Asymptote source block.") + +(defun org-babel-expand-body:asymptote (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params + (org-babel-process-params params))))) + (concat (mapconcat 'org-babel-asymptote-var-to-asymptote vars "\n") + "\n" body "\n"))) + +(defun org-babel-execute:asymptote (body params) + "Execute a block of Asymptote code. +This function is called by `org-babel-execute-src-block'." + (let* ((processed-params (org-babel-process-params params)) + (result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (format (or (and out-file + (string-match ".+\\.\\(.+\\)" out-file) + (match-string 1 out-file)) + "pdf")) + (cmdline (cdr (assoc :cmdline params))) + (in-file (make-temp-file "org-babel-asymptote")) + (cmd (concat "asy " + (if out-file + (concat "-globalwrite -f " format " -o " out-file) + "-V") + " " cmdline " " in-file))) + (with-temp-file in-file + (insert (org-babel-expand-body:asymptote body params processed-params))) + (message cmd) (shell-command cmd) + out-file)) + +(defun org-babel-prep-session:asymptote (session params) + "Return an error if the :session header argument is set. +Asymptote does not support sessions" + (error "Asymptote does not support sessions")) + +(defun org-babel-asymptote-var-to-asymptote (pair) + "Convert an elisp value into an Asymptote variable. +The elisp value PAIR is converted into Asymptote code specifying +a variable of the same value." + (let ((var (car pair)) + (val (if (symbolp (cdr pair)) + (symbol-name (cdr pair)) + (cdr pair)))) + (cond + ((integerp val) + (format "int %S=%S;" var val)) + ((floatp val) + (format "real %S=%S;" var val)) + ((stringp val) + (format "string %S=\"%s\";" var val)) + ((listp val) + (let* ((dimension-2-p (not (null (cdr val)))) + (dim (if dimension-2-p "[][]" "[]")) + (type (org-babel-asymptote-define-type val)) + (array (org-babel-asymptote-table-to-array + val + (if dimension-2-p '(:lstart "{" :lend "}," :llend "}"))))) + (format "%S%s %S=%s;" type dim var array)))))) + +(defun org-babel-asymptote-table-to-array (table params) + "Convert values of an elisp table into a string of an asymptote array. +Empty cells are ignored." + (labels ((atom-to-string (table) + (cond + ((null table) '()) + ((not (listp (car table))) + (cons (if (and (stringp (car table)) + (not (string= (car table) ""))) + (format "\"%s\"" (car table)) + (format "%s" (car table))) + (atom-to-string (cdr table)))) + (t + (cons (atom-to-string (car table)) + (atom-to-string (cdr table)))))) + ;; Remove any empty row + (fix-empty-lines (table) + (delq nil (mapcar (lambda (l) (delq "" l)) table)))) + (orgtbl-to-generic + (fix-empty-lines (atom-to-string table)) + (org-combine-plists '(:hline nil :sep "," :tstart "{" :tend "}") params)))) + +(defun org-babel-asymptote-define-type (data) + "Determine type of DATA. +DATA is a list. Type symbol is returned as 'symbol. The type is +usually the type of the first atom encountered, except for arrays +of int, where every cell must be of int type." + (labels ((anything-but-int (el) + (cond + ((null el) nil) + ((not (listp (car el))) + (cond + ((floatp (car el)) 'real) + ((stringp (car el)) 'string) + (t + (anything-but-int (cdr el))))) + (t + (or (anything-but-int (car el)) + (anything-but-int (cdr el))))))) + (or (anything-but-int data) 'int))) + +(provide 'ob-asymptote) + +;; arch-tag: f2f5bd0d-78e8-412b-8e6c-6dadc94cc06b + +;;; ob-asymptote.el ends here diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el new file mode 100644 index 00000000000..c42d9b4db38 --- /dev/null +++ b/lisp/org/ob-clojure.el @@ -0,0 +1,316 @@ +;;; ob-clojure.el --- org-babel functions for clojure evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Joel Boehland +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; ob support for evaluating clojure code + +;;; Requirements: + +;;; A working clojure install. This also implies a working java executable +;;; clojure-mode +;;; slime +;;; swank-clojure + +;;; By far, the best way to install these components is by following +;;; the directions as set out by Phil Hagelberg (Technomancy) on the +;;; web page: http://technomancy.us/126 + +;;; Code: +(require 'ob) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function slime-eval-async "ext:slime" (sexp &optional cont package)) +(declare-function slime-eval "ext:slime" (sexp &optional package)) +(declare-function swank-clojure-concat-paths "ext:slime" (paths)) +(declare-function org-babel-ref-variables "ext:slime" (params)) +(declare-function slime "ext:slime" (&optional command coding-system)) +(declare-function slime-output-buffer "ext:slime" (&optional noprompt)) +(declare-function slime-filter-buffers "ext:slime" (predicate)) + +(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) + +(defvar org-babel-default-header-args:clojure '()) + +(defvar org-babel-clojure-wrapper-method + " +(defn spit + [f content] + (with-open [#^java.io.PrintWriter w + (java.io.PrintWriter. + (java.io.BufferedWriter. + (java.io.OutputStreamWriter. + (java.io.FileOutputStream. + (java.io.File. f)))))] + (.print w content))) + +(defn main + [] + %s) + +(spit \"%s\" (str (main)))") +;;";; <-- syntax highlighting is messed without this double quote + +;;taken mostly from clojure-test-mode.el +(defun org-babel-clojure-clojure-slime-eval (string &optional handler) + "Evaluate a STRING of clojure code using `slime-eval-async'." + (slime-eval-async `(swank:eval-and-grab-output ,string) + (or handler #'identity))) + +(defun org-babel-clojure-slime-eval-sync (string) + "Evaluate a STRING of clojure code using `slime-eval'." + (slime-eval `(swank:eval-and-grab-output ,string))) + +;;taken from swank-clojure.el +(defvar swank-clojure-binary) +(defvar swank-clojure-classpath) +(defvar swank-clojure-java-path) +(defvar swank-clojure-extra-vm-args) +(defvar swank-clojure-library-paths) +(defvar swank-clojure-extra-classpaths) +(defun org-babel-clojure-babel-clojure-cmd () + "Create the command to start clojure according to current settings." + (if (and (not swank-clojure-binary) (not swank-clojure-classpath)) + (error "%s" (concat "You must specifiy either a `swank-clojure-binary' " + "or a `swank-clojure-jar-path'")) + (if swank-clojure-binary + (if (listp swank-clojure-binary) + swank-clojure-binary + (list swank-clojure-binary)) + (delq + nil + (append + (list swank-clojure-java-path) + swank-clojure-extra-vm-args + (list + (when swank-clojure-library-paths + (concat "-Djava.library.path=" + (swank-clojure-concat-paths swank-clojure-library-paths))) + "-classpath" + (swank-clojure-concat-paths + (append + swank-clojure-classpath + swank-clojure-extra-classpaths)) + "clojure.main")))))) + +(defun org-babel-clojure-table-or-string (results) + "Convert RESULTS to an elisp value. +If RESULTS looks like a table, then convert to an Emacs-lisp +table, otherwise return the results as a string." + (org-babel-read + (if (string-match "^\\[.+\\]$" results) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + ", " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(defun org-babel-clojure-var-to-clojure (var) + "Convert an elisp value into a clojure variable. +The elisp value VAR is converted into a string of clojure source +code specifying a variable of the same value." + (if (listp var) + (format "'%s" var) + (format "%S" var))) + +(defun org-babel-clojure-build-full-form (body vars) + "Construct a clojure let form with VARS as the let variables." + (let ((vars-forms + (mapconcat ;; define any variables + (lambda (pair) + (format "%s %s" + (car pair) (org-babel-clojure-var-to-clojure (cdr pair)))) + vars "\n ")) + (body (org-babel-trim body))) + (if (> (length vars-forms) 0) + (format "(let [%s]\n %s)" vars-forms body) + body))) + +(defun org-babel-prep-session:clojure (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (require 'slime) (require 'swank-clojure) + (let* ((session-buf (org-babel-clojure-initiate-session session)) + (vars (org-babel-ref-variables params)) + (var-lines (mapcar ;; define any top level session variables + (lambda (pair) + (format "(def %s %s)\n" (car pair) + (org-babel-clojure-var-to-clojure (cdr pair)))) + vars))) + session-buf)) + +(defun org-babel-load-session:clojure (session body params) + "Load BODY into SESSION." + (require 'slime) (require 'swank-clojure) + (save-window-excursion + (let ((buffer (org-babel-prep-session:clojure session params))) + (with-current-buffer buffer + (goto-char (point-max)) + (insert (org-babel-chomp body))) + buffer))) + +(defvar org-babel-clojure-buffers '()) +(defvar org-babel-clojure-pending-sessions '()) + +(defun org-babel-clojure-session-buffer (session) + "Return the buffer associated with SESSION." + (cdr (assoc session org-babel-clojure-buffers))) + +(defun org-babel-clojure-initiate-session-by-key (&optional session) + "Initiate a clojure session in an inferior-process-buffer. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session." + (save-window-excursion + (let* ((session (if session + (if (stringp session) (intern session) + session) + :default)) + (clojure-buffer (org-babel-clojure-session-buffer session))) + (unless (and clojure-buffer (buffer-live-p clojure-buffer)) + (setq org-babel-clojure-buffers + (assq-delete-all session org-babel-clojure-buffers)) + (push session org-babel-clojure-pending-sessions) + (slime) + ;; we are waiting to finish setting up which will be done in + ;; org-babel-clojure-session-connected-hook below. + (let ((timeout 9)) + (while (and (not (org-babel-clojure-session-buffer session)) + (< 0 timeout)) + (message "Waiting for clojure repl for session: %s ... %i" + session timeout) + (sit-for 1) + (decf timeout))) + (setq org-babel-clojure-pending-sessions + (remove session org-babel-clojure-pending-sessions)) + (unless (org-babel-clojure-session-buffer session) + (error "Couldn't create slime clojure process")) + (setq clojure-buffer (org-babel-clojure-session-buffer session))) + session))) + +(defun org-babel-clojure-initiate-session (&optional session params) + "Return the slime-clojure repl buffer bound to SESSION. +Returns nil if \"none\" is specified." + (require 'slime) (require 'swank-clojure) + (unless (and (stringp session) (string= session "none")) + (org-babel-clojure-session-buffer + (org-babel-clojure-initiate-session-by-key session)))) + +(defun org-babel-clojure-session-connected-hook () + "Finish binding an org-babel session to a slime-clojure repl." + (let ((pending-session (pop org-babel-clojure-pending-sessions))) + (when pending-session + (save-excursion + (switch-to-buffer (slime-output-buffer)) + (rename-buffer + (if (stringp pending-session) + pending-session (symbol-name pending-session))) + (org-babel-clojure-bind-session-to-repl-buffer + pending-session (slime-output-buffer)))))) + +(add-hook 'slime-connected-hook 'org-babel-clojure-session-connected-hook) + +(defun org-babel-clojure-bind-session-to-repl-buffer (session repl-buffer) + "Associate SESSION with REPL-BUFFER." + (when (stringp session) (setq session (intern session))) + (setq org-babel-clojure-buffers + (cons (cons session repl-buffer) + (assq-delete-all session org-babel-clojure-buffers)))) + +(defun org-babel-clojure-repl-buffer-pred () + "Test whether the current buffer is an active slime-clojure +repl buffer." + (and (buffer-live-p (current-buffer)) (eq major-mode 'slime-repl-mode))) + +(defun org-babel-clojure-bind-session-to-repl (session) + "Bind SESSION to a clojure repl." + (interactive "sEnter session name: ") + (let ((repl-bufs (slime-filter-buffers 'org-babel-clojure-repl-buffer-pred))) + (unless repl-bufs (error "No existing slime-clojure repl buffers exist")) + (let ((repl-buf (read-buffer "Choose slime-clojure repl: " repl-bufs t))) + (org-babel-clojure-bind-session-to-repl-buffer session repl-buf)))) + +(defun org-babel-clojure-evaluate-external-process + (buffer body &optional result-type) + "Evaluate the body in an external process." + (let ((cmd (format "%s -" (mapconcat #'identity + (org-babel-clojure-babel-clojure-cmd) + " ")))) + (case result-type + (output (org-babel-eval cmd body)) + (value (let* ((tmp-file (make-temp-file "org-babel-clojure-results-"))) + (org-babel-eval cmd (format org-babel-clojure-wrapper-method + body tmp-file tmp-file)) + (org-babel-clojure-table-or-string + (org-babel-eval-read-file tmp-file))))))) + +(defun org-babel-clojure-evaluate-session (buffer body &optional result-type) + "Evaluate the body in the context of a clojure session." + (require 'slime) (require 'swank-clojure) + (let ((raw nil) + (results nil)) + (with-current-buffer buffer + (setq raw (org-babel-clojure-slime-eval-sync body)) + (setq results (reverse (mapcar #'org-babel-trim raw))) + (cond + ((equal result-type 'output) + (mapconcat #'identity (reverse (cdr results)) "\n")) + ((equal result-type 'value) + (org-babel-clojure-table-or-string (car results))))))) + +(defun org-babel-clojure-evaluate (buffer body &optional result-type) + "Pass BODY to the Clojure process in BUFFER. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY as elisp." + (if buffer + (org-babel-clojure-evaluate-session buffer body result-type) + (org-babel-clojure-evaluate-external-process buffer body result-type))) + +(defun org-babel-expand-body:clojure (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (org-babel-clojure-build-full-form + body (nth 1 (or processed-params (org-babel-process-params params))))) + +(defun org-babel-execute:clojure (body params) + "Execute a block of Clojure code." + (require 'slime) (require 'swank-clojure) + (let* ((processed-params (org-babel-process-params params)) + (body (org-babel-expand-body:clojure body params processed-params)) + (session (org-babel-clojure-initiate-session + (first processed-params)))) + (org-babel-reassemble-table + (org-babel-clojure-evaluate session body (nth 3 processed-params)) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params)))))) + +(provide 'ob-clojure) + +;; arch-tag: a43b33f2-653e-46b1-ac56-2805cf05b7d1 + +;;; ob-clojure.el ends here diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el new file mode 100644 index 00000000000..732f2766b28 --- /dev/null +++ b/lisp/org/ob-comint.el @@ -0,0 +1,143 @@ +;;; ob-comint.el --- org-babel functions for interaction with comint buffers + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, comint +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; These functions build on comint to ease the sending and receiving +;; of commands and results from comint buffers. + +;; Note that the buffers in this file are analogous to sessions in +;; org-babel at large. + +;;; Code: +(require 'ob) +(require 'comint) +(eval-when-compile (require 'cl)) + +(defun org-babel-comint-buffer-livep (buffer) + "Check if BUFFER is a comint buffer with a live process." + (let ((buffer (if buffer (get-buffer buffer)))) + (and buffer (buffer-live-p buffer) (get-buffer-process buffer) buffer))) + +(defmacro org-babel-comint-in-buffer (buffer &rest body) + "Check BUFFER and execute BODY. +BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is +executed inside the protection of `save-window-excursion' and +`save-match-data'." + (declare (indent 1)) + `(save-excursion + (save-match-data + (unless (org-babel-comint-buffer-livep ,buffer) + (error "buffer %s doesn't exist or has no process" ,buffer)) + (set-buffer ,buffer) + ,@body))) + +(defmacro org-babel-comint-with-output (meta &rest body) + "Evaluate BODY in BUFFER and return process output. +Will wait until EOE-INDICATOR appears in the output, then return +all process output. If REMOVE-ECHO and FULL-BODY are present and +non-nil, then strip echo'd body from the returned output. META +should be a list containing the following where the last two +elements are optional. + + (BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY) + +This macro ensures that the filter is removed in case of an error +or user `keyboard-quit' during execution of body." + (declare (indent 1)) + (let ((buffer (car meta)) + (eoe-indicator (cadr meta)) + (remove-echo (cadr (cdr meta))) + (full-body (cadr (cdr (cdr meta))))) + `(org-babel-comint-in-buffer ,buffer + (let ((string-buffer "") dangling-text raw) + (flet ((my-filt (text) + (setq string-buffer (concat string-buffer text)))) + ;; setup filter + (add-hook 'comint-output-filter-functions 'my-filt) + (unwind-protect + (progn + ;; got located, and save dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (let ((start (point)) + (end (point-max))) + (setq dangling-text (buffer-substring start end)) + (delete-region start end)) + ;; pass FULL-BODY to process + ,@body + ;; wait for end-of-evaluation indicator + (while (progn + (goto-char comint-last-input-end) + (not (save-excursion + (and (re-search-forward + comint-prompt-regexp nil t) + (re-search-forward + (regexp-quote ,eoe-indicator) nil t))))) + (accept-process-output (get-buffer-process (current-buffer))) + ;; thought the following this would allow async + ;; background running, but I was wrong... + ;; (run-with-timer .5 .5 'accept-process-output + ;; (get-buffer-process (current-buffer))) + ) + ;; replace cut dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert dangling-text)) + ;; remove filter + (remove-hook 'comint-output-filter-functions 'my-filt))) + ;; remove echo'd FULL-BODY from input + (if (and ,remove-echo ,full-body + (string-match + (replace-regexp-in-string + "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) + string-buffer)) + (setq raw (substring string-buffer (match-end 0)))) + (split-string string-buffer comint-prompt-regexp))))) + +(defun org-babel-comint-input-command (buffer cmd) + "Pass CMD to BUFFER. +The input will not be echoed." + (org-babel-comint-in-buffer buffer + (goto-char (process-mark (get-buffer-process buffer))) + (insert cmd) + (comint-send-input) + (org-babel-comint-wait-for-output buffer))) + +(defun org-babel-comint-wait-for-output (buffer) + "Wait until output arrives from BUFFER. +Note: this is only safe when waiting for the result of a single +statement (not large blocks of code)." + (org-babel-comint-in-buffer buffer + (while (progn + (goto-char comint-last-input-end) + (not (and (re-search-forward comint-prompt-regexp nil t) + (goto-char (match-beginning 0)) + (string= (face-name (face-at-point)) + "comint-highlight-prompt")))) + (accept-process-output (get-buffer-process buffer))))) + +(provide 'ob-comint) + +;; arch-tag: 9adddce6-0864-4be3-b0b5-6c5157dc7889 + +;;; ob-comint.el ends here diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el new file mode 100644 index 00000000000..0a279b24573 --- /dev/null +++ b/lisp/org/ob-css.el @@ -0,0 +1,52 @@ +;;; ob-css.el --- org-babel functions for css evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Since CSS can't be executed, this file exists solely for tangling +;; CSS from org-mode files. + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:css '()) + +(defun org-babel-expand-body:css (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defun org-babel-execute:css (body params) + "Execute a block of CSS code. +This function is called by `org-babel-execute-src-block'." + body) + +(defun org-babel-prep-session:css (session params) + "Return an error if the :session header argument is set. +CSS does not support sessions." + (error "CSS sessions are nonsensical")) + +(provide 'ob-css) + +;; arch-tag: f4447e8c-50ab-41f9-b322-b7b9574d9fbe + +;;; ob-css.el ends here diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el new file mode 100644 index 00000000000..336eaa93f12 --- /dev/null +++ b/lisp/org/ob-ditaa.el @@ -0,0 +1,72 @@ +;;; ob-ditaa.el --- org-babel functions for ditaa evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating ditaa source code. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in ditaa +;; +;; 2) we are generally only going to return results of type "file" +;; +;; 3) we are adding the "file" and "cmdline" header arguments +;; +;; 4) there are no variables (at least for now) + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:ditaa + '((:results . "file") (:exports . "results")) + "Default arguments for evaluating a ditaa source block.") + +(defun org-babel-expand-body:ditaa (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defvar org-ditaa-jar-path) +(defun org-babel-execute:ditaa (body params) + "Execute a block of Ditaa code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (make-temp-file "org-babel-ditaa"))) + (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 (concat "java -jar " org-ditaa-jar-path " " cmdline " " in-file " " out-file)) + (shell-command (concat "java -jar " (shell-quote-argument org-ditaa-jar-path) " " cmdline " " in-file " " out-file)) + out-file)) + +(defun org-babel-prep-session:ditaa (session params) + "Return an error because ditaa does not support sessions." + (error "Ditaa does not support sessions")) + +(provide 'ob-ditaa) + +;; arch-tag: 492cd006-07d9-4fac-bef6-5bb60b48842e + +;;; ob-ditaa.el ends here diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el new file mode 100644 index 00000000000..4657fb80ba0 --- /dev/null +++ b/lisp/org/ob-dot.el @@ -0,0 +1,87 @@ +;;; ob-dot.el --- org-babel functions for dot evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating dot source code. +;; +;; For information on dot see http://www.graphviz.org/ +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in dot +;; +;; 2) we are generally only going to return results of type "file" +;; +;; 3) we are adding the "file" and "cmdline" header arguments +;; +;; 4) there are no variables (at least for now) + +;;; Code: +(require 'ob) +(require 'ob-eval) + +(defvar org-babel-default-header-args:dot + '((:results . "file") (:exports . "results")) + "Default arguments to use when evaluating a dot source block.") + +(defun org-babel-expand-body:dot (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params + (org-babel-process-params params))))) + (mapc + (lambda (pair) + (let ((name (symbol-name (car pair))) + (value (cdr pair))) + (setq body + (replace-regexp-in-string + (concat "\$" (regexp-quote name)) + (if (stringp value) value (format "%S" value)) + body)))) + vars) + body)) + +(defun org-babel-execute:dot (body params) + "Execute a block of Dot code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let ((processed-params (org-babel-process-params params)) + (result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (cmdline (cdr (assoc :cmdline params))) + (cmd (or (cdr (assoc :cmd params)) "dot")) + (in-file (make-temp-file "org-babel-dot"))) + (with-temp-file in-file + (insert (org-babel-expand-body:dot body params processed-params))) + (org-babel-eval (concat cmd " " in-file " " cmdline " -o " out-file) "") + out-file)) + +(defun org-babel-prep-session:dot (session params) + "Return an error because Dot does not support sessions." + (error "Dot does not support sessions")) + +(provide 'ob-dot) + +;; arch-tag: 817d0516-7b47-4f77-a8b2-2aadd8e4d0e2 + +;;; ob-dot.el ends here diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el new file mode 100644 index 00000000000..92c3f36e2ed --- /dev/null +++ b/lisp/org/ob-emacs-lisp.el @@ -0,0 +1,74 @@ +;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating emacs-lisp code + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:emacs-lisp + '((:hlines . "yes") (:colnames . "no")) + "Default arguments for evaluating an emacs-lisp source block.") + +(declare-function org-babel-comint-with-output "ob-comint" (&rest body)) +(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) +(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) +(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) +(declare-function orgtbl-to-generic "org-table" (table params)) + +(defun org-babel-expand-body:emacs-lisp (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let* ((processed-params (or processed-params (org-babel-process-params params))) + (vars (nth 1 processed-params)) + (result-params (nth 2 processed-params)) + (print-level nil) (print-length nil) + (body (if (> (length vars) 0) + (concat "(let (" + (mapconcat + (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) + vars "\n ") + ")\n" body ")") + body))) + (if (or (member "code" result-params) + (member "pp" result-params)) + (concat "(pp " body ")") body))) + +(defun org-babel-execute:emacs-lisp (body params) + "Execute a block of emacs-lisp code with Babel." + (save-window-excursion + (let ((processed-params (org-babel-process-params params))) + (org-babel-reassemble-table + (eval (read (format "(progn %s)" + (org-babel-expand-body:emacs-lisp + body params processed-params)))) + (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))) + +(provide 'ob-emacs-lisp) + +;; arch-tag: e9a3acca-dc84-472a-9f5a-23c35befbcd6 + +;;; ob-emacs-lisp.el ends here diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el new file mode 100644 index 00000000000..dea39f12089 --- /dev/null +++ b/lisp/org/ob-eval.el @@ -0,0 +1,255 @@ +;;; ob-run.el --- org-babel functions for external code evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, comint +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; These functions build existing Emacs support for executing external +;; shell commands. + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(defun org-babel-eval-error-notify (exit-code stderr) + "Open a buffer to display STDERR and a message with the value of EXIT-CODE." + (let ((buf (get-buffer-create "*Org-Babel Error Output*"))) + (with-current-buffer buf + (goto-char (point-max)) + (save-excursion (insert stderr))) + (display-buffer buf)) + (message "Babel evaluation exited with code %S" exit-code)) + +(defun org-babel-eval (cmd body) + "Run CMD on BODY. +If CMD succeeds then return it's results, otherwise display +STDERR with `org-babel-eval-error-notify'." + (let ((err-buff (get-buffer-create "*Org-Babel Error*")) exit-code) + (with-current-buffer err-buff (erase-buffer)) + (with-temp-buffer + (insert body) + (setq exit-code + (org-babel-shell-command-on-region + (point-min) (point-max) cmd t 'replace err-buff)) + (if (or (not (numberp exit-code)) (> exit-code 0)) + (progn + (with-current-buffer err-buff + (org-babel-eval-error-notify exit-code (buffer-string))) + nil) + (buffer-string))))) + +(defun org-babel-eval-read-file (file) + "Return the contents of FILE as a string." + (with-temp-buffer (insert-file-contents + (org-babel-maybe-remote-file file)) + (buffer-string))) + +(defun org-babel-shell-command-on-region (start end command + &optional output-buffer replace + error-buffer display-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 ((error-file + (if error-buffer + (make-temp-file + (expand-file-name "scor" + (or (unless (featurep 'xemacs) + small-temporary-file-directory) + temporary-file-directory))) + nil)) + exit-status) + (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)) + (setq exit-status + (call-process-region start end shell-file-name t + (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)) + (setq exit-status + (call-process-region (point-min) (point-max) + shell-file-name t + (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 + (call-process-region start end 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) + )))) + + (when (and error-file (file-exists-p error-file)) + (if (< 0 (nth 7 (file-attributes error-file))) + (with-current-buffer (get-buffer-create error-buffer) + (let ((pos-from-end (- (point-max) (point)))) + (or (bobp) + (insert "\f\n")) + ;; Do no formatting while reading error file, + ;; because that can run a shell command, and we + ;; don't want that to cause an infinite recursion. + (format-insert-file error-file nil) + ;; Put point after the inserted errors. + (goto-char (- (point-max) pos-from-end))) + (and display-error-buffer + (display-buffer (current-buffer))))) + (delete-file error-file)) + exit-status)) + +(provide 'ob-eval) + +;; arch-tag: 5328b17f-957d-42d9-94da-a2952682d04d + +;;; ob-comint.el ends here diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el new file mode 100644 index 00000000000..4c074887ef1 --- /dev/null +++ b/lisp/org/ob-exp.el @@ -0,0 +1,313 @@ +;;; ob-exp.el --- Exportation of org-babel source blocks + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; See the online documentation for more information +;; +;; http://orgmode.org/worg/org-contrib/babel/ + +;;; Code: +(require 'ob) +(require 'org-exp-blocks) +(eval-when-compile + (require 'cl)) + +(defvar obe-marker nil) +(defvar org-current-export-file) +(defvar org-babel-lob-one-liner-regexp) +(defvar org-babel-ref-split-regexp) +(declare-function org-babel-lob-get-info "ob-lob" ()) +(declare-function org-babel-ref-literal "ob-ref" (ref)) + +(add-to-list 'org-export-interblocks '(src org-babel-exp-inline-src-blocks)) +(add-to-list 'org-export-interblocks '(lob org-babel-exp-lob-one-liners)) +(add-hook 'org-export-blocks-postblock-hook 'org-exp-res/src-name-cleanup) + +(org-export-blocks-add-block '(src org-babel-exp-src-blocks nil)) + +(defcustom org-export-babel-evaluate t + "Switch controlling code evaluation during export. +When set to nil no code will be exported as part of the export +process." + :group 'org-babel + :type 'boolean) +(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) + +(defvar org-babel-function-def-export-keyword "function" + "The keyword to substitute for the source name line on export. +When exporting a source block function, this keyword will +appear in the exported version in the place of source name +line. A source block is considered to be a source block function +if the source name is present and is followed by a parenthesized +argument list. The parentheses may be empty or contain +whitespace. An example is the following which generates n random +\(uniform) numbers. + +#+source: rand(n) +#+begin_src R + runif(n) +#+end_src") + +(defvar org-babel-function-def-export-indent 4 + "Number of characters to indent a source block on export. +When exporting a source block function, the block contents will +be indented by this many characters. See +`org-babel-function-def-export-name' for the definition of a +source block function.") + +(defun org-babel-exp-src-blocks (body &rest headers) + "Process source block for export. +Depending on the 'export' headers argument in replace the source +code block with... + +both ---- display the code and the results + +code ---- the default, display the code inside the block but do + not process + +results - just like none only the block is run on export ensuring + that it's results are present in the org-mode buffer + +none ----- do not display either code or results upon export" + (interactive) + (message "org-babel-exp processing...") + (save-excursion + (goto-char (match-beginning 0)) + (let* ((info (org-babel-get-src-block-info)) + (params (nth 2 info))) + ;; bail if we couldn't get any info from the block + (when info + ;; 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 (get-file-buffer org-current-export-file)) + (nth 1 info)))) + (org-babel-exp-do-export info 'block)))) + +(defun org-babel-exp-inline-src-blocks (start end) + "Process inline source blocks between START and END for export. +See `org-babel-exp-src-blocks' for export options, currently the +options and are taken from `org-babel-default-inline-header-args'." + (interactive) + (save-excursion + (goto-char start) + (while (and (< (point) end) + (re-search-forward org-babel-inline-src-block-regexp end t)) + (let* ((info (save-match-data (org-babel-parse-inline-src-block-match))) + (params (nth 2 info)) + (replacement + (save-match-data + (if (org-babel-in-example-or-verbatim) + (buffer-substring (match-beginning 0) (match-end 0)) + ;; 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 (get-file-buffer org-current-export-file)) + (nth 1 info))) + (org-babel-exp-do-export info 'inline))))) + (setq end (+ end (- (length replacement) (length (match-string 1))))) + (replace-match replacement t t nil 1))))) + +(defun org-exp-res/src-name-cleanup () + "Clean up #+results and #+srcname lines for export. +This function should only be called after all block processing +has taken place." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (org-re-search-forward-unprotected + (concat + "\\("org-babel-src-name-regexp"\\|"org-babel-result-regexp"\\)") + nil t) + (delete-region + (progn (beginning-of-line) (point)) + (progn (end-of-line) (+ 1 (point))))))) + +(defun org-babel-in-example-or-verbatim () + "Return true if point is in example or verbatim code. +Example and verbatim code include escaped portions of +an org-mode buffer code that should be treated as normal +org-mode text." + (or (org-in-indented-comment-line) + (save-excursion + (save-match-data + (goto-char (point-at-bol)) + (looking-at "[ \t]*:[ \t]"))) + (org-in-regexps-block-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src"))) + +(defun org-babel-exp-lob-one-liners (start end) + "Process Library of Babel calls between START and END for export. +See `org-babel-exp-src-blocks' for export options. Currently the +options are taken from `org-babel-default-header-args'." + (interactive) + (let (replacement) + (save-excursion + (goto-char start) + (while (and (< (point) end) + (re-search-forward org-babel-lob-one-liner-regexp nil t)) + (setq replacement + (let ((lob-info (org-babel-lob-get-info))) + (save-match-data + (org-babel-exp-do-export + (list "emacs-lisp" "results" + (org-babel-merge-params + org-babel-default-header-args + (org-babel-parse-header-arguments + (org-babel-clean-text-properties + (concat ":var results=" + (mapconcat #'identity + (butlast lob-info) " "))))) + (car (last lob-info))) + 'lob)))) + (setq end (+ end (- (length replacement) (length (match-string 0))))) + (replace-match replacement t t))))) + +(defun org-babel-exp-do-export (info type) + "Return a string with the exported content of a code block. +The function respects the value of the :exports header argument." + (flet ((silently () (let ((session (cdr (assoc :session (nth 2 info))))) + (when (and session + (not (equal "none" session)) + (not (assoc :noeval (nth 2 info)))) + (org-babel-exp-results info type 'silent)))) + (clean () (org-babel-remove-result info))) + (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) + ('none (silently) (clean) "") + ('code (silently) (clean) (org-babel-exp-code info type)) + ('results (org-babel-exp-results info type)) + ('both (concat (org-babel-exp-code info type) + "\n\n" + (org-babel-exp-results info type)))))) + +(defvar backend) +(defun org-babel-exp-code (info type) + "Prepare and return code in the current code block for export. +Code is prepared in a manner suitable for exportat by +org-mode. This function is called by `org-babel-exp-do-export'. +The code block is not evaluated." + (let ((lang (nth 0 info)) + (body (nth 1 info)) + (switches (nth 3 info)) + (name (nth 4 info)) + (args (mapcar + #'cdr + (org-remove-if-not (lambda (el) (eq :var (car el))) (nth 2 info))))) + (case type + ('inline (format "=%s=" body)) + ('block + (let ((str + (format "#+BEGIN_SRC %s %s\n%s%s#+END_SRC\n" lang switches body + (if (and body (string-match "\n$" body)) + "" "\n")))) + (when name + (add-text-properties + 0 (length str) + (list 'org-caption + (format "%s(%s)" + name + (mapconcat #'identity args ", "))) + str)) + str)) + ('lob + (let ((call-line (and (string-match "results=" (car args)) + (substring (car args) (match-end 0))))) + (cond + ((eq backend 'html) + (format "\n#+HTML: <label class=\"org-src-name\">%s</label>\n" + call-line)) + ((format ": %s\n" call-line)))))))) + +(defun org-babel-exp-results (info type &optional silent) + "Evaluate and return the results of the current code block for export. +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." + (if org-export-babel-evaluate + (let ((lang (nth 0 info)) + (body (nth 1 info)) + (params + ;; lets ensure that we lookup references in the original file + (mapcar + (lambda (pair) + (if (and org-current-export-file + (eq (car pair) :var) + (string-match org-babel-ref-split-regexp (cdr pair)) + (equal :ob-must-be-reference + (org-babel-ref-literal + (match-string 2 (cdr pair))))) + `(:var . ,(concat (match-string 1 (cdr pair)) + "=" org-current-export-file + ":" (match-string 2 (cdr pair)))) + pair)) + (nth 2 info)))) + ;; skip code blocks which we can't evaluate + (if (fboundp (intern (concat "org-babel-execute:" lang))) + (case type + ('inline + (let ((raw (org-babel-execute-src-block + nil info '((:results . "silent")))) + (result-params (split-string + (cdr (assoc :results params))))) + (unless silent + (cond ;; respect the value of the :results header argument + ((member "file" result-params) + (org-babel-result-to-file raw)) + ((or (member "raw" result-params) + (member "org" result-params)) + (format "%s" raw)) + ((member "code" result-params) + (format "src_%s{%s}" lang raw)) + (t + (if (stringp raw) + (if (= 0 (length raw)) "=(no results)=" + (format "%s" raw)) + (format "%S" raw))))))) + ('block + (org-babel-execute-src-block + nil info (org-babel-merge-params + params + `((:results . ,(if silent "silent" "replace"))))) + "") + ('lob + (save-excursion + (re-search-backward org-babel-lob-one-liner-regexp nil t) + (org-babel-execute-src-block + nil info (org-babel-merge-params + params + `((:results . ,(if silent "silent" "replace"))))) + ""))) + "")) + "")) + +(provide 'ob-exp) + +;; arch-tag: 523abf4c-76d1-44ed-9f27-e3bddf34bf0f + +;;; ob-exp.el ends here diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el new file mode 100644 index 00000000000..40543d720b0 --- /dev/null +++ b/lisp/org/ob-gnuplot.el @@ -0,0 +1,229 @@ +;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating gnuplot source code. +;; +;; This differs from most standard languages in that +;; +;; 1) we are generally only going to return results of type "file" +;; +;; 2) we are adding the "file" and "cmdline" header arguments + +;;; Requirements: + +;; - gnuplot :: http://www.gnuplot.info/ +;; +;; - gnuplot-mode :: http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(eval-when-compile (require 'cl)) + +(declare-function org-time-string-to-time "org" (s)) +(declare-function org-combine-plists "org" (&rest plists)) +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function gnuplot-mode "ext:gnuplot-mode" ()) +(declare-function gnuplot-send-string-to-gnuplot "ext:gnuplot-mode" (str txt)) +(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot-mode" ()) + +(defvar org-babel-default-header-args:gnuplot + '((:results . "file") (:exports . "results") (:session . nil)) + "Default arguments to use when evaluating a gnuplot source block.") + +(defvar org-babel-gnuplot-timestamp-fmt nil) + +(defun org-babel-gnuplot-process-vars (params) + "Extract variables from PARAMS and process the variables. +Dumps all vectors into files and returns an association list +of variable names and the related value to be used in the gnuplot +code." + (mapcar + (lambda (pair) + (cons + (car pair) ;; variable name + (if (listp (cdr pair)) ;; variable value + (org-babel-gnuplot-table-to-data + (cdr pair) (make-temp-file "org-babel-gnuplot") params) + (cdr pair)))) + (org-babel-ref-variables params))) + +(defun org-babel-expand-body:gnuplot (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (save-window-excursion + (let* ((vars (org-babel-gnuplot-process-vars params)) + (out-file (cdr (assoc :file params))) + (term (or (cdr (assoc :term params)) + (when out-file (file-name-extension out-file)))) + (cmdline (cdr (assoc :cmdline params))) + (title (plist-get params :title)) + (lines (plist-get params :line)) + (sets (plist-get params :set)) + (x-labels (plist-get params :xlabels)) + (y-labels (plist-get params :ylabels)) + (timefmt (plist-get params :timefmt)) + (time-ind (or (plist-get params :timeind) + (when timefmt 1))) + output) + (flet ((add-to-body (text) + (setq body (concat text "\n" body)))) + ;; append header argument settings to body + (when title (add-to-body (format "set title '%s'" title))) ;; title + (when lines (mapc (lambda (el) (add-to-body el)) lines)) ;; line + (when sets + (mapc (lambda (el) (add-to-body (format "set %s" el))) sets)) + (when x-labels + (add-to-body + (format "set xtics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + x-labels ", ")))) + (when y-labels + (add-to-body + (format "set ytics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + y-labels ", ")))) + (when time-ind + (add-to-body "set xdata time") + (add-to-body (concat "set timefmt \"" + (or timefmt + "%Y-%m-%d-%H:%M:%S") "\""))) + (when out-file (add-to-body (format "set output \"%s\"" out-file))) + (when term (add-to-body (format "set term %s" term))) + ;; insert variables into code body: this should happen last + ;; placing the variables at the *top* of the code in case their + ;; values are used later + (add-to-body (mapconcat + (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) + vars "\n")) + ;; replace any variable names preceded by '$' with the actual + ;; value of the variable + (mapc (lambda (pair) + (setq body (replace-regexp-in-string + (format "\\$%s" (car pair)) (cdr pair) body))) + vars)) + body))) + +(defun org-babel-execute:gnuplot (body params) + "Execute a block of Gnuplot code. +This function is called by `org-babel-execute-src-block'." + (require 'gnuplot) + (let ((session (cdr (assoc :session params))) + (result-type (cdr (assoc :results params))) + (out-file (cdr (assoc :file params))) + (body (org-babel-expand-body:gnuplot body params)) + output) + (save-window-excursion + ;; evaluate the code body with gnuplot + (if (string= session "none") + (let ((script-file (make-temp-file "org-babel-gnuplot-script"))) + (with-temp-file script-file + (insert (concat body "\n"))) + (message "gnuplot \"%s\"" script-file) + (setq output + (shell-command-to-string (format "gnuplot \"%s\"" script-file))) + (message output)) + (with-temp-buffer + (insert (concat body "\n")) + (gnuplot-mode) + (gnuplot-send-buffer-to-gnuplot))) + (if (member "output" (split-string result-type)) + output + out-file)))) + +(defun org-babel-prep-session:gnuplot (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (let* ((session (org-babel-gnuplot-initiate-session session)) + (vars (org-babel-ref-variables params)) + (var-lines (mapcar + (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) + vars))) + (message "%S" session) + (org-babel-comint-in-buffer session + (mapc (lambda (var-line) + (insert var-line) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines)) + session)) + +(defun org-babel-load-session:gnuplot (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:gnuplot session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +(defvar gnuplot-buffer) +(defun org-babel-gnuplot-initiate-session (&optional session params) + "Initiate a gnuplot session. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session. The current +`gnuplot-mode' doesn't provide support for multiple sessions." + (require 'gnuplot) + (unless (string= session "none") + (save-window-excursion + (gnuplot-send-string-to-gnuplot "" "line") + gnuplot-buffer))) + +(defun org-babel-gnuplot-quote-timestamp-field (s) + "Convert S from timestamp to Unix time and export to gnuplot." + (format-time-string org-babel-gnuplot-timestamp-fmt (org-time-string-to-time s))) + +(defvar org-table-number-regexp) +(defvar org-ts-regexp3) +(defun org-babel-gnuplot-quote-tsv-field (s) + "Quote S for export to gnuplot." + (unless (stringp s) + (setq s (format "%s" s))) + (if (string-match org-table-number-regexp s) s + (if (string-match org-ts-regexp3 s) + (org-babel-gnuplot-quote-timestamp-field s) + (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")))) + +(defun org-babel-gnuplot-table-to-data (table data-file params) + "Export TABLE to DATA-FILE in a format readable by gnuplot. +Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." + (with-temp-file data-file + (make-local-variable 'org-babel-gnuplot-timestamp-fmt) + (setq org-babel-gnuplot-timestamp-fmt (or + (plist-get params :timefmt) + "%Y-%m-%d-%H:%M:%S")) + (insert (orgtbl-to-generic + table + (org-combine-plists + '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field) + params)))) + data-file) + +(provide 'ob-gnuplot) + +;; arch-tag: 50490ace-a9e1-4b29-a6e5-0db9f16c610b + +;;; ob-gnuplot.el ends here diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el new file mode 100644 index 00000000000..e0803347a64 --- /dev/null +++ b/lisp/org/ob-haskell.el @@ -0,0 +1,230 @@ +;;; ob-haskell.el --- org-babel functions for haskell evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating haskell source code. This one will +;; be sort of tricky because haskell programs must be compiled before +;; they can be run, but haskell code can also be run through an +;; interactive interpreter. +;; +;; For now lets only allow evaluation using the haskell interpreter. + +;;; Requirements: + +;; - haskell-mode :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode +;; +;; - inf-haskell :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode +;; +;; - (optionally) lhs2tex :: http://people.cs.uu.nl/andres/lhs2tex/ + +;;; Code: +(require 'ob) +(require 'ob-comint) +(require 'comint) +(eval-when-compile (require 'cl)) + +(declare-function org-remove-indentation "org" (code &optional n)) +(declare-function haskell-mode "ext:haskell-mode" ()) +(declare-function run-haskell "ext:inf-haskell" (&optional arg)) +(declare-function inferior-haskell-load-file + "ext:inf-haskell" (&optional reload)) + +(add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs")) + +(defvar org-babel-default-header-args:haskell '()) + +(defvar org-babel-haskell-lhs2tex-command "lhs2tex") + +(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"") + +(defun org-babel-expand-body:haskell (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) + (concat + (mapconcat + (lambda (pair) (format "let %s = %s" + (car pair) + (org-babel-haskell-var-to-haskell (cdr pair)))) + vars "\n") "\n" body "\n"))) + +(defun org-babel-execute:haskell (body params) + "Execute a block of Haskell code." + (let* ((processed-params (org-babel-process-params params)) + (session (nth 0 processed-params)) + (vars (nth 1 processed-params)) + (result-type (nth 3 processed-params)) + (full-body (org-babel-expand-body:haskell body params processed-params)) + (session (org-babel-haskell-initiate-session session params)) + (raw (org-babel-comint-with-output + (session org-babel-haskell-eoe t full-body) + (insert (org-babel-trim full-body)) + (comint-send-input nil t) + (insert org-babel-haskell-eoe) + (comint-send-input nil t))) + (results (mapcar + #'org-babel-haskell-read-string + (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)))) + (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))) + +(defun org-babel-haskell-read-string (string) + "Strip \\\"s from around a haskell string." + (if (string-match "^\"\\([^\000]+\\)\"$" string) + (match-string 1 string) + string)) + +(defun org-babel-haskell-initiate-session (&optional session params) + "Initiate a haskell session. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session." + (require 'inf-haskell) + (or (get-buffer "*haskell*") + (save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer)))) + +(defun org-babel-load-session:haskell + (session body params &optional processed-params) + "Load BODY into SESSION." + (save-window-excursion + (let* ((buffer (org-babel-prep-session:haskell + session params processed-params)) + (load-file (concat (make-temp-file "org-babel-haskell-load") ".hs"))) + (with-temp-buffer + (insert body) (write-file load-file) + (haskell-mode) (inferior-haskell-load-file)) + buffer))) + +(defun org-babel-prep-session:haskell + (session params &optional processed-params) + "Prepare SESSION according to the header arguments in PARAMS." + (save-window-excursion + (let ((pp (or processed-params (org-babel-process-params params))) + (buffer (org-babel-haskell-initiate-session session))) + (org-babel-comint-in-buffer buffer + (mapc + (lambda (pair) + (insert (format "let %s = %s" + (car pair) + (org-babel-haskell-var-to-haskell (cdr pair)))) + (comint-send-input nil t)) + (nth 1 pp))) + (current-buffer)))) + +(defun org-babel-haskell-table-or-string (results) + "Convert RESULTS to an Emacs-lisp table or string. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + "," " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(defun org-babel-haskell-var-to-haskell (var) + "Convert an elisp value VAR into a haskell variable. +The elisp VAR is converted to a string of haskell source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]") + (format "%S" var))) + +(defvar org-src-preserve-indentation) +(defun org-babel-haskell-export-to-lhs (&optional arg) + "Export to a .lhs file with all haskell code blocks escaped. +When called with a prefix argument the resulting +.lhs file will be exported to a .tex file. This function will +create two new files, base-name.lhs and base-name.tex where +base-name is the name of the current org-mode file. + +Note that all standard Babel literate programming +constructs (header arguments, no-web syntax etc...) are ignored." + (interactive "P") + (let* ((contents (buffer-string)) + (haskell-regexp + (concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)?[\r\n]" + "\\([^\000]*?\\)[\r\n][ \t]*#\\+end_src.*")) + (base-name (file-name-sans-extension (buffer-file-name))) + (tmp-file (make-temp-file "ob-haskell")) + (tmp-org-file (concat tmp-file ".org")) + (tmp-tex-file (concat tmp-file ".tex")) + (lhs-file (concat base-name ".lhs")) + (tex-file (concat base-name ".tex")) + (command (concat org-babel-haskell-lhs2tex-command " " lhs-file " > " tex-file)) + (preserve-indentp org-src-preserve-indentation) + indentation) + ;; escape haskell source-code blocks + (with-temp-file tmp-org-file + (insert contents) + (goto-char (point-min)) + (while (re-search-forward haskell-regexp nil t) + (save-match-data (setq indentation (length (match-string 1)))) + (replace-match (save-match-data + (concat + "#+begin_latex\n\\begin{code}\n" + (if (or preserve-indentp + (string-match "-i" (match-string 2))) + (match-string 3) + (org-remove-indentation (match-string 3))) + "\n\\end{code}\n#+end_latex\n")) + t t) + (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) + (kill-buffer) + (delete-file tmp-org-file) + (find-file tmp-tex-file) + (goto-char (point-min)) (forward-line 2) + (insert "%include polycode.fmt\n") + ;; ensure all \begin/end{code} statements start at the first column + (while (re-search-forward "^[ \t]+\\\\begin{code}[^\000]+\\\\end{code}" nil t) + (replace-match (save-match-data (org-remove-indentation (match-string 0))) + t t)) + (setq contents (buffer-string)) + (save-buffer) (kill-buffer)) + (delete-file tmp-tex-file) + ;; save org exported latex to a .lhs file + (with-temp-file lhs-file (insert contents)) + (if (not arg) + (find-file lhs-file) + ;; process .lhs file with lhs2tex + (message "running %s" command) (shell-command command) (find-file tex-file)))) + +(provide 'ob-haskell) + +;; arch-tag: b53f75f3-ba1a-4b05-82d9-a2a0d4e70804 + +;;; ob-haskell.el ends here diff --git a/lisp/org/ob-keys.el b/lisp/org/ob-keys.el new file mode 100644 index 00000000000..3f8e83b4f91 --- /dev/null +++ b/lisp/org/ob-keys.el @@ -0,0 +1,89 @@ +;;; ob-keys.el --- key bindings for org-babel + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Add org-babel keybindings to the org-mode keymap for exposing +;; org-babel functions. These will all share a common prefix. See +;; the value of `org-babel-key-bindings' for a list of interactive +;; functions and their associated keys. + +;;; Code: +(require 'ob) + +(defvar org-babel-key-prefix "\C-c\C-v" + "The key prefix for Babel interactive key-bindings. +See `org-babel-key-bindings' for the list of interactive babel +functions which are assigned key bindings, and see +`org-babel-map' for the actual babel keymap.") + +(defvar org-babel-map (make-sparse-keymap) + "The keymap for interactive Babel functions.") + +;;;###autoload +(defun org-babel-describe-bindings () + "Describe all keybindings behind `org-babel-key-prefix'." + (interactive) + (describe-bindings org-babel-key-prefix)) + +(defvar org-babel-key-bindings + '(("p" . org-babel-previous-src-block) + ("\C-p" . org-babel-previous-src-block) + ("n" . org-babel-next-src-block) + ("\C-n" . org-babel-next-src-block) + ("e" . org-babel-execute-src-block) + ("\C-e" . org-babel-execute-src-block) + ("o" . org-babel-open-src-block-result) + ("\C-o" . org-babel-open-src-block-result) + ("\C-v" . org-babel-expand-src-block) + ("v" . org-babel-expand-src-block) + ("g" . org-babel-goto-named-src-block) + ("r" . org-babel-goto-named-result) + ("\C-r" . org-babel-goto-named-result) + ("\C-b" . org-babel-execute-buffer) + ("b" . org-babel-execute-buffer) + ("\C-s" . org-babel-execute-subtree) + ("s" . org-babel-execute-subtree) + ("\C-t" . org-babel-tangle) + ("t" . org-babel-tangle) + ("\C-f" . org-babel-tangle-file) + ("f" . org-babel-tangle-file) + ("\C-l" . org-babel-lob-ingest) + ("l" . org-babel-lob-ingest) + ("\C-z" . org-babel-switch-to-session) + ("z" . org-babel-switch-to-session) + ("\C-a" . org-babel-sha1-hash) + ("a" . org-babel-sha1-hash) + ("h" . org-babel-describe-bindings)) + "Alist of key bindings and interactive Babel functions. +This list associates interactive Babel functions +with keys. Each element of this list will add an entry to the +`org-babel-map' using the letter key which is the `car' of the +a-list placed behind the generic `org-babel-key-prefix'.") + +(provide 'ob-keys) + +;; arch-tag: 01e348ee-4906-46fa-839a-6b7b6f989048 + +;;; ob-keys.el ends here diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el new file mode 100644 index 00000000000..e5b01463a51 --- /dev/null +++ b/lisp/org/ob-latex.el @@ -0,0 +1,158 @@ +;;; ob-latex.el --- org-babel functions for latex "evaluation" + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating LaTeX source code. +;; +;; Currently on evaluation this returns raw LaTeX code, unless a :file +;; header argument is given in which case small png or pdf files will +;; be created directly form the latex source code. + +;;; Code: +(require 'ob) + +(declare-function org-create-formula-image "org" (string tofile options buffer)) +(declare-function org-splice-latex-header "org" + (tpl def-pkg pkg snippets-p &optional extra)) +(declare-function org-export-latex-fix-inputenc "org-latex" ()) + +(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) + +(defvar org-babel-default-header-args:latex + '((:results . "latex") (:exports . "results")) + "Default arguments to use when evaluating a LaTeX source block.") + +(defun org-babel-expand-body:latex (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (mapc (lambda (pair) ;; replace variables + (setq body + (replace-regexp-in-string + (regexp-quote (format "%S" (car pair))) + (if (stringp (cdr pair)) + (cdr pair) (format "%S" (cdr pair))) + body))) (nth 1 (org-babel-process-params params))) + body) + +(defvar org-format-latex-options) +(defvar org-export-latex-packages-alist) +(defun org-babel-execute:latex (body params) + "Execute a block of Latex code with Babel. +This function is called by `org-babel-execute-src-block'." + (setq body (org-babel-expand-body:latex body params)) + (if (cdr (assoc :file params)) + (let ((out-file (cdr (assoc :file params))) + (tex-file (make-temp-file "org-babel-latex" nil ".tex")) + (pdfheight (cdr (assoc :pdfheight params))) + (pdfwidth (cdr (assoc :pdfwidth 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))) + (cond + ((string-match "\\.png$" out-file) + (org-create-formula-image + body out-file org-format-latex-options in-buffer)) + ((string-match "\\.pdf$" out-file) + (org-babel-latex-body-to-tex-file tex-file body pdfheight pdfwidth) + (when (file-exists-p out-file) (delete-file out-file)) + (rename-file (org-babel-latex-tex-to-pdf tex-file) out-file)) + ((string-match "\\.\\([^\\.]+\\)$" out-file) + (error "can not create %s files, please specify a .png or .pdf file" + (match-string 1 out-file)))) + out-file) + body)) + +(defvar org-format-latex-header) +(defvar org-format-latex-header-extra) +(defvar org-export-latex-packages-alist) +(defvar org-export-latex-default-packages-alist) +(defun org-babel-latex-body-to-tex-file (tex-file body &optional height width) + "Place the contents of BODY into TEX-FILE. +Extracted from `org-create-formula-image' in org.el." + (with-temp-file tex-file + (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) + (if height (concat "\n" (format "\\pdfpageheight %s" height)) "") + (if width (concat "\n" (format "\\pdfpagewidth %s" width)) "") + (if org-format-latex-header-extra + (concat "\n" org-format-latex-header-extra) + "") + "\n\\begin{document}\n" body "\n\\end{document}\n") + (org-export-latex-fix-inputenc))) + +(defvar org-export-pdf-logfiles) +(defvar org-latex-to-pdf-process) +(defvar org-export-pdf-remove-logfiles) +(defun org-babel-latex-tex-to-pdf (tex-file) + "Generate a pdf file according to the contents TEX-FILE. +Extracted from `org-export-as-pdf' in org-latex.el." + (let* ((wconfig (current-window-configuration)) + (default-directory (file-name-directory tex-file)) + (base (file-name-sans-extension tex-file)) + (pdffile (concat base ".pdf")) + (cmds org-latex-to-pdf-process) + (outbuf (get-buffer-create "*Org PDF LaTeX Output*")) + cmd) + (if (and cmds (symbolp cmds)) + (funcall cmds tex-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 "%s" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument tex-file)) + t t cmd))) + (shell-command cmd outbuf outbuf))) + (if (not (file-exists-p pdffile)) + (error "PDF file was not produced from %s" tex-file) + (set-window-configuration wconfig) + (when org-export-pdf-remove-logfiles + (dolist (ext org-export-pdf-logfiles) + (setq tex-file (concat base "." ext)) + (and (file-exists-p tex-file) (delete-file tex-file)))) + pdffile))) + +(defun org-babel-prep-session:latex (session params) + "Return an error because LaTeX doesn't support sesstions." + (error "LaTeX does not support sessions")) + +(provide 'ob-latex) + +;; arch-tag: 1f13f7e2-26de-4c24-9274-9f331d4c6ff3 + +;;; ob-latex.el ends here diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el new file mode 100644 index 00000000000..f806668e2e8 --- /dev/null +++ b/lisp/org/ob-lob.el @@ -0,0 +1,116 @@ +;;; ob-lob.el --- functions supporting the Library of Babel + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; See the online documentation for more information +;; +;; http://orgmode.org/worg/org-contrib/babel/ + +;;; Code: +(require 'ob) +(require 'ob-table) + +(defvar org-babel-library-of-babel nil + "Library of source-code blocks. +This is an association list. Populate the library by adding +files to `org-babel-lob-files'.") + +(defcustom org-babel-lob-files '() + "Files used to populate the `org-babel-library-of-babel'. +To add files to this list use the `org-babel-lob-ingest' command." + :group 'org-babel + :type 'list) + +;;;###autoload +(defun org-babel-lob-ingest (&optional file) + "Add all source-blocks defined in FILE to `org-babel-library-of-babel'." + (interactive "f") + (org-babel-map-src-blocks file + (let* ((info (org-babel-get-src-block-info)) + (source-name (intern (nth 4 info)))) + (when source-name + (setq org-babel-library-of-babel + (cons (cons source-name info) + (assq-delete-all source-name org-babel-library-of-babel))))))) + +(defconst org-babel-lob-call-aliases '("lob" "call") + "Aliases to call a source block function. +If you change the value of this variable then your files may + become unusable by other org-babel users, and vice versa.") + +(defconst org-babel-lob-one-liner-regexp + (concat "^\\([ \t]*\\)#\\+\\(?:" + (mapconcat #'regexp-quote org-babel-lob-call-aliases "\\|") + "\\):[ \t]+\\([^\(\)\n]+\\)\(\\([^\n]*\\)\)[ \t]*\\([^\n]*\\)") + "Regexp to match calls to predefined source block functions.") + +;; functions for executing lob one-liners +;;;###autoload +(defun org-babel-lob-execute-maybe () + "Execute a Library of Babel source block, if appropriate. +Detect if this is context for a Library Of Babel source block and +if so then run the appropriate source block from the Library." + (interactive) + (let ((info (org-babel-lob-get-info))) + (if (nth 0 info) (progn (org-babel-lob-execute info) t) nil))) + +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-lob-execute-maybe) + +;;;###autoload +(defun org-babel-lob-get-info () + "Return a Library of Babel function call as a string. + +This function is analogous to org-babel-get-src-block-name. For +both functions, after they are called, (match-string 1) matches +the function name, and (match-string 2) matches the function +arguments inside the parentheses. I think perhaps these functions +should be renamed to bring out this similarity, perhaps involving +the word 'call'." + (let ((case-fold-search t)) + (save-excursion + (beginning-of-line 1) + (if (looking-at org-babel-lob-one-liner-regexp) + (append (mapcar #'org-babel-clean-text-properties + (list (format "%s(%s)" (match-string 2) (match-string 3)) + (match-string 4))) + (list (length (match-string 1)))))))) + +(defun org-babel-lob-execute (info) + "Execute the lob call specified by INFO." + (let ((params (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties) + (org-babel-parse-header-arguments + (org-babel-clean-text-properties + (concat ":var results=" (mapconcat #'identity (butlast info) " "))))))) + (org-babel-execute-src-block + nil (list "emacs-lisp" "results" params nil nil (nth 2 info))))) + +(provide 'ob-lob) + +;; arch-tag: ce0712c9-2147-4019-ba3f-42341b8b474b + +;;; ob-lob.el ends here diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el new file mode 100644 index 00000000000..0728edf49dc --- /dev/null +++ b/lisp/org/ob-matlab.el @@ -0,0 +1,48 @@ +;;; ob-matlab.el --- org-babel support for matlab evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Functions that are common to org-babel support for matlab and +;; octave are in org-babel-octave.el + +;;; Requirements: + +;; Matlab + +;; matlab.el required for interactive emacs sessions and matlab-mode +;; major mode for source code editing buffer +;; http://matlab-emacs.sourceforge.net/ + +;;; Code: +(require 'ob) +(require 'ob-octave) + +;; see ob-octave for matlab implementation + +(provide 'ob-matlab) + +;; arch-tag: 6b234299-c1f7-4eb1-ace8-7b93344065ac + +;;; ob-matlab.el ends here diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el new file mode 100644 index 00000000000..a78e0b6bd68 --- /dev/null +++ b/lisp/org/ob-mscgen.el @@ -0,0 +1,89 @@ +;;; ob-msc.el --- org-babel functions for mscgen evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Juan Pechiar +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This software provides EMACS org-babel export support for message +;; sequence charts. The mscgen utility is used for processing the +;; sequence definition, and must therefore be installed in the system. +;; +;; Mscgen is available and documented at +;; http://www.mcternan.me.uk/mscgen/index.html +;; +;; This code is directly inspired by Eric Schulte's ob-dot.el +;; +;; Example: +;; +;; #+begin_src mscgen :file example.png +;; msc { +;; A,B; +;; A -> B [ label = "send message" ]; +;; A <- B [ label = "get answer" ]; +;; } +;; #+end_src +;; +;; Header for alternative file type: +;; +;; #+begin_src mscgen :file ex2.svg :filetype svg + +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in mscgen +;; 2) we are generally only going to return results of type "file" +;; 3) we are adding the "file" and "filetype" header arguments +;; 4) there are no variables + +;;; Code: +(require 'ob) +(require 'ob-eval) + +(defvar org-babel-default-header-args:mscgen + '((:results . "file") (:exports . "results")) + "Default arguments to use when evaluating a mscgen source block.") + +(defun org-babel-expand-body:mscgen (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defun org-babel-execute:mscgen (body params) + "Execute a block of Mscgen code with Babel. +This function is called by `org-babel-execute-src-block'. +Default filetype is png. Modify by setting :filetype parameter to +mscgen supported formats." + (let* ((out-file (or (cdr (assoc :file params)) "output.png" )) + (filetype (or (cdr (assoc :filetype params)) "png" ))) + (unless (cdr (assoc :file params)) + (error " +ERROR: no output file specified. Add \":file name.png\" to the src header")) + (org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body) + out-file)) + +(defun org-babel-prep-session:mscgen (session params) + "Raise an error because Mscgen doesn't support sessions." + (error "Mscgen does not support sessions")) + +(provide 'ob-mscgen) + +;; arch-tag: 74695b1e-715f-4b5a-a3a9-d78ee39ba5c8 + +;;; ob-msc.el ends here diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el new file mode 100644 index 00000000000..f5add5c5754 --- /dev/null +++ b/lisp/org/ob-ocaml.el @@ -0,0 +1,158 @@ +;;; ob-ocaml.el --- org-babel functions for ocaml evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating ocaml source code. This one will +;; be sort of tricky because ocaml programs must be compiled before +;; they can be run, but ocaml code can also be run through an +;; interactive interpreter. +;; +;; For now lets only allow evaluation using the ocaml interpreter. + +;;; Requirements: + +;; - tuareg-mode :: http://www-rocq.inria.fr/~acohen/tuareg/ + +;;; Code: +(require 'ob) +(require 'ob-comint) +(require 'comint) +(eval-when-compile (require 'cl)) + +(declare-function tuareg-run-caml "ext:tuareg" ()) +(declare-function tuareg-interactive-send-input "ext:tuareg" ()) + +(add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml")) + +(defvar org-babel-default-header-args:ocaml '()) + +(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;") +(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe") + +(defun org-babel-expand-body:ocaml (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) + (concat + (mapconcat + (lambda (pair) (format "let %s = %s;;" (car pair) + (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) + vars "\n") "\n" body "\n"))) + +(defun org-babel-execute:ocaml (body params) + "Execute a block of Ocaml code with Babel." + (let* ((processed-params (org-babel-process-params params)) + (vars (nth 1 processed-params)) + (full-body (org-babel-expand-body:ocaml body params processed-params)) + (session (org-babel-prep-session:ocaml + (cdr (assoc :session params)) params)) + (raw (org-babel-comint-with-output + (session org-babel-ocaml-eoe-output t full-body) + (insert + (concat + (org-babel-chomp full-body)"\n"org-babel-ocaml-eoe-indicator)) + (tuareg-interactive-send-input))) + (clean + (car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out) + (delq nil (mapcar (lambda (line) + (if out + (progn (setq out nil) line) + (when (string-match re line) + (progn (setq out t) nil)))) + (mapcar #'org-babel-trim (reverse raw)))))))) + (org-babel-reassemble-table + (org-babel-ocaml-parse-output (org-babel-trim clean)) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params)))))) + +(defvar tuareg-interactive-buffer-name) +(defun org-babel-prep-session:ocaml (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (require 'tuareg) + (let ((tuareg-interactive-buffer-name (if (and (not (string= session "none")) + (not (string= session "default")) + (stringp session)) + session + tuareg-interactive-buffer-name))) + (save-window-excursion (tuareg-run-caml) + (get-buffer tuareg-interactive-buffer-name)))) + +(defun org-babel-ocaml-elisp-to-ocaml (val) + "Return a string of ocaml code which evaluates to VAL." + (if (listp val) + (concat "[|" (mapconcat #'org-babel-ocaml-elisp-to-ocaml val "; ") "|]") + (format "%S" val))) + +(defun org-babel-ocaml-parse-output (output) + "Parse OUTPUT. +OUTPUT is string output from an ocaml process." + (let ((regexp "%s = \\(.+\\)$")) + (cond + ((string-match (format regexp "string") output) + (org-babel-read (match-string 1 output))) + ((or (string-match (format regexp "int") output) + (string-match (format regexp "float") output)) + (string-to-number (match-string 1 output))) + ((string-match (format regexp "list") output) + (org-babel-ocaml-read-list (match-string 1 output))) + ((string-match (format regexp "array") output) + (org-babel-ocaml-read-array (match-string 1 output))) + (t (message "don't recognize type of %s" output) output)))) + +(defun org-babel-ocaml-read-list (results) + "Convert RESULTS into an elisp table or string. +If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + "; " " " (replace-regexp-in-string + "'" "\"" results))))) + results))) + +(defun org-babel-ocaml-read-array (results) + "Convert RESULTS into an elisp table or string. +If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (concat + "'" (replace-regexp-in-string + "\\[|" "(" (replace-regexp-in-string + "|\\]" ")" (replace-regexp-in-string + "; " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(provide 'ob-ocaml) + +;; arch-tag: 2e815f4d-365e-4d69-b1df-dd17fdd7b7b7 + +;;; ob-ocaml.el ends here diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el new file mode 100644 index 00000000000..2cdbaa0468c --- /dev/null +++ b/lisp/org/ob-octave.el @@ -0,0 +1,266 @@ +;;; ob-octave.el --- org-babel functions for octave and matlab evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Requirements: + +;; octave +;; octave-mode.el and octave-inf.el come with GNU emacs + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function matlab-shell "ext:matlab-mode") +(declare-function matlab-shell-run-region "ext:matlab-mode") + +(defvar org-babel-default-header-args:matlab '()) +(defvar org-babel-default-header-args:octave '()) + +(defvar org-babel-matlab-shell-command "matlab -nosplash" + "Shell command to run matlab as an external process.") +(defvar org-babel-octave-shell-command "octave -q" + "Shell command to run octave as an external process.") + +(defun org-babel-expand-body:matlab (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (org-babel-expand-body:octave body params processed-params)) +(defun org-babel-expand-body:octave (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) + (concat + (mapconcat + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-octave-var-to-octave (cdr pair)))) + vars "\n") "\n" body "\n"))) + +(defvar org-babel-matlab-with-emacs-link nil + "If non-nil use matlab-shell-run-region for session evaluation. + This will use EmacsLink if (matlab-with-emacs-link) evaluates + to a non-nil value.") + +(defvar org-babel-matlab-emacs-link-wrapper-method + "%s +if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); +else, save -ascii %s ans +end +delete('%s') +") +(defvar org-babel-octave-wrapper-method + "%s +if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); +else, save -ascii %s ans +end") + +(defvar org-babel-octave-eoe-indicator "\'org_babel_eoe\'") + +(defvar org-babel-octave-eoe-output "ans = org_babel_eoe") + +(defun org-babel-execute:matlab (body params) + "Execute a block of matlab code with Babel." + (require 'matlab) + (org-babel-execute:octave body params 'matlab)) +(defun org-babel-execute:octave (body params &optional matlabp) + "Execute a block of octave code with Babel." + (let* ((processed-params (org-babel-process-params params)) + (session + (funcall (intern (format "org-babel-%s-initiate-session" + (if matlabp "matlab" "octave"))) + (nth 0 processed-params) params)) + (vars (nth 1 processed-params)) + (result-params (nth 2 processed-params)) + (result-type (nth 3 processed-params)) + (out-file (cdr (assoc :file params))) + (augmented-body + (org-babel-expand-body:octave body params processed-params)) + (result (org-babel-octave-evaluate + session augmented-body result-type matlabp))) + (or out-file + (org-babel-reassemble-table + result + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params))))))) + +(defun org-babel-prep-session:matlab (session params) + "Prepare SESSION according to PARAMS." + (require 'matlab) + (org-babel-prep-session:octave session params 'matlab)) +(defun org-babel-octave-var-to-octave (var) + "Convert an emacs-lisp value into an octave variable. +Converts an emacs-lisp variable into a string of octave code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-octave-var-to-octave var ", ") "]") + (format "%S" var))) + +(defun org-babel-prep-session:octave (session params &optional matlabp) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-octave-initiate-session session params matlabp)) + (vars (org-babel-ref-variables params)) + (var-lines (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-octave-var-to-octave (cdr pair)))) + vars))) + (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-matlab-initiate-session (&optional session params) + "Create a matlab inferior process buffer. +If there is not a current inferior-process-buffer in SESSION then +create. Return the initialized session." + (require 'matlab) + (org-babel-octave-initiate-session session params 'matlab)) +(defun org-babel-octave-initiate-session (&optional session params matlabp) + "Create an octave inferior process buffer. +If there is not a current inferior-process-buffer in SESSION then +create. Return the initialized session." + (require 'octave-inf) + (unless (string= session "none") + (let ((session (or session + (if matlabp "*Inferior Matlab*" "*Inferior Octave*")))) + (if (org-babel-comint-buffer-livep session) session + (save-window-excursion + (if matlabp (unless org-babel-matlab-with-emacs-link (matlab-shell)) + (run-octave)) + (rename-buffer (if (bufferp session) (buffer-name session) + (if (stringp session) session (buffer-name)))) + (current-buffer)))))) + +(defun org-babel-octave-evaluate + (session body result-type lang &optional matlabp) + "Pass BODY to the octave process in SESSION. +If RESULT-TYPE equals 'output then return the outputs of the +statements in BODY, if RESULT-TYPE equals 'value then return the +value of the last statement in BODY, as elisp." + (if session + (org-babel-octave-evaluate-session session body result-type matlabp) + (org-babel-octave-evaluate-external-process body result-type matlabp))) + +(defun org-babel-octave-evaluate-external-process (body result-type matlabp) + "Evaluate BODY in an external octave process." + (let ((cmd (if matlabp + org-babel-matlab-shell-command + org-babel-octave-shell-command))) + (case result-type + (output (org-babel-eval cmd body)) + (value (let ((tmp-file (make-temp-file "org-babel-results-"))) + (org-babel-eval + cmd + (format org-babel-octave-wrapper-method body tmp-file tmp-file)) + (org-babel-eval-read-file tmp-file)))))) + +(defun org-babel-octave-evaluate-session + (session body result-type &optional matlabp) + "Evaluate BODY in SESSION." + (let* ((tmp-file (make-temp-file "org-babel-results-")) + (wait-file (make-temp-file "org-babel-matlab-emacs-link-wait-signal-")) + (full-body + (case result-type + (output + (mapconcat + #'org-babel-chomp + (list body org-babel-octave-eoe-indicator) "\n")) + (value + (if (and matlabp org-babel-matlab-with-emacs-link) + (concat + (format org-babel-matlab-emacs-link-wrapper-method + body tmp-file tmp-file wait-file) "\n") + (mapconcat + #'org-babel-chomp + (list (format org-babel-octave-wrapper-method + body tmp-file tmp-file) + org-babel-octave-eoe-indicator) "\n"))))) + (raw (if (and matlabp org-babel-matlab-with-emacs-link) + (save-window-excursion + (with-temp-buffer + (insert full-body) + (write-region "" 'ignored wait-file nil nil nil 'excl) + (matlab-shell-run-region (point-min) (point-max)) + (message "Waiting for Matlab Emacs Link") + (while (file-exists-p wait-file) (sit-for 0.01)) + "")) ;; matlab-shell-run-region doesn't seem to + ;; make *matlab* buffer contents easily + ;; available, so :results output currently + ;; won't work + (org-babel-comint-with-output + (session + (if matlabp + org-babel-octave-eoe-indicator + org-babel-octave-eoe-output) + t full-body) + (insert full-body) (comint-send-input nil t)))) results) + (case result-type + (value + (org-babel-octave-import-elisp-from-file + (org-babel-maybe-remote-file tmp-file))) + (output + (progn + (setq results + (if matlabp + (cdr (reverse (delq "" (mapcar + #'org-babel-octave-read-string + (mapcar #'org-babel-trim raw))))) + (cdr (member org-babel-octave-eoe-output + (reverse (mapcar + #'org-babel-octave-read-string + (mapcar #'org-babel-trim raw))))))) + (mapconcat #'identity (reverse results) "\n")))))) + +(defun org-babel-octave-import-elisp-from-file (file-name) + "Import data from FILE-NAME. +This removes initial blank and comment lines and then calls +`org-babel-import-elisp-from-file'." + (let ((temp-file (make-temp-file "org-babel-results-")) beg end) + (with-temp-file temp-file + (insert-file-contents file-name) + (re-search-forward "^[ \t]*[^# \t]" nil t) + (if (< (setq beg (point-min)) + (setq end (point-at-bol))) + (delete-region beg end))) + (org-babel-import-elisp-from-file temp-file))) + +(defun org-babel-octave-read-string (string) + "Strip \\\"s from around octave string" + (if (string-match "^\"\\([^\000]+\\)\"$" string) + (match-string 1 string) + string)) + +(provide 'ob-octave) + +;; arch-tag: d8e5f68b-ba13-440a-a495-b653e989e704 + +;;; ob-octave.el ends here diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el new file mode 100644 index 00000000000..bfba158d4a8 --- /dev/null +++ b/lisp/org/ob-perl.el @@ -0,0 +1,120 @@ +;;; ob-perl.el --- org-babel functions for perl evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation + +;; Author: Dan Davison, Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating perl source code. + +;;; Code: +(require 'ob) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl")) + +(defvar org-babel-default-header-args:perl '()) + +(defvar org-babel-perl-command "perl" + "Name of command to use for executing perl code.") + +(defun org-babel-expand-body:perl (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) + (concat + (mapconcat ;; define any variables + (lambda (pair) + (format "$%s=%s;" + (car pair) + (org-babel-perl-var-to-perl (cdr pair)))) + vars "\n") "\n" (org-babel-trim body) "\n"))) + +(defun org-babel-execute:perl (body params) + "Execute a block of Perl code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((processed-params (org-babel-process-params params)) + (session (nth 0 processed-params)) + (vars (nth 1 processed-params)) + (result-params (nth 2 processed-params)) + (result-type (nth 3 processed-params)) + (full-body (org-babel-expand-body:perl + body params processed-params)) + (session (org-babel-perl-initiate-session session))) + (org-babel-reassemble-table + (org-babel-perl-evaluate session full-body result-type) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params)))))) + +(defun org-babel-prep-session:perl (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (error "Sessions are not supported for Perl.")) + +;; helper functions + +(defun org-babel-perl-var-to-perl (var) + "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))) + +(defvar org-babel-perl-buffers '(:default . nil)) + +(defun org-babel-perl-initiate-session (&optional session params) + "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-pp-wrapper-method + nil) + +(defun org-babel-perl-evaluate (session body &optional result-type) + "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 (make-temp-file "org-babel-perl-results-"))) + (org-babel-eval + org-babel-perl-command + (format org-babel-perl-wrapper-method body tmp-file)) + (org-babel-eval-read-file tmp-file))))) + +(provide 'ob-perl) + +;; arch-tag: 88ef9396-d857-4dc3-8946-5a72bdfa2337 + +;;; ob-perl.el ends here diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el new file mode 100644 index 00000000000..c082188bea7 --- /dev/null +++ b/lisp/org/ob-python.el @@ -0,0 +1,276 @@ +;;; ob-python.el --- org-babel functions for python evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating python source code. + +;;; Code: +(require 'ob) +(require 'ob-ref) +(require 'ob-comint) +(require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function org-remove-indentation "org" ) +(declare-function py-shell "ext:python-mode" (&optional argprompt)) +(declare-function run-python "ext:python" (&optional cmd noshow new)) + +(add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) + +(defvar org-babel-default-header-args:python '()) + +(defvar org-babel-python-command "python" + "Name of command for executing python code.") + +(defvar org-babel-python-mode (if (featurep 'xemacs) 'python-mode 'python) + "Preferred python mode for use in running python interactively.") + +(defun org-babel-expand-body:python (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (concat + (mapconcat ;; define any variables + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-python-var-to-python (cdr pair)))) + (nth 1 (or processed-params (org-babel-process-params params))) "\n") + "\n" (org-babel-trim body) "\n")) + +(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'." + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-python-initiate-session (first processed-params))) + (result-params (nth 2 processed-params)) + (result-type (nth 3 processed-params)) + (full-body (org-babel-expand-body:python + body params processed-params)) + (result (org-babel-python-evaluate + session full-body result-type result-params))) + (or (cdr (assoc :file params)) + (org-babel-reassemble-table + result + (org-babel-pick-name (nth 4 processed-params) + (cdr (assoc :colnames params))) + (org-babel-pick-name (nth 5 processed-params) + (cdr (assoc :rownames params))))))) + +(defun org-babel-prep-session:python (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (let* ((session (org-babel-python-initiate-session session)) + (vars (org-babel-ref-variables params)) + (var-lines (mapcar ;; define any variables + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-python-var-to-python (cdr pair)))) + vars))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:python (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:python 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-python-var-to-python (var) + "Convert an elisp value to a python variable. +Convert an elisp value, VAR, into a string of python source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]") + (if (equal var 'hline) + "None" + (format + (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S") + var)))) + +(defun org-babel-python-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If the results look like a list or tuple, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + ((lambda (res) + (if (listp res) + (mapcar (lambda (el) (if (equal el 'None) 'hline el)) res) + res)) + (org-babel-read + (if (or (string-match "^\\[.+\\]$" results) + (string-match "^(.+)$" results)) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + ", " " " (replace-regexp-in-string + "'" "\"" results t)))))) + results)))) + +(defvar org-babel-python-buffers '((:default . nil))) + +(defun org-babel-python-session-buffer (session) + "Return the buffer associated with SESSION." + (cdr (assoc session org-babel-python-buffers))) + +(defun org-babel-python-initiate-session-by-key (&optional session) + "Initiate a python session. +If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (require org-babel-python-mode) + (save-window-excursion + (let* ((session (if session (intern session) :default)) + (python-buffer (org-babel-python-session-buffer session))) + (cond + ((and (equal 'python org-babel-python-mode) + (fboundp 'run-python)) ; python.el + (run-python)) + ((and (equal 'python-mode org-babel-python-mode) + (fboundp 'py-shell)) ; python-mode.el + ;; `py-shell' creates a buffer whose name is the value of + ;; `py-which-bufname' with '*'s at the beginning and end + (let* ((bufname (if python-buffer + (replace-regexp-in-string ;; zap surrounding * + "^\\*\\([^*]+\\)\\*$" "\\1" python-buffer) + (concat "Python-" (symbol-name session)))) + (py-which-bufname bufname)) + (py-shell) + (setq python-buffer (concat "*" bufname "*")))) + (t + (error "No function available for running an inferior python."))) + (setq org-babel-python-buffers + (cons (cons session python-buffer) + (assq-delete-all session org-babel-python-buffers))) + session))) + +(defun org-babel-python-initiate-session (&optional session params) + "Create a session named SESSION according to PARAMS." + (unless (string= session "none") + (org-babel-python-session-buffer + (org-babel-python-initiate-session-by-key session)))) + +(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'" + "A string to indicate that evaluation has completed.") +(defvar org-babel-python-wrapper-method + " +def main(): +%s + +open('%s', 'w').write( str(main()) )") +(defvar org-babel-python-pp-wrapper-method + " +import pprint +def main(): +%s + +open('%s', 'w').write( pprint.pformat(main()) )") + +(defun org-babel-python-evaluate + (buffer body &optional result-type result-params) + "Pass BODY to the Python process in BUFFER. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY, as elisp." + (if (not buffer) + ;; external process evaluation + (case result-type + (output (org-babel-eval org-babel-python-command body)) + (value (let ((tmp-file (make-temp-file "org-babel-python-results-"))) + (org-babel-eval org-babel-python-command + (format + (if (member "pp" result-params) + org-babel-python-pp-wrapper-method + org-babel-python-wrapper-method) + (mapconcat + (lambda (line) (format "\t%s" line)) + (split-string + (org-remove-indentation + (org-babel-trim body)) + "[\r\n]") "\n") + tmp-file)) + ((lambda (raw) + (if (or (member "code" result-params) + (member "pp" result-params)) + raw + (org-babel-python-table-or-string raw))) + (org-babel-eval-read-file tmp-file))))) + ;; comint session evaluation + (flet ((dump-last-value (tmp-file pp) + (mapc + (lambda (statement) (insert statement) (comint-send-input)) + (if pp + (list + "import pp" + (format "open('%s', 'w').write(pprint.pformat(_))" tmp-file)) + (list (format "open('%s', 'w').write(str(_))" tmp-file))))) + (input-body (body) + (mapc (lambda (statement) (insert statement) (comint-send-input)) + (split-string (org-babel-trim body) "[\r\n]+")) + (comint-send-input) (comint-send-input))) + (case result-type + (output + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (buffer org-babel-python-eoe-indicator t body) + (let ((comint-process-echoes nil)) + (input-body body) + (insert org-babel-python-eoe-indicator) + (comint-send-input))) 2) "\n")) + (value + ((lambda (results) + (if (or (member "code" result-params) (member "pp" result-params)) + results + (org-babel-python-table-or-string results))) + (let ((tmp-file (make-temp-file "org-babel-python-results-"))) + (org-babel-comint-with-output + (buffer org-babel-python-eoe-indicator t body) + (let ((comint-process-echoes nil)) + (input-body body) + (dump-last-value tmp-file (member "pp" result-params)) + (comint-send-input) (comint-send-input) + (insert org-babel-python-eoe-indicator) + (comint-send-input))) + (org-babel-eval-read-file tmp-file)))))))) + +(defun org-babel-python-read-string (string) + "Strip 's from around python string" + (if (string-match "^'\\([^\000]+\\)'$" string) + (match-string 1 string) + string)) + +(provide 'ob-python) + +;; arch-tag: f19b6c3d-dfcb-4a1a-9ce0-45ade1ebc212 + +;;; ob-python.el ends here diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el new file mode 100644 index 00000000000..4c344e6761e --- /dev/null +++ b/lisp/org/ob-ref.el @@ -0,0 +1,242 @@ +;;; ob-ref.el --- org-babel functions for referencing external data + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Functions for referencing data from the header arguments of a +;; org-babel block. The syntax of such a reference should be + +;; #+VAR: variable-name=file:resource-id + +;; - variable-name :: the name of the variable to which the value +;; will be assigned + +;; - file :: path to the file containing the resource, or omitted if +;; resource is in the current file + +;; - resource-id :: the id or name of the resource + +;; So an example of a simple src block referencing table data in the +;; same file would be + +;; #+TBLNAME: sandbox +;; | 1 | 2 | 3 | +;; | 4 | org-babel | 6 | +;; +;; #+begin_src emacs-lisp :var table=sandbox +;; (message table) +;; #+end_src + +;;; Code: +(require 'ob) +(eval-when-compile + (require 'cl)) + +(declare-function org-remove-if-not "org" (predicate seq)) +(declare-function org-at-table-p "org" (&optional table-type)) +(declare-function org-count "org" (CL-ITEM CL-SEQ)) + +(defun org-babel-ref-variables (params) + "Convert PARAMS to variable names and values. +Takes a parameter alist, and return an alist of variable names, +and the emacs-lisp representation of the related value." + (let ((assignments + (delq nil (mapcar (lambda (pair) (if (eq (car pair) :var) (cdr pair))) params))) + (others + (delq nil (mapcar (lambda (pair) (unless (eq :var (car pair)) pair)) params)))) + (mapcar (lambda (assignment) (org-babel-ref-parse assignment)) assignments))) + +(defvar org-babel-ref-split-regexp + "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*") + +(defun org-babel-ref-parse (assignment &optional params) + "Parse a variable ASSIGNMENT in a header argument. +If the right hand side of the assignment has a literal value +return that value, otherwise interpret as a reference to an +external resource and find it's value using +`org-babel-ref-resolve-reference'. Return a list with two +elements. The first element of the list will be the name of the +variable, and the second will be an emacs-lisp representation of +the value of the variable." + (if (string-match org-babel-ref-split-regexp assignment) + (let ((var (match-string 1 assignment)) + (ref (match-string 2 assignment))) + (cons (intern var) + ((lambda (val) + (if (equal :ob-must-be-reference val) + (org-babel-ref-resolve-reference ref params) + val)) (org-babel-ref-literal ref)))))) + +(defun org-babel-ref-literal (ref) + "Return the value of REF if it is a literal value. +Determine if the right side of a header argument variable +assignment is a literal value or is a reference to some external +resource. REF should be a string of the right hand side of the +assignment. If REF is literal then return it's value, otherwise +return nil." + (let ((out (org-babel-read ref))) + (if (equal out ref) + (if (string-match "^\".+\"$" ref) + (read ref) + :ob-must-be-reference) + out))) + +(defvar org-babel-library-of-babel) +(defun org-babel-ref-resolve-reference (ref &optional params) + "Resolve the reference REF and return its value." + (save-excursion + (let ((case-fold-search t) + type args new-refere new-referent result lob-info split-file split-ref + index index-row index-col) + ;; if ref is indexed grab the indices -- beware nested indices + (when (and (string-match "\\[\\(.+\\)\\]" ref) + (let ((str (substring ref 0 (match-beginning 0)))) + (= (org-count ?( str) (org-count ?) str)))) + (setq index (match-string 1 ref)) + (setq ref (substring ref 0 (match-beginning 0)))) + ;; assign any arguments to pass to source block + (when (string-match "^\\(.+?\\)\(\\(.*\\)\)$" ref) + (setq new-refere (match-string 1 ref)) + (setq new-referent (match-string 2 ref)) + ;; (message "new-refere=%S, new-referent=%S" new-refere new-referent) ;; debugging + (when (> (length new-refere) 0) + (if (> (length new-referent) 0) + (setq args (mapcar (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args new-referent)))) + ;; (message "args=%S" args) ;; debugging + (setq ref new-refere))) + (when (string-match "^\\(.+\\):\\(.+\\)$" ref) + (setq split-file (match-string 1 ref)) + (setq split-ref (match-string 2 ref)) + (find-file split-file) (setq ref split-ref)) + (save-restriction + (widen) + (goto-char (point-min)) + (if (let ((result_regexp (concat "^[ \t]*#\\+\\(TBLNAME\\|RESNAME\\|RESULTS\\):[ \t]*" + (regexp-quote ref) "[ \t]*$")) + (regexp (concat org-babel-src-name-regexp + (regexp-quote ref) "\\(\(.*\)\\)?" "[ \t]*$"))) + ;; goto ref in the current buffer + (or (and (not args) + (or (re-search-forward result_regexp nil t) + (re-search-backward result_regexp nil t))) + (re-search-forward regexp nil t) + (re-search-backward regexp nil t) + ;; check the Library of Babel + (setq lob-info (cdr (assoc (intern ref) org-babel-library-of-babel))))) + (unless lob-info (goto-char (match-beginning 0))) + ;; ;; TODO: allow searching for names in other buffers + ;; (setq id-loc (org-id-find ref 'marker) + ;; buffer (marker-buffer id-loc) + ;; loc (marker-position id-loc)) + ;; (move-marker id-loc nil) + (error "reference '%s' not found in this buffer" ref)) + (if lob-info + (setq type 'lob) + (while (not (setq type (org-babel-ref-at-ref-p))) + (forward-line 1) + (beginning-of-line) + (if (or (= (point) (point-min)) (= (point) (point-max))) + (error "reference not found")))) + (setq params (org-babel-merge-params params args '((:results . "silent")))) + (setq result + (case type + ('results-line (org-babel-read-result)) + ('table (org-babel-read-table)) + ('file (org-babel-read-link)) + ('source-block (org-babel-execute-src-block nil nil params)) + ('lob (org-babel-execute-src-block nil lob-info params)))) + (if (symbolp result) + (format "%S" result) + (if (and index (listp result)) + (org-babel-ref-index-list index result) + result)))))) + +(defun org-babel-ref-index-list (index lis) + "Return the subset of LIS indexed by INDEX. + +Indices are 0 based and negative indices count from the end of +LIS, so 0 references the first element of LIS and -1 references +the last. If INDEX is separated by \",\"s then each \"portion\" +is assumed to index into the next deepest nesting or dimension. + +A valid \"portion\" can consist of either an integer index, two +integers separated by a \":\" in which case the entire range is +returned, or an empty string or \"*\" both of which are +interpreted to mean the entire range and as such are equivalent +to \"0:-1\"." + (if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index)) + (let ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)") + (length (length lis)) + (portion (match-string 1 index)) + (remainder (substring index (match-end 0)))) + (flet ((wrap (num) (if (< num 0) (+ length num) num)) + (open (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls))) + (open + (mapcar + (lambda (sub-lis) (org-babel-ref-index-list remainder sub-lis)) + (if (or (= 0 (length portion)) (string-match ind-re portion)) + (mapcar + (lambda (n) (nth n lis)) + (apply 'number-sequence + (if (and (> (length portion) 0) (match-string 2 portion)) + (list + (wrap (string-to-number (match-string 2 portion))) + (wrap (string-to-number (match-string 3 portion)))) + (list (wrap 0) (wrap -1))))) + (list (nth (wrap (string-to-number portion)) lis))))))) + lis)) + +(defun org-babel-ref-split-args (arg-string) + "Split ARG-STRING into top-level arguments of balanced parenthesis." + (let ((index 0) (depth 0) (buffer "") holder return) + ;; crawl along string, splitting at any ","s which are on the top level + (while (< index (length arg-string)) + (setq holder (substring arg-string index (+ 1 index))) + (setq buffer (concat buffer holder)) + (setq index (+ 1 index)) + (cond + ((string= holder ",") + (when (= depth 0) + (setq return (reverse (cons (substring buffer 0 -1) return))) + (setq buffer ""))) + ((or (string= holder "(") (string= holder "[")) (setq depth (+ depth 1))) + ((or (string= holder ")") (string= holder "]")) (setq depth (- depth 1))))) + (mapcar #'org-babel-trim (reverse (cons buffer return))))) + +(defvar org-bracket-link-regexp) +(defun org-babel-ref-at-ref-p () + "Return the type of reference located at point. +Return nil if none of the supported reference types are found. +Supported reference types are tables and source blocks." + (cond ((org-at-table-p) 'table) + ((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block) + ((looking-at org-bracket-link-regexp) 'file) + ((looking-at org-babel-result-regexp) 'results-line))) + +(provide 'ob-ref) + +;; arch-tag: ace4a4f4-ea38-4dac-8fe6-6f52fcc43b6d + +;;; ob-ref.el ends here diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el new file mode 100644 index 00000000000..e557c80ef1a --- /dev/null +++ b/lisp/org/ob-ruby.el @@ -0,0 +1,254 @@ +;;; ob-ruby.el --- org-babel functions for ruby evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating ruby source code. + +;;; Requirements: + +;; - ruby and irb executables :: http://www.ruby-lang.org/ +;; +;; - ruby-mode :: Can be installed through ELPA, or from +;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el +;; +;; - inf-ruby mode :: Can be installed through ELPA, or from +;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el + +;;; 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)) + +(add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb")) + +(defvar org-babel-default-header-args:ruby '()) + +(defvar org-babel-ruby-command "ruby" + "Name of command to use for executing ruby code.") + +(defun org-babel-expand-body:ruby (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (require 'inf-ruby) + (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) + (concat + (mapconcat ;; define any variables + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-ruby-var-to-ruby (cdr pair)))) + vars "\n") "\n" body "\n"))) + +(defun org-babel-execute:ruby (body params) + "Execute a block of Ruby code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-ruby-initiate-session (first processed-params))) + (result-params (nth 2 processed-params)) + (result-type (nth 3 processed-params)) + (full-body (org-babel-expand-body:ruby + body params processed-params)) + (result (org-babel-ruby-evaluate + session full-body result-type result-params))) + (or (cdr (assoc :file params)) + (org-babel-reassemble-table + result + (org-babel-pick-name (nth 4 processed-params) + (cdr (assoc :colnames params))) + (org-babel-pick-name (nth 5 processed-params) + (cdr (assoc :rownames params))))))) + +(defun org-babel-prep-session:ruby (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + ;; (message "params=%S" params) ;; debugging + (let* ((session (org-babel-ruby-initiate-session session)) + (vars (org-babel-ref-variables params)) + (var-lines (mapcar ;; define any variables + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-ruby-var-to-ruby (cdr pair)))) + vars))) + (org-babel-comint-in-buffer session + (sit-for .5) (goto-char (point-max)) + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines)) + session)) + +(defun org-babel-load-session:ruby (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:ruby 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-ruby-var-to-ruby (var) + "Convert VAR into a ruby variable. +Convert an elisp value into a string of ruby source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]") + (format "%S" var))) + +(defun org-babel-ruby-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + ", " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(defun org-babel-ruby-initiate-session (&optional session params) + "Initiate a ruby session. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session." + (require 'inf-ruby) + (unless (string= session "none") + (let ((session-buffer (save-window-excursion + (run-ruby nil session) (current-buffer)))) + (if (org-babel-comint-buffer-livep session-buffer) + (progn (sit-for .25) session-buffer) + (sit-for .5) + (org-babel-ruby-initiate-session session))))) + +(defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe" + "String to indicate that evaluation has completed.") +(defvar org-babel-ruby-f-write + "File.open('%s','w'){|f| f.write((_.class == String) ? _ : _.inspect)}") +(defvar org-babel-ruby-pp-f-write + "File.open('%s','w'){|f| $stdout = f; pp(results); $stdout = orig_out}") +(defvar org-babel-ruby-wrapper-method + " +def main() +%s +end +results = main() +File.open('%s', 'w'){ |f| f.write((results.class == String) ? results : results.inspect) } +") +(defvar org-babel-ruby-pp-wrapper-method + " +require 'pp' +def main() +%s +end +results = main() +File.open('%s', 'w') do |f| + $stdout = f + pp results +end +") + +(defun org-babel-ruby-evaluate + (buffer body &optional result-type result-params) + "Pass BODY to the Ruby process in BUFFER. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY, as elisp." + (if (not buffer) + ;; external process evaluation + (case result-type + (output (org-babel-eval org-babel-ruby-command body)) + (value (let ((tmp-file (make-temp-file "org-babel-ruby-results-"))) + (org-babel-eval org-babel-ruby-command + (format (if (member "pp" result-params) + org-babel-ruby-pp-wrapper-method + org-babel-ruby-wrapper-method) + body tmp-file)) + ((lambda (raw) + (if (or (member "code" result-params) + (member "pp" result-params)) + raw + (org-babel-ruby-table-or-string raw))) + (org-babel-eval-read-file tmp-file))))) + ;; comint session evaluation + (case result-type + (output + (mapconcat + #'identity + (butlast + (split-string + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (buffer org-babel-ruby-eoe-indicator t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (list body org-babel-ruby-eoe-indicator)) + (comint-send-input nil t)) 2) + "\n") "[\r\n]")) "\n")) + (value + ((lambda (results) + (if (or (member "code" result-params) (member "pp" result-params)) + results + (org-babel-ruby-table-or-string results))) + (let* ((tmp-file (make-temp-file "org-babel-ruby-results-")) + (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 tmp-file)) + (list + "results=_" "require 'pp'" "orig_out = $stdout" + (format org-babel-ruby-pp-f-write tmp-file))) + (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." + (if (string-match "^\"\\([^\000]+\\)\"$" string) + (match-string 1 string) + string)) + +(provide 'ob-ruby) + +;; arch-tag: 3e9726db-4520-49e2-b263-e8f571ac88f5 + +;;; ob-ruby.el ends here diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el new file mode 100644 index 00000000000..87f9ff46ecc --- /dev/null +++ b/lisp/org/ob-sass.el @@ -0,0 +1,70 @@ +;;; ob-sass.el --- org-babel functions for the sass css generation language + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; For more information on sass see http://sass-lang.com/ +;; +;; This accepts a 'file' header argument which is the target of the +;; compiled sass. The default output type for sass evaluation is +;; either file (if a 'file' header argument was given) or scalar if no +;; such header argument was supplied. +;; +;; A 'cmdline' header argument can be supplied to pass arguments to +;; the sass command line. + +;;; Requirements: + +;; - sass-mode :: http://github.com/nex3/haml/blob/master/extra/sass-mode.el + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:sass '()) + +(defun org-babel-expand-body:sass (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defun org-babel-execute:sass (body params) + "Execute a block of Sass code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (file (cdr (assoc :file params))) + (out-file (or file (make-temp-file "org-babel-sass-out"))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (make-temp-file "org-babel-sass-in")) + (cmd (concat "sass " (or cmdline "") in-file " " out-file))) + (with-temp-file in-file + (insert (org-babel-expand-body:sass body params))) (shell-command cmd) + (or file (with-temp-buffer (insert-file-contents out-file) (buffer-string))))) + +(defun org-babel-prep-session:sass (session params) + "Raise an error because sass does not support sessions." + (error "Sass does not support sessions")) + +(provide 'ob-sass) + +;; arch-tag: 2954b169-eef4-45ce-a8e5-3e619f0f07ac + +;;; ob-sass.el ends here diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el new file mode 100644 index 00000000000..7e575aa02ec --- /dev/null +++ b/lisp/org/ob-screen.el @@ -0,0 +1,154 @@ +;;; ob-screen.el --- org-babel support for interactive terminal + +;; Copyright (C) 2009, 2010 Free Software Foundation + +;; Author: Benjamin Andresen +;; Keywords: literate programming, interactive shell +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for interactive terminals. Mostly shell scripts. +;; Heavily inspired by 'eev' from Eduardo Ochs +;; +;; Adding :cmd and :terminal as header arguments +;; :terminal must support the -T (title) and -e (command) parameter +;; +;; You can test the default setup. (xterm + sh) with +;; M-x org-babel-screen-test RET + +;;; Code: +(require 'ob) +(require 'ob-ref) + +(defvar org-babel-screen-location "screen" + "The command location for screen. +In case you want to use a different screen than one selected by your $PATH") + +(defvar org-babel-default-header-args:screen + '((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm")) + "Default arguments to use when running screen source blocks.") + +(defun org-babel-expand-body:screen (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defun org-babel-execute:screen (body params) + "Send a block of code via screen to a terminal using Babel. +\"default\" session is be used when none is specified." + (message "Sending source code block to interactive terminal session...") + (save-window-excursion + (let* ((processed-params (org-babel-process-params params)) + (session (nth 0 processed-params)) + (socket (org-babel-screen-session-socketname session))) + (unless socket (org-babel-prep-session:screen session params)) + (org-babel-screen-session-execute-string + session (org-babel-expand-body:screen body params))))) + +(defun org-babel-prep-session:screen (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((processed-params (org-babel-process-params params)) + (session (nth 0 processed-params)) + (vars (nth 1 processed-params)) + (socket (org-babel-screen-session-socketname session)) + (vars (org-babel-ref-variables params)) + (cmd (cdr (assoc :cmd params))) + (terminal (cdr (assoc :terminal params))) + (process-name (concat "org-babel: terminal (" session ")"))) + (apply 'start-process process-name "*Messages*" + terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location + "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) + ,cmd)) + ;; XXX: Is there a better way than the following? + (while (not (org-babel-screen-session-socketname session)) + ;; wait until screen session is available before returning + ))) + +;; helper functions + +(defun org-babel-screen-session-execute-string (session body) + "If SESSION exists, send BODY to it." + (let ((socket (org-babel-screen-session-socketname session))) + (when socket + (let ((tmpfile (org-babel-screen-session-write-temp-file session body))) + (apply 'start-process (concat "org-babel: screen (" session ")") "*Messages*" + org-babel-screen-location + `("-S" ,socket "-X" "eval" "msgwait 0" + ,(concat "readreg z " tmpfile) + "paste z")))))) + +(defun org-babel-screen-session-socketname (session) + "Check if SESSION exists by parsing output of \"screen -ls\"." + (let* ((screen-ls (shell-command-to-string "screen -ls")) + (sockets (delq + nil + (mapcar + (lambda (x) + (when (string-match (rx (or "(Attached)" "(Detached)")) x) + x)) + (split-string screen-ls "\n")))) + (match-socket (car + (delq + nil + (mapcar + (lambda (x) + (when (string-match + (concat "org-babel-session-" session) x) + x)) + sockets))))) + (when match-socket (car (split-string match-socket))))) + +(defun org-babel-screen-session-write-temp-file (session body) + "Save BODY in a temp file that is named after SESSION." + (let ((tmpfile (concat "/tmp/screen.org-babel-session-" session))) + (with-temp-file tmpfile + (insert body) + + ;; org-babel has superflous spaces + (goto-char (point-min)) + (delete-matching-lines "^ +$")) + tmpfile)) + +(defun org-babel-screen-test () + "Test if the default setup works. +The terminal should shortly flicker." + (interactive) + (let* ((session "org-babel-testing") + (random-string (format "%s" (random 99999))) + (tmpfile "/tmp/org-babel-screen.test") + (body (concat "echo '" random-string "' > " tmpfile "\nexit\n")) + process tmp-string) + (org-babel-execute:screen body org-babel-default-header-args:screen) + ;; XXX: need to find a better way to do the following + (while (not (file-readable-p tmpfile)) + ;; do something, otherwise this will be optimized away + (format "org-babel-screen: File not readable yet.")) + (setq tmp-string (with-temp-buffer + (insert-file-contents-literally tmpfile) + (buffer-substring (point-min) (point-max)))) + (delete-file tmpfile) + (message (concat "org-babel-screen: Setup " + (if (string-match random-string tmp-string) + "WORKS." + "DOESN'T work."))))) + +(provide 'ob-screen) + +;; arch-tag: 908e5afe-89a0-4f27-b982-23f1f2e3bac9 + +;;; ob-screen.el ends here diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el new file mode 100644 index 00000000000..69fbefc82c4 --- /dev/null +++ b/lisp/org/ob-sh.el @@ -0,0 +1,189 @@ +;;; ob-sh.el --- org-babel functions for shell evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating shell source code. + +;;; Code: +(require 'ob) +(require 'ob-comint) +(require 'ob-eval) +(require 'shell) +(eval-when-compile (require 'cl)) + +(declare-function org-babel-ref-variables "ob-ref" (params)) +(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) +(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) +(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) +(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body)) +(declare-function orgtbl-to-generic "org-table" (table params)) + +(defvar org-babel-default-header-args:sh '()) + +(defvar org-babel-sh-command "sh" + "Command used to invoke a shell. +This will be passed to `shell-command-on-region'") + +(defun org-babel-expand-body:sh (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params (org-babel-process-params params)))) + (sep (cdr (assoc :separator params)))) + (concat + (mapconcat ;; define any variables + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-sh-var-to-sh (cdr pair) sep))) + vars "\n") "\n" body "\n\n"))) + +(defun org-babel-execute:sh (body params) + "Execute a block of Shell commands with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-sh-initiate-session (nth 0 processed-params))) + (result-params (nth 2 processed-params)) + (full-body (org-babel-expand-body:sh + body params processed-params))) + (org-babel-reassemble-table + (org-babel-sh-evaluate session full-body result-params) + (org-babel-pick-name + (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name + (nth 5 processed-params) (cdr (assoc :rownames params)))))) + +(defun org-babel-prep-session:sh (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-sh-initiate-session session)) + (vars (org-babel-ref-variables params)) + (sep (cdr (assoc :separator params))) + (var-lines (mapcar ;; define any variables + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-sh-var-to-sh (cdr pair) sep))) + vars))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:sh (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:sh 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-sh-var-to-sh (var &optional sep) + "Convert an elisp value to a shell variable. +Convert an elisp var into a string of shell commands specifying a +var of the same value." + (if (listp var) + (flet ((deep-string (el) + (if (listp el) + (mapcar #'deep-string el) + (org-babel-sh-var-to-sh el sep)))) + (format "$(cat <<BABEL_TABLE\n%s\nBABEL_TABLE\n)" + (orgtbl-to-generic + (deep-string var) (list :sep (or sep "\t"))))) + (if (stringp var) + (if (string-match "[\n\r]" var) + (format "$(cat <<BABEL_STRING\n%s\nBABEL_STRING\n)" var) + (format "%s" var)) + (format "%S" var)))) + +(defun org-babel-sh-table-or-results (results) + "Convert RESULTS to an appropriate elisp value. +If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (string-match "^\\[.+\\]$" results) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + ", " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(defun org-babel-sh-initiate-session (&optional session params) + "Initiate a session named SESSION according to PARAMS." + (when (and session (not (string= session "none"))) + (save-window-excursion + (or (org-babel-comint-buffer-livep session) + (progn (shell session) (get-buffer (current-buffer))))))) + +(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'" + "String to indicate that evaluation has completed.") +(defvar org-babel-sh-eoe-output "org_babel_sh_eoe" + "String to indicate that evaluation has completed.") + +(defun org-babel-sh-evaluate (session body &optional result-params) + "Pass BODY to the Shell process in BUFFER. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY." + ((lambda (results) + (if (or (member "scalar" result-params) + (member "output" result-params)) + results + (let ((tmp-file (make-temp-file "org-babel-sh"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file)))) + (if (not session) + (org-babel-eval org-babel-sh-command (org-babel-trim body)) + (let ((tmp-file (make-temp-file "org-babel-sh"))) + (mapconcat + #'org-babel-sh-strip-weird-long-prompt + (mapcar + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (session org-babel-sh-eoe-output t body) + (mapc + (lambda (line) + (insert line) (comint-send-input nil t) (sleep-for 0.25)) + (append + (split-string (org-babel-trim body) "\n") + (list org-babel-sh-eoe-indicator)))) + 2)) "\n"))))) + +(defun org-babel-sh-strip-weird-long-prompt (string) + "Remove prompt cruft from a string of shell output." + (while (string-match "^% +[\r\n$]+ *" string) + (setq string (substring string (match-end 0)))) + string) + +(provide 'ob-sh) + +;; arch-tag: 416dd531-c230-4b0a-a5bf-8d948f990f2d + +;;; ob-sh.el ends here diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el new file mode 100644 index 00000000000..184c755f7b8 --- /dev/null +++ b/lisp/org/ob-sql.el @@ -0,0 +1,90 @@ +;;; ob-sql.el --- org-babel functions for sql evaluation + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating sql source code. +;; +;; SQL is somewhat unique in that there are many different engines for +;; the evaluation of sql (Mysql, PostgreSQL, etc...), so much of this +;; file will have to be implemented engine by engine. +;; +;; Also SQL evaluation generally takes place inside of a database. +;; +;; For now lets just allow a generic ':cmdline' header argument. +;; +;; 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? +;; + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function org-table-import "org-table" (file arg)) + +(defvar org-babel-default-header-args:sql '()) + +(defun org-babel-expand-body:sql (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(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 (split-string (or (cdr (assoc :results params)) ""))) + (processed-params (org-babel-process-params params)) + (cmdline (cdr (assoc :cmdline params))) + (engine (cdr (assoc :engine params))) + (in-file (make-temp-file "org-babel-sql-in")) + (out-file (or (cdr (assoc :out-file params)) + (make-temp-file "org-babel-sql-out"))) + (command (case (intern engine) + ('mysql (format "mysql %s -e \"source %s\" > %s" + (or cmdline "") in-file out-file)) + (t (error "no support for the %s sql engine" engine))))) + (with-temp-file in-file + (insert (org-babel-expand-body:sql body params))) + (message command) + (shell-command command) + (with-temp-buffer + (org-table-import out-file nil) + (org-babel-reassemble-table + (org-table-to-lisp) + (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params))))))) + + +(defun org-babel-prep-session:sql (session params) + "Raise an error because Sql sessions aren't implemented." + (error "sql sessions not yet implemented")) + +(provide 'ob-sql) + +;; arch-tag: a43ff944-6de1-4566-a83c-626814e3dad2 + +;;; ob-sql.el ends here diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el new file mode 100644 index 00000000000..7d6930abd4b --- /dev/null +++ b/lisp/org/ob-sqlite.el @@ -0,0 +1,152 @@ +;;; ob-sqlite.el --- org-babel functions for sqlite database interaction + +;; Copyright (C) 2010 Free Software Foundation + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Org-Babel support for evaluating sqlite source code. + +;;; Code: +(require 'ob) +(require 'ob-ref) + +(declare-function org-fill-template "org" (template alist)) +(declare-function org-table-convert-region "org-table" + (beg0 end0 &optional separator)) +(declare-function orgtbl-to-csv "org-table" (TABLE PARAMS)) + +(defvar org-babel-default-header-args:sqlite '()) + +(defvar org-babel-header-arg-names:sqlite + '(db header echo bail csv column html line list separator nullvalue) + "Sqlite specific header args.") + +(defun org-babel-expand-body:sqlite (body params &optional processed-params) + (org-babel-sqlite-expand-vars + body (or (nth 1 processed-params) (org-babel-ref-variables params)))) + +(defvar org-babel-sqlite3-command "sqlite3") + +(defun org-babel-execute:sqlite (body params) + "Execute a block of Sqlite code with Babel. +This function is called by `org-babel-execute-src-block'." + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (vars (org-babel-ref-variables params)) + (db (cdr (assoc :db params))) + (separator (cdr (assoc :separator params))) + (nullvalue (cdr (assoc :nullvalue params))) + (headers-p (equal "yes" (cdr (assoc :colnames params)))) + (others (delq nil (mapcar + (lambda (arg) (car (assoc arg params))) + (list :header :echo :bail :column + :csv :html :line :list)))) + exit-code) + (unless db (error "ob-sqlite: can't evaluate without a database.")) + (with-temp-buffer + (insert + (shell-command-to-string + (org-fill-template + "%cmd -init %body %header %separator %nullvalue %others %csv %db " + (list + (cons "body" ((lambda (sql-file) + (with-temp-file sql-file + (insert (org-babel-expand-body:sqlite + body nil (list nil vars)))) + sql-file) + (make-temp-file "ob-sqlite-sql"))) + (cons "cmd" org-babel-sqlite3-command) + (cons "header" (if headers-p "-header" "-noheader")) + (cons "separator" + (if separator (format "-separator %s" separator) "")) + (cons "nullvalue" + (if nullvalue (format "-nullvalue %s" nullvalue) "")) + (cons "others" + (mapconcat + (lambda (arg) (format "-%s" (substring (symbol-name arg) 1))) + others " ")) + ;; for easy table parsing, default header type should be -csv + (cons "csv" (if (or (member :csv others) (member :column others) + (member :line others) (member :list others) + (member :html others) separator) + "" + "-csv")) + (cons "db " db))))) + (if (or (member "scalar" 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)) + (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." + (mapc + (lambda (pair) + (setq body + (replace-regexp-in-string + (format "\$%s" (car pair)) + ((lambda (val) + (if (listp val) + ((lambda (data-file) + (with-temp-file data-file + (insert (orgtbl-to-csv + val '(:fmt (lambda (el) (if (stringp el) + el + (format "%S" el))))))) + data-file) + (make-temp-file "ob-sqlite-data")) + (format "%S" val))) + (cdr pair)) + body))) + vars) + body) + +(defun org-babel-sqlite-table-or-scalar (result) + "If RESULT looks like a trivial table, then unwrap it." + (if (and (equal 1 (length result)) + (equal 1 (length (car result)))) + (org-babel-read (caar result)) + (mapcar (lambda (row) + (if (equal 'hline row) + 'hline + (mapcar #'org-babel-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." + (if headers-p + (cons (car table) (cons 'hline (cdr table))) + table)) + +(defun org-babel-prep-session:sqlite (session params) + "Raise an error because support for sqlite sessions isn't implemented. +Prepare SESSION according to the header arguments specified in PARAMS." + (error "sqlite sessions not yet implemented")) + +(provide 'ob-sqlite) + +;; arch-tag: 5c03d7f2-0f72-48b8-bbd1-35aafea248ac + +;;; ob-sqlite.el ends here diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el new file mode 100644 index 00000000000..f1506550829 --- /dev/null +++ b/lisp/org/ob-table.el @@ -0,0 +1,109 @@ +;;; ob-table.el --- support for calling org-babel functions from tables + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Should allow calling functions from org-mode tables using the +;; function `sbe' as so... + +;; #+begin_src emacs-lisp :results silent +;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2))))) +;; #+end_src + +;; #+srcname: fibbd +;; #+begin_src emacs-lisp :var n=2 :results silent +;; (fibbd n) +;; #+end_src + +;; | original | fibbd | +;; |----------+--------| +;; | 0 | | +;; | 1 | | +;; | 2 | | +;; | 3 | | +;; | 4 | | +;; | 5 | | +;; | 6 | | +;; | 7 | | +;; | 8 | | +;; | 9 | | +;; #+TBLFM: $2='(sbe 'fibbd (n $1)) + +;;; Code: +(require 'ob) + +(defun org-babel-table-truncate-at-newline (string) + "Replace newline character with ellipses. +If STRING ends in a newline character, then remove the newline +character and replace it with ellipses." + (if (and (stringp string) (string-match "[\n\r]" string)) + (concat (substring string 0 (match-beginning 0)) "...") + string)) + +(defmacro sbe (source-block &rest variables) + "Return the results of calling SOURCE-BLOCK with VARIABLES. +Each element of VARIABLES should be a two +element list, whose first element is the name of the variable and +second element is a string of its value. The following call to +`sbe' would be equivalent to the following source code block. + + (sbe 'source-block (n $2) (m 3)) + +#+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent +results +#+end_src + +NOTE: by default string variable names are interpreted as +references to source-code blocks, to force interpretation of a +cell's value as a string, prefix the identifier with two \"$\"s +rather than a single \"$\" (i.e. \"$$2\" instead of \"$2\" in the +example above." + (let ((variables (mapcar + (lambda (var) + (if (and (= 3 (length var)) (eq (nth 1 var) '$)) + (list (car var) (format "\"%s\"" (last var))) + var)) + variables))) + (unless (stringp source-block) (setq source-block (symbol-name source-block))) + (org-babel-table-truncate-at-newline ;; org-table cells can't be multi-line + (if (and source-block (> (length source-block) 0)) + (let ((params + (eval `(org-babel-parse-header-arguments + (concat ":var results=" + ,source-block + "(" + (mapconcat (lambda (var-spec) + (format "%S=%s" (nth 0 var-spec) (nth 1 var-spec))) + ',variables ", ") + ")"))))) + (org-babel-execute-src-block + nil (list "emacs-lisp" "results" + (org-babel-merge-params '((:results . "silent")) params)))) + "")))) + +(provide 'ob-table) + +;; arch-tag: 4234cc7c-4fc8-4e92-abb0-2892de1a493b + +;;; ob-table.el ends here diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el new file mode 100644 index 00000000000..85f69ede357 --- /dev/null +++ b/lisp/org/ob-tangle.el @@ -0,0 +1,300 @@ +;;; ob-tangle.el --- extract source code from org-mode files + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extract the code from source blocks out into raw source-code files. + +;;; Code: +(require 'ob) +(require 'org-src) +(eval-when-compile + (require 'cl)) + +(declare-function org-link-escape "org" (text &optional table)) +(declare-function org-heading-components "org" ()) + +(defcustom org-babel-tangle-lang-exts + '(("emacs-lisp" . "el")) + "Alist mapping languages to their file extensions. +The key is the language name, the value is the string that should +be inserted as the extension commonly used to identify files +written in this language. If no entry is found in this list, +then the name of the language is used." + :group 'org-babel-tangle + :type '(repeat + (cons + (string "Language name") + (string "File Extension")))) + +(defcustom org-babel-post-tangle-hook nil + "Hook run in code files tangled by `org-babel-tangle'." + :group 'org-babel + :type 'hook) + +(defmacro org-babel-with-temp-filebuffer (file &rest body) + "Open FILE into a temporary buffer execute BODY there like +`progn', then kill the FILE buffer returning the result of +evaluating BODY." + (declare (indent 1)) + (let ((temp-result (make-symbol "temp-result")) + (temp-file (make-symbol "temp-file"))) + `(let (,temp-result ,temp-file) + (find-file ,file) + (setf ,temp-file (current-buffer)) + (setf ,temp-result (progn ,@body)) + (kill-buffer ,temp-file) + ,temp-result))) + +;;;###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'." + (flet ((age (file) + (float-time + (time-subtract (current-time) + (nth 5 (or (file-attributes (file-truename file)) + (file-attributes file))))))) + (let* ((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) + (> (age file) (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. +Source code blocks are extracted with `org-babel-tangle'. +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 "fFile to tangle: \nP") + (let ((visited-p (get-file-buffer (expand-file-name file))) + to-be-removed) + (save-window-excursion + (find-file file) + (setq to-be-removed (current-buffer)) + (org-babel-tangle target-file lang)) + (unless visited-p + (kill-buffer to-be-removed)))) + +(defun org-babel-tangle-publish (_ filename pub-dir) + "Tangle FILENAME and place the results in PUB-DIR." + (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) + +;;;###autoload +(defun org-babel-tangle (&optional 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." + (interactive) + (save-buffer) + (save-excursion + (let ((block-counter 0) + (org-babel-default-header-args + (if target-file + (org-babel-merge-params org-babel-default-header-args + (list (cons :tangle target-file))) + org-babel-default-header-args)) + path-collector) + (mapc ;; map over all languages + (lambda (by-lang) + (let* ((lang (car by-lang)) + (specs (cdr by-lang)) + (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang)) + (lang-f (intern + (concat + (or (and (cdr (assoc lang org-src-lang-modes)) + (symbol-name + (cdr (assoc lang org-src-lang-modes)))) + lang) + "-mode"))) + she-banged) + (mapc + (lambda (spec) + (flet ((get-spec (name) + (cdr (assoc name (nth 2 spec))))) + (let* ((tangle (get-spec :tangle)) + (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb)) + (get-spec :shebang))) + (base-name (cond + ((string= "yes" tangle) + (file-name-sans-extension + (buffer-file-name))) + ((string= "no" tangle) nil) + ((> (length tangle) 0) tangle))) + (file-name (when base-name + ;; decide if we want to add ext to base-name + (if (and ext (string= "yes" tangle)) + (concat base-name "." ext) base-name)))) + (when file-name + ;; delete any old versions of file + (when (and (file-exists-p file-name) + (not (member file-name path-collector))) + (delete-file file-name)) + ;; drop source-block to file + (with-temp-buffer + (when (fboundp lang-f) (funcall lang-f)) + (when (and she-bang (not (member file-name she-banged))) + (insert (concat she-bang "\n")) + (setq she-banged (cons file-name she-banged))) + (org-babel-spec-to-string spec) + ;; We avoid append-to-file as it does not work with tramp. + (let ((content (buffer-string))) + (with-temp-buffer + (if (file-exists-p file-name) + (insert-file-contents file-name)) + (goto-char (point-max)) + (insert content) + (write-region nil nil file-name)))) + ;; if files contain she-bangs, then make the executable + (when she-bang (set-file-modes file-name ?\755)) + ;; update counter + (setq block-counter (+ 1 block-counter)) + (add-to-list 'path-collector file-name))))) + specs))) + (org-babel-tangle-collect-blocks lang)) + (message "tangled %d code block%s" block-counter + (if (= block-counter 1) "" "s")) + ;; run `org-babel-post-tangle-hook' in all tangled files + (when org-babel-post-tangle-hook + (mapc + (lambda (file) + (org-babel-with-temp-filebuffer file + (run-hooks 'org-babel-post-tangle-hook))) + path-collector)) + path-collector))) + +(defun org-babel-tangle-clean () + "Remove comments inserted by `org-babel-tangle'. +Call this function inside of a source-code file generated by +`org-babel-tangle' to remove all comments inserted automatically +by `org-babel-tangle'. Warning, this comment removes any lines +containing constructs which resemble org-mode file links or noweb +references." + (interactive) + (goto-char (point-min)) + (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t) + (re-search-forward "<<[^[:space:]]*>>" nil t)) + (delete-region (save-excursion (beginning-of-line 1) (point)) + (save-excursion (end-of-line 1) (forward-char 1) (point))))) + +(defvar org-stored-links) +(defun org-babel-tangle-collect-blocks (&optional lang) + "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) + (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]" "-" + (nth 4 (org-heading-components)))) + (let* ((link (progn (call-interactively 'org-store-link) + (org-babel-clean-text-properties + (car (pop org-stored-links))))) + (info (org-babel-get-src-block-info)) + (source-name (intern (or (nth 4 info) + (format "%s:%d" + current-heading block-counter)))) + (src-lang (nth 0 info)) + (expand-cmd (intern (concat "org-babel-expand-body:" src-lang))) + (params (nth 2 info)) + by-lang) + (unless (string= (cdr (assoc :tangle params)) "no") ;; skip + (unless (and lang (not (string= lang src-lang))) ;; limit by language + ;; 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 link source-name params + ((lambda (body) + (if (assoc :no-expand params) + body + (funcall + (if (fboundp expand-cmd) + expand-cmd + 'org-babel-expand-body:generic) + body + params))) + (if (and (cdr (assoc :noweb params)) + (string= + "yes" + (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references + info) + (nth 1 info)))) + by-lang)) blocks)))))) + ;; ensure blocks in the correct order + (setq blocks + (mapcar + (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) + blocks)) + blocks)) + +(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 + + (link source-name params body)" + (let ((link (nth 0 spec)) + (source-name (nth 1 spec)) + (body (nth 3 spec)) + (commentable (string= (cdr (assoc :comments (nth 2 spec))) "yes"))) + (flet ((insert-comment (text) + (when commentable + (insert "\n") + (comment-region (point) + (progn (insert text) (point))) + (end-of-line nil) + (insert "\n")))) + (insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name)) + (insert (format "\n%s\n" (replace-regexp-in-string + "^," "" (org-babel-chomp body)))) + (insert-comment (format "%s ends here" source-name))))) + +(provide 'ob-tangle) + +;; arch-tag: 413ced93-48f5-4216-86e4-3fc5df8c8f24 + +;;; ob-tangle.el ends here diff --git a/lisp/org/ob.el b/lisp/org/ob.el new file mode 100644 index 00000000000..eeb60836b3f --- /dev/null +++ b/lisp/org/ob.el @@ -0,0 +1,1591 @@ +;;; ob.el --- working with code blocks in org-mode + +;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte, Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; See the online documentation for more information +;; +;; http://orgmode.org/worg/org-contrib/babel/ + +;;; Code: +(eval-when-compile (require 'cl)) +(require 'org-macs) + +(defvar org-babel-call-process-region-original) +(declare-function show-all "outline" ()) +(declare-function tramp-compat-make-temp-file "tramp" (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 org-icompleting-read "org" (&rest args)) +(declare-function org-edit-src-code "org" (context code edit-buffer-name)) +(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) +(declare-function org-save-outline-visibility "org" (use-markers &rest body)) +(declare-function org-narrow-to-subtree "org" ()) +(declare-function org-entry-get "org" (pom property &optional inherit)) +(declare-function org-make-options-regexp "org" (kwds &optional extra)) +(declare-function org-match-string-no-properties "org" (num &optional string)) +(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-table-import "org" (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-lob-get-info "ob-lob" nil) +(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) +(declare-function org-babel-ref-variables "ob-ref" (params)) +(declare-function org-babel-ref-resolve-reference "ob-ref" (ref &optional params)) + +(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 + :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 + :type 'boolean) + +(defvar org-babel-src-name-regexp + "^[ \t]*#\\+\\(srcname\\|source\\|function\\):[ \t]*" + "Regular expression used to match a source name line.") + +(defvar org-babel-src-name-w-name-regexp + (concat org-babel-src-name-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 + "[ \f\t\n\r\v]\\(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-src-block-info (&optional header-vars-only) + "Get information on the current source block. + +Returns a list + (language body header-arguments-alist switches name function-args indent). +Unless HEADER-VARS-ONLY is non-nil, any variable +references provided in 'function call style' (i.e. in a +parenthesised argument list following the src block name) are +added to the header-arguments-alist." + (let ((case-fold-search t) head info args indent) + (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)) + (forward-line -1) + (if (and (looking-at org-babel-src-name-w-name-regexp) + (match-string 2)) + (progn + (setq info (append info (list (org-babel-clean-text-properties + (match-string 2))))) + ;; Note that e.g. "name()" and "name( )" result in + ;; ((:var . "")). We maintain that behaviour, and the + ;; resulting non-nil sixth element is relied upon in + ;; org-babel-exp-code to detect a functional-style + ;; block in those cases. However, "name" without any + ;; parentheses would result in the same thing, so we + ;; explicitly avoid that. + (if (setq args (match-string 4)) + (setq info + (append info (list + (mapcar + (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args args)))))) + (unless header-vars-only + (setf (nth 2 info) + (org-babel-merge-params (nth 5 info) (nth 2 info))))) + (setq info (append info (list nil nil)))) + (append info (list indent))) + (if (save-excursion ;; inline source block + (re-search-backward "[ \f\t\n\r\v]" nil t) + (looking-at org-babel-inline-src-block-regexp)) + (org-babel-parse-inline-src-block-match) + nil)))) + +(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 (cdr (assoc :eval (nth 2 info)))) + (query (or (equal eval "query") + (and (functionp org-confirm-babel-evaluate) + (funcall org-confirm-babel-evaluate + (nth 0 info) (nth 1 info))) + org-confirm-babel-evaluate))) + (when (or (equal eval "never") + (and query + (not (yes-or-no-p + (format "Evaluate this%scode on your system? " + (if info (format " %s " (nth 0 info)) " ")))))) + (error "evaluation aborted")))) + +;;;###autoload +(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) + (if (not org-babel-no-eval-on-ctrl-c-ctrl-c) + (let ((info (org-babel-get-src-block-info))) + (if info + (progn (org-babel-execute-src-block current-prefix-arg info) t) nil)) + nil)) +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-src-block-maybe) + +;;;###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-header-arg-names + '(cache cmdline colnames dir exports file noweb results + session tangle var noeval comments) + "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")) + "Default arguments to use when evaluating a source block.") + +(defvar org-babel-default-inline-header-args + '((:session . "none") (:results . "silent") (:exports . "results")) + "Default arguments to use when evaluating an inline source block.") + +(defvar org-babel-current-buffer-properties) +(make-variable-buffer-local 'org-babel-current-buffer-properties) + +(defvar org-babel-result-regexp + "^[ \t]*#\\+res\\(ults\\|name\\)\\(\\[\\([[: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\n]*" + (substring org-babel-src-block-regexp 1))) + +;;; 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. + +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))) + ;; note the `evaluation-confirmed' variable is currently not + ;; used, but could be used later to avoid the need for + ;; chaining confirmations + (evaluation-confirmed (org-babel-confirm-evaluate 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))))))) + (new-hash + (if (and (cdr (assoc :cache params)) + (string= "yes" (cdr (assoc :cache params)))) + (org-babel-sha1-hash info))) + (old-hash (org-babel-result-hash info)) + (body (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (result-params (split-string (or (cdr (assoc :results params)) ""))) + (result-type (cond ((member "output" result-params) 'output) + ((member "value" result-params) 'value) + (t 'value))) + (cmd (intern (concat "org-babel-execute:" lang))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory 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) + (unwind-protect + (flet ((call-process-region (&rest args) + (apply 'org-babel-tramp-handle-call-process-region args))) + (unless (fboundp cmd) + (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 (funcall cmd body params)) + (if (eq result-type 'value) + (setq result (if (and (or (member "vector" result-params) + (member "table" result-params)) + (not (listp result))) + (list (list result)) + result))) + (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 processed-params) + "Expand BODY with PARAMS. +Expand a block of code with org-babel according to it's 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." body) + +;;;###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 (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references info) (nth 1 info)))) + (cmd (intern (concat "org-babel-expand-body:" lang))) + (expanded (funcall (if (fboundp cmd) cmd 'org-babel-expand-body:generic) + body params))) + (org-edit-src-code + nil expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")))) + +;;;###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)) + (body (nth 1 info)) + (params (nth 2 info)) + (session (cdr (assoc :session params))) + (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-switch-to-session (&optional arg info) + "Switch to the session of the current source-code block. +If called with a prefix argument then evaluate the header arguments +for the source block before entering the session. Copy the body +of the source block to the kill ring." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + (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)) + (cmd (intern (format "org-babel-%s-initiate-session" lang))) + (cmd2 (intern (concat "org-babel-prep-session:" lang)))) + (unless (fboundp cmd) + (error "No org-babel-initiate-session function for %s!" lang)) + ;; copy body to the kill ring + (with-temp-buffer (insert (org-babel-trim body)) + (copy-region-as-kill (point-min) (point-max))) + ;; if called with a prefix argument, then process header arguments + (unless (fboundp cmd2) + (error "No org-babel-prep-session function for %s!" lang)) + (when arg (funcall cmd2 session params)) + ;; just to the session using pop-to-buffer + (pop-to-buffer (funcall cmd session params)) + (end-of-line 1))) + +(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) + +(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") + (when (org-babel-get-src-block-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 ((results (org-babel-read-result))) + (flet ((echo-res (result) + (if (stringp result) result (format "%S" result)))) + (pop-to-buffer (get-buffer-create "org-babel-results")) + (delete-region (point-min) (point-max)) + (if (listp results) + ;; table result + (insert (orgtbl-to-generic results '(:sep "\t" :fmt echo-res))) + ;; scalar result + (insert (echo-res results)))))) + t))) + +;;;###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") + (save-excursion + (org-save-outline-visibility t + (goto-char (point-min)) + (show-all) + (while (re-search-forward org-babel-src-block-regexp nil t) + (let ((pos-end (match-end 0))) + (goto-char (match-beginning 0)) + (org-babel-execute-src-block arg) + (goto-char pos-end)))))) + +;;;###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) + (widen)))) + +;;;###autoload +(defun org-babel-sha1-hash (&optional info) + "Generate an sha1 hash based on the value of info." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + (hash (sha1 (format "%s-%s" (mapconcat (lambda (arg) (format "%S" arg)) + (nth 2 info) ":") + (nth 1 info))))) + (when (interactive-p) (message hash)) + hash)) + +(defun org-babel-result-hash (&optional info) + "Return the in-buffer hash associated with INFO." + (org-babel-where-is-src-block-result nil info) + (org-babel-clean-text-properties (match-string 3))) + +(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 (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))) + +(defmacro org-babel-map-src-blocks (file &rest body) + "Evaluate BODY forms on each source-block in FILE." + (declare (indent 1)) + `(let ((visited-p (get-file-buffer (expand-file-name ,file))) + to-be-removed) + (save-window-excursion + (find-file ,file) + (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)) + (save-match-data ,@body) + (goto-char (match-end 0)))) + (unless visited-p + (kill-buffer to-be-removed)))) + +(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) + (delq nil + (mapcar + (lambda (header-arg) + (and (setq val + (or (condition-case nil + (org-entry-get (point) header-arg t) + (error nil)) + (cdr (assoc header-arg org-file-properties)))) + (cons (intern (concat ":" header-arg)) val))) + (mapcar + 'symbol-name + (append + org-babel-header-arg-names + (progn + (setq sym (intern (concat "org-babel-header-arg-names:" lang))) + (and (boundp sym) (eval sym)))))))))) + +(defun org-babel-params-from-buffer () + "Retrieve per-buffer parameters. + Return an association list of any source block params which +may be specified at the top of the current buffer." + (or org-babel-current-buffer-properties + (setq org-babel-current-buffer-properties + (save-match-data + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (when (re-search-forward + (org-make-options-regexp (list "BABEL")) nil t) + (org-babel-parse-header-arguments + (org-match-string-no-properties 2))))))))) + +(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-babel-clean-text-properties (match-string 2))) + (lang-headers (intern (concat "org-babel-default-header-args:" lang))) + (switches (match-string 3)) + (body (org-babel-clean-text-properties (match-string 5))) + (preserve-indentation (or org-src-preserve-indentation + (string-match "-i\\>" switches)))) + (list lang + ;; get block body less properties, protective commas, and indentation + (with-temp-buffer + (save-match-data + (insert (org-babel-strip-protective-commas body)) + (unless preserve-indentation (org-do-remove-indentation)) + (buffer-string))) + (org-babel-merge-params + org-babel-default-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties lang) + (if (boundp lang-headers) (eval lang-headers) nil) + (org-babel-parse-header-arguments + (org-babel-clean-text-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-babel-clean-text-properties (match-string 2))) + (lang-headers (intern (concat "org-babel-default-header-args:" lang)))) + (list lang + (org-babel-strip-protective-commas + (org-babel-clean-text-properties (match-string 5))) + (org-babel-merge-params + org-babel-default-inline-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties lang) + (if (boundp lang-headers) (eval lang-headers) nil) + (org-babel-parse-header-arguments + (org-babel-clean-text-properties (or (match-string 4) ""))))))) + +(defun org-babel-parse-header-arguments (arg-string) + "Parse a string of header arguments returning an alist." + (if (> (length arg-string) 0) + (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 (concat ":" (match-string 1 arg))) + (let ((raw (org-babel-chomp (match-string 2 arg)))) + (if (org-babel-number-p raw) + raw (org-babel-read raw)))) + (cons (intern (concat ":" arg)) nil))) + (split-string (concat " " arg-string) "[ \f\t\n\r\v]+:" t))))) + +(defun org-babel-process-params (params) + "Parse params and resolve references. + +Return a list (session vars result-params result-type colnames rownames)." + (let* ((session (cdr (assoc :session params))) + (vars-and-names (org-babel-disassemble-tables + (org-babel-ref-variables params) + (cdr (assoc :hlines params)) + (cdr (assoc :colnames params)) + (cdr (assoc :rownames params)))) + (vars (car vars-and-names)) + (colnames (cadr vars-and-names)) + (rownames (caddr vars-and-names)) + (result-params (split-string (or (cdr (assoc :results params)) ""))) + (result-type (cond ((member "output" result-params) 'output) + ((member "value" result-params) 'value) + (t 'value)))) + (list session vars result-params result-type colnames rownames))) + +;; 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." + (flet ((trans (table) (apply #'mapcar* #'list table))) + (let* ((width (apply 'max (mapcar (lambda (el) (if (listp el) (length el) 0)) table))) + (table (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)) + (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." + (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) + cnames 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)) top bottom) + (or + (save-excursion ;; on a source name line + (beginning-of-line 1) + (and (looking-at org-babel-src-name-regexp) (forward-line 1) + (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-named-src-block (name) + "Go to a named source-code block." + (interactive + (let ((completion-ignore-case t)) + (list (org-icompleting-read "source-block name: " + (org-babel-src-block-names) nil t)))) + (let ((point (org-babel-find-named-block name))) + (if point + ;; taken from `org-open-at-point' + (progn (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 (names) + (while (re-search-forward org-babel-src-name-w-name-regexp nil t) + (setq names (cons (org-babel-clean-text-properties (match-string 2)) + 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) + "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 + (goto-char (point-min)) + (when (re-search-forward + (concat org-babel-result-regexp + "[ \t]" (regexp-quote name) "[ \t\n\f\v\r]") nil t) + (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 (names) + (while (re-search-forward org-babel-result-w-name-regexp nil t) + (setq names (cons (org-babel-clean-text-properties (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)) + (re-search-forward org-babel-src-block-regexp nil nil (or arg 1)) + (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") + (re-search-backward org-babel-src-block-regexp nil nil (or arg 1)) + (goto-char (match-beginning 0)) (org-show-context)) + +(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* ((on-lob-line (progn (beginning-of-line 1) + (looking-at org-babel-lob-one-liner-regexp))) + (name (if on-lob-line + (nth 0 (org-babel-lob-get-info)) + (nth 4 (or info (org-babel-get-src-block-info))))) + (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 + (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) " ") + (number-sequence 1 indent) "") + "") + "#+results" + (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)) + ((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 #'org-babel-read row))) + (org-table-to-lisp))) + +(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-babel-clean-text-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-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 + +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. + +org ----- this is the same as the 'raw' option + +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-babel-clean-text-properties result)) + (when (member "file" result-params) + (setq result (org-babel-result-to-file result)))) + (unless (listp result) (setq result (format "%S" result)))) + (if (= (length result) 0) + (if (member "value" result-params) + (message "No result returned by source block") + (message "Source block produced no output")) + (if (and result-params (member "silent" result-params)) + (progn + (message (replace-regexp-in-string "%" "%%" (format "%S" result))) + result) + (when (and (stringp result) ;; ensure results end in a newline + (not (or (string-equal (substring result -1) "\n") + (string-equal (substring result -1) "\r")))) + (setq result (concat result "\n"))) + (save-excursion + (let ((existing-result (org-babel-where-is-src-block-result + t info hash indent)) + (results-switches + (cdr (assoc :results_switches (nth 2 info)))) + beg end) + (when existing-result + (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))) + ((member "prepend" result-params) ;; already there + ))) + (setq results-switches + (if results-switches (concat " " results-switches) "")) + (cond + ;; assume the result is a table if it's not a string + ((not (stringp result)) + (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))) + ((member "file" result-params) + (insert result)) + ((member "html" result-params) + (insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n" + results-switches result))) + ((member "latex" result-params) + (insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n" + results-switches result))) + ((member "code" result-params) + (insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n" + (or lang "none") results-switches result))) + ((or (member "raw" result-params) (member "org" result-params)) + (save-excursion (insert result)) (if (org-at-table-p) (org-cycle))) + (t + (org-babel-examplize-region + (point) (progn (insert result) (point)) results-switches))) + ;; possibly indent the results to match the #+results line + (setq end (if (listp result) (org-table-end) (point))) + (when (and 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)))) + (message "finished")))) + +(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 + (save-excursion + (goto-char location) (setq start (point)) (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 + (if (org-at-table-p) + (progn (goto-char (org-table-end)) (point)) + (let ((case-fold-search t)) + (cond + ((looking-at "[ \t]*#\\+begin_latex") + (re-search-forward "[ \t]*#\\+end_latex" nil t) + (forward-line 1)) + ((looking-at "[ \t]*#\\+begin_html") + (re-search-forward "[ \t]*#\\+end_html" nil t) + (forward-line 1)) + ((looking-at "[ \t]*#\\+begin_example") + (re-search-forward "[ \t]*#\\+end_example" nil t) + (forward-line 1)) + ((looking-at "[ \t]*#\\+begin_src") + (re-search-forward "[ \t]*#\\+end_src" nil t) + (forward-line 1)) + (t (progn (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)") + (forward-line 1)))))) + (point)))) + +(defun org-babel-result-to-file (result) + "Convert RESULT into an `org-mode' link. +If the `default-directory' is different from the containing +file's directory then expand relative links." + (format + "[[file:%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))) + +(defun org-babel-examplize-region (beg end &optional results-switches) + "Comment out region using the ': ' org example quote." + (interactive "*r") + (let ((size (count-lines beg end))) + (save-excursion + (cond ((= size 0) + (error (concat "This should be impossible:" + "a newline was appended to result if missing"))) + ((< 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 "#+begin_example%s\n" results-switches) + "#+begin_example\n")) + (forward-char (- end beg)) + (insert "#+end_example\n")))))) + +(defun org-babel-merge-params (&rest plists) + "Combine all parameter association lists in PLISTS. +Later elements of PLISTS override the values of previous element. +This takes into account some special considerations for certain +parameters when merging lists." + (let ((results-exclusive-groups + '(("file" "vector" "table" "scalar" "raw" "org" + "html" "latex" "code" "pp") + ("replace" "silent" "append" "prepend") + ("output" "value"))) + (exports-exclusive-groups + '(("code" "results" "both" "none"))) + params results exports tangle noweb cache vars var ref shebang comments) + (flet ((e-merge (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))) + (mapc (lambda (plist) + (mapc (lambda (pair) + (case (car pair) + (:var + ;; we want only one specification per variable + (when (string-match + (concat "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" + "[ \t]*\\([^\f\n\r\v]+\\)$") (cdr pair)) + ;; TODO: When is this not true? + (setq var (intern (match-string 1 (cdr pair))) + ref (match-string 2 (cdr pair)) + vars (cons (cons var ref) + (assq-delete-all var vars))))) + (:results + (setq results + (e-merge results-exclusive-groups + results (split-string (cdr pair))))) + (:file + (when (cdr pair) + (setq results (e-merge results-exclusive-groups + results '("file"))) + (unless (or (member "both" exports) + (member "none" exports) + (member "code" exports)) + (setq exports (e-merge exports-exclusive-groups + exports '("results")))) + (setq params + (cons pair + (assq-delete-all (car pair) params))))) + (:exports + (setq exports + (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 + (e-merge '(("yes" "no")) noweb + (split-string (or (cdr pair) ""))))) + (:cache + (setq cache + (e-merge '(("yes" "no")) cache + (split-string (or (cdr pair) ""))))) + (:shebang ;; take the latest -- always overwrite + (setq shebang (or (list (cdr pair)) shebang))) + (:comments + (setq comments + (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 (mapcar (lambda (pair) (format "%s=%s" (car pair) (cdr pair))) vars)) + (while vars (setq params (cons (cons :var (pop vars)) params))) + (cons (cons :comments (mapconcat 'identity comments " ")) + (cons (cons :shebang (mapconcat 'identity shebang " ")) + (cons (cons :cache (mapconcat 'identity cache " ")) + (cons (cons :noweb (mapconcat 'identity noweb " ")) + (cons (cons :tangle (mapconcat 'identity tangle " ")) + (cons (cons :exports + (mapconcat 'identity exports " ")) + (cons + (cons :results + (mapconcat 'identity results " ")) + 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'. + +<<example-block>> + +Note that any text preceding the <<foo>> construct on a line will +be interposed between the lines of the replacement text. So for +example if <<foo>> 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'. + +<<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 + +<<example-block(a=9)>> + +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)) + (new-body "") index source-name evaluate prefix) + (flet ((nb-add (text) + (setq new-body (concat new-body text)))) + (with-temp-buffer + (insert body) (goto-char (point-min)) + (setq index (point)) + (while (and (re-search-forward "<<\\(.+?\\)>>" 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)) + (nb-add (buffer-substring index (point))) + (goto-char (match-end 0)) + (setq index (point)) + (nb-add (with-current-buffer parent-buffer + (mapconcat ;; interpose PREFIX between every line + #'identity + (split-string + (if evaluate + (let ((raw (org-babel-ref-resolve-reference + source-name nil))) + (if (stringp raw) raw (format "%S" raw))) + (save-restriction + (widen) + (let ((point (org-babel-find-named-block + source-name))) + (if point + (save-excursion + (goto-char point) + (org-babel-trim + (org-babel-expand-noweb-references + (org-babel-get-src-block-info)))) + ;; optionally raise an error if named + ;; source-block doesn't exist + (if (member lang org-babel-noweb-error-langs) + (error "%s" + (concat + "<<" source-name ">> " + "could not be resolved (see " + "`org-babel-noweb-error-langs')")) + ""))))) + "[\n\r]") (concat "\n" prefix))))) + (nb-add (buffer-substring index (point-max))))) + new-body)) + +(defun org-babel-clean-text-properties (text) + "Strip all properties from text return." + (when text + (set-text-properties 0 (length text) nil text) text)) + +(defun org-babel-strip-protective-commas (body) + "Strip protective commas from bodies of source blocks." + (replace-regexp-in-string "^,#" "#" body)) + +(defun org-babel-read (cell) + "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. + +This is taken almost directly from `org-read-prop'." + (if (and (stringp cell) (not (equal cell ""))) + (or (org-babel-number-p cell) + (if (or (equal "(" (substring cell 0 1)) + (equal "'" (substring cell 0 1)) + (equal "`" (substring cell 0 1))) + (eval (read cell)) + (progn (set-text-properties 0 (length cell) nil cell) cell))) + cell)) + +(defun org-babel-number-p (string) + "Return t if STRING represents a number." + (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) + "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 nil + (progn + (org-table-import file-name nil) + (delete-file file-name) + (setq result (mapcar (lambda (row) + (mapcar #'org-babel-string-read row)) + (org-table-to-lisp)))) + (error 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))) + +(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-maybe-remote-file (file) + "Conditionally parse information on a remote connnection. +If FILE specifies a remove file, then parse the information on +the remote connection." + (if (file-remote-p default-directory) + (let* ((vec (tramp-dissect-file-name default-directory)) + (user (tramp-file-name-user vec)) + (host (tramp-file-name-host vec))) + (concat "/" user (when user "@") host ":" file)) + file)) + +(provide 'ob) + +;; arch-tag: 01a7ebee-06c5-4ee4-a709-e660d28c0af1 + +;;; ob.el ends here diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 07bb0b4681c..a3d288065d3 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -32,8 +32,7 @@ (require 'org) (eval-when-compile - (require 'cl) - (require 'calendar)) + (require 'cl)) (declare-function diary-add-to-list "diary-lib" (date string specifier &optional marker globcolor literal)) @@ -143,8 +142,8 @@ specifies the maximum number of lines that will be added for each entry that is listed in the agenda view. Note that this variable is not used during display, only when exporting -the agenda. For agenda display, see org-agenda-entry-text-mode and the -variable `org-agenda-entry-text-maxlines'." +the agenda. For agenda display, see the variables `org-agenda-entry-text-mode' +and `org-agenda-entry-text-maxlines'." :group 'org-agenda :type 'integer) @@ -198,6 +197,11 @@ you can \"misuse\" it to also add other text to the header. However, :group 'org-export-html :type 'string) +(defcustom org-agenda-persistent-filter nil + "When set, keep filters from one agenda view to the next." + :group 'org-agenda + :type 'boolean) + (defgroup org-agenda-custom-commands nil "Options concerning agenda views in Org-mode." :tag "Org Agenda Custom Commands" @@ -212,6 +216,7 @@ you can \"misuse\" it to also add other text to the header. However, (const todo-state-up) (const todo-state-down) (const effort-up) (const effort-down) (const habit-up) (const habit-down) + (const alpha-up) (const alpha-down) (const user-defined-up) (const user-defined-down)) "Sorting choices.") @@ -590,7 +595,7 @@ to make his option also apply to the tags-todo list." There are different motivations for using different values, please think carefully when configuring this variable. -This applie when creating the global todo list. +This applies when creating the global todo list. Valid values are: near Don't show near deadline entries. A deadline is near when it is @@ -757,7 +762,7 @@ Needs to be set before org.el is loaded." :type 'boolean) (defcustom org-agenda-start-with-follow-mode nil - "The initial value of follow-mode in a newly created agenda window." + "The initial value of follow mode in a newly created agenda window." :group 'org-agenda-startup :type 'boolean) @@ -1003,7 +1008,7 @@ When this is non-nil, the string will be split on whitespace, and each snippet will be searched individually, and all must match in order to select an entry. A snippet is then a single string of non-white characters, or a string in double quotes, or a regexp in {} braces. -If a snippet is preceeded by \"-\", the snippet must *not* match. +If a snippet is preceded by \"-\", the snippet must *not* match. \"+\" is syntactic sugar for positive selection. Each snippet may be found as a full word or a partial word, but see the variable `org-agenda-search-view-force-full-words'. @@ -1013,7 +1018,7 @@ with each space character matching any amount of whitespace, including line breaks. Even when this is nil, you can still switch to Boolean search dynamically -by preceeding the first snippet with \"+\" or \"-\". If the first snippet +by preceding the first snippet with \"+\" or \"-\". If the first snippet is a regexp marked with braces like \"{abc}\", this will also switch to boolean search." :group 'org-agenda-search-view @@ -1024,8 +1029,7 @@ boolean search." 'org-agenda-search-view-always-boolean)) (defcustom org-agenda-search-view-force-full-words nil - "Non-nil me -ans, search words must be matches as complete words. + "Non-nil means, search words must be matches as complete words. When nil, they may also match part of a word." :group 'org-agenda-search-view :type 'boolean) @@ -1121,6 +1125,8 @@ user-defined-up Sort according to `org-agenda-cmp-user-defined', high last. user-defined-down Sort according to `org-agenda-cmp-user-defined', high first. habit-up Put entries that are habits first habit-down Put entries that are habits last +alpha-up Sort headlines alphabetically +alpha-down Sort headlines alphabetically, reversed The different possibilities will be tried in sequence, and testing stops if one comparison returns a \"not-equal\". For example, the default @@ -1279,7 +1285,7 @@ range, respectively." (function)))) (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") - "Text preceeding scheduled items in the agenda view. + "Text preceding scheduled items in the agenda view. This is a list with two strings. The first applies when the item is scheduled on the current day. The second applies when it has been scheduled previously, it may contain a %d indicating that this is the nth time that @@ -1292,7 +1298,7 @@ that passed since this item was scheduled first." (string :tag "Scheduled previously"))) (defcustom org-agenda-inactive-leader "[" - "Text preceeding item pulled into the agenda by inactive time stamps. + "Text preceding item pulled into the agenda by inactive time stamps. These entries are added to the agenda when pressing \"[\"." :group 'org-agenda-line-format :type '(list @@ -1300,7 +1306,7 @@ These entries are added to the agenda when pressing \"[\"." (string :tag "Scheduled previously"))) (defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: ") - "Text preceeding deadline items in the agenda view. + "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 @@ -1321,7 +1327,7 @@ placed into the prefix. If this option is non-nil, the original specification 11:30-4pm) will be removed for agenda display. This makes the agenda less cluttered. The option can be t or nil. It may also be the symbol `beg', indicating -that the time should only be removed what it is located at the beginning of +that the time should only be removed when it is located at the beginning of the headline/diary entry." :group 'org-agenda-line-format :type '(choice @@ -1329,6 +1335,11 @@ the headline/diary entry." (const :tag "Never" nil) (const :tag "When at beginning of entry" beg))) +(defcustom org-agenda-remove-timeranges-from-blocks nil + "Non-nil means remove time ranges specifications in agenda +items that span on several days." + :group 'org-agenda-line-format + :type 'boolean) (defcustom org-agenda-default-appointment-duration nil "Default duration for appointments that only have a starting time. @@ -1347,7 +1358,7 @@ When non-nil, this must be the number of minutes, e.g. 60 for one hour." (defcustom org-agenda-hide-tags-regexp nil "Regular expression used to filter away specific tags in agenda views. This means that these tags will be present, but not be shown in the agenda -line. Secondayt filltering will still work on the hidden tags. +line. Secondary filtering will still work on the hidden tags. Nil means don't hide any tags." :group 'org-agenda-line-format :type '(choice @@ -1382,7 +1393,7 @@ it means that the tags should be flushright to that column. For example, (defcustom org-agenda-fontify-priorities 'cookies "Non-nil means highlight low and high priorities in agenda. When t, the highest priority entries are bold, lowest priority italic. -However, settings in org-priority-faces will overrule these faces. +However, settings in `org-priority-faces' will overrule these faces. When this variable is the symbol `cookies', only fontify the cookies, not the entire task. This may also be an association list of priority faces, whose @@ -1485,7 +1496,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (defvar org-agenda-redo-command nil) (defvar org-agenda-query-string nil) (defvar org-agenda-mode-hook nil - "Hook for org-agenda-mode, run after the mode is turned on.") + "Hook for `org-agenda-mode', run after the mode is turned on.") (defvar org-agenda-type nil) (defvar org-agenda-force-single-file nil) (defvar org-agenda-bulk-marked-entries) ;; Defined further down in this file @@ -1663,10 +1674,8 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) -(org-defkey org-agenda-mode-map - (if (featurep 'xemacs) [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) -(org-defkey org-agenda-mode-map - (if (featurep 'xemacs) [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) +(org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse) +(org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse) (when org-agenda-mouse-1-follows-link (org-defkey org-agenda-mode-map [follow-link] 'mouse-face)) (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" @@ -1967,7 +1976,6 @@ Pressing `<' twice means to restrict to the current subtree or region (move-marker org-agenda-restrict-end (progn (org-end-of-subtree t))))))) - (require 'calendar) ; FIXME: can we avoid this for some commands? ;; For example the todo list should not need it (but does...) (cond ((setq entry (assoc keys org-agenda-custom-commands)) @@ -2256,7 +2264,7 @@ s Search for keywords C Configure custom agenda commands If CMD-KEY is a string of length 1, it is used as a key in `org-agenda-custom-commands' and triggers this command. If it is a longer string it is used as a tags/todo match string. -Paramters are alternating variable names and values that will be bound +Parameters are alternating variable names and values that will be bound before running the agenda command." (let (pars) (while parameters @@ -2284,7 +2292,7 @@ before running the agenda command." If CMD-KEY is a string of length 1, it is used as a key in `org-agenda-custom-commands' and triggers this command. If it is a longer string it is used as a tags/todo match string. -Paramters are alternating variable names and values that will be bound +Parameters are alternating variable names and values that will be bound before running the agenda command. The output gives a line for each selected agenda item. Each @@ -2339,8 +2347,8 @@ agenda-day The day in the agenda where this is listed" (princ "\n")))))) (defun org-fix-agenda-info (props) - "Make sure all properties on an agenda item have a canonical form, -so the export commands can easily use it." + "Make sure all properties on an agenda item have a canonical form. +This ensures the export commands can easily use it." (let (tmp re) (when (setq tmp (plist-get props 'tags)) (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) @@ -2446,7 +2454,7 @@ higher priority settings." ((string-match "\\.html?\\'" file) (require 'htmlize)) ((string-match "\\.ps\\'" file) (require 'ps-print))) (org-let (if nosettings nil org-agenda-exporter-settings) - '(save-excursion + `(save-excursion (save-window-excursion (org-agenda-mark-filtered-text) (let ((bs (copy-sequence (buffer-string))) beg) @@ -2478,14 +2486,14 @@ higher priority settings." (message "HTML written to %s" file)) ((string-match "\\.ps\\'" file) (require 'ps-print) - (flet ((ps-get-buffer-name () "Agenda View")) - (ps-print-buffer-with-faces file)) + ,(flet ((ps-get-buffer-name () "Agenda View")) + (ps-print-buffer-with-faces file)) (message "Postscript written to %s" file)) ((string-match "\\.pdf\\'" file) (require 'ps-print) - (flet ((ps-get-buffer-name () "Agenda View")) - (ps-print-buffer-with-faces - (concat (file-name-sans-extension file) ".ps"))) + ,(flet ((ps-get-buffer-name () "Agenda View")) + (ps-print-buffer-with-faces + (concat (file-name-sans-extension file) ".ps"))) (call-process "ps2pdf" nil nil nil (expand-file-name (concat (file-name-sans-extension file) ".ps")) @@ -2518,9 +2526,9 @@ higher priority settings." (let ((inhibit-read-only t)) (mapc (lambda (o) - (when (equal (org-overlay-buffer o) (current-buffer)) + (when (equal (overlay-buffer o) (current-buffer)) (put-text-property - (org-overlay-start o) (org-overlay-end o) + (overlay-start o) (overlay-end o) 'org-filtered t))) org-agenda-filter-overlays))) @@ -2706,7 +2714,7 @@ removed from the entry content. Currently only `planning' is allowed here." (defvar org-agenda-filter nil) (defvar org-agenda-filter-preset nil "A preset of the tags filter used for secondary agenda filtering. -This must be a list of strings, each string must be a single tag preceeded +This must be a list of strings, each string must be a single tag preceded by \"+\" or \"-\". This variable should not be set directly, but agenda custom commands can bind it in the options section.") @@ -2715,7 +2723,8 @@ bind it in the options section.") (setq org-todo-keywords-for-agenda nil) (setq org-done-keywords-for-agenda nil) (setq org-drawers-for-agenda nil) - (setq org-agenda-filter nil) + (unless org-agenda-persistent-filter + (setq org-agenda-filter nil)) (put 'org-agenda-filter :preset-filter org-agenda-filter-preset) (if org-agenda-multi (progn @@ -2790,16 +2799,16 @@ bind it in the options section.") (org-habit-insert-consistency-graphs)) (run-hooks 'org-finalize-agenda-hook) (setq org-agenda-type (org-get-at-bol 'org-agenda-type)) - (when (get 'org-agenda-filter :preset-filter) + (when (or org-agenda-filter (get 'org-agenda-filter :preset-filter)) (org-agenda-filter-apply org-agenda-filter)) ))) (defun org-agenda-mark-clocking-task () "Mark the current clock entry in the agenda if it is present." (mapc (lambda (o) - (if (eq (org-overlay-get o 'type) 'org-agenda-clocking) - (org-delete-overlay o))) - (org-overlays-in (point-min) (point-max))) + (if (eq (overlay-get o 'type) 'org-agenda-clocking) + (delete-overlay o))) + (overlays-in (point-min) (point-max))) (when (marker-buffer org-clock-hd-marker) (save-excursion (goto-char (point-min)) @@ -2808,18 +2817,18 @@ bind it in the options section.") (goto-char s) (when (equal (org-get-at-bol 'org-hd-marker) org-clock-hd-marker) - (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-eol)))) - (org-overlay-put ov 'type 'org-agenda-clocking) - (org-overlay-put ov 'face 'org-agenda-clocking) - (org-overlay-put ov 'help-echo + (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol)))) + (overlay-put ov 'type 'org-agenda-clocking) + (overlay-put ov 'face 'org-agenda-clocking) + (overlay-put ov 'help-echo "The clock is running in this item"))))))) (defun org-agenda-fontify-priorities () "Make highest priority lines bold, and lowest italic." (interactive) - (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-priority) - (org-delete-overlay o))) - (org-overlays-in (point-min) (point-max))) + (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-priority) + (delete-overlay o))) + (overlays-in (point-min) (point-max))) (save-excursion (let ((inhibit-read-only t) b e p ov h l) @@ -2834,8 +2843,8 @@ bind it in the options section.") e (if (eq org-agenda-fontify-priorities 'cookies) (match-end 0) (point-at-eol)) - ov (org-make-overlay b e)) - (org-overlay-put + ov (make-overlay b e)) + (overlay-put ov 'face (cond ((org-face-from-face-or-color 'priority nil @@ -2846,13 +2855,13 @@ bind it in the options section.") (cdr (assoc p org-agenda-fontify-priorities))))) ((equal p l) 'italic) ((equal p h) 'bold))) - (org-overlay-put ov 'org-type 'org-priority))))) + (overlay-put ov 'org-type 'org-priority))))) (defun org-agenda-dim-blocked-tasks () "Dim currently blocked TODO's in the agenda display." - (mapc (lambda (o) (if (eq (org-overlay-get o 'org-type) 'org-blocked-todo) - (org-delete-overlay o))) - (org-overlays-in (point-min) (point-max))) + (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo) + (delete-overlay o))) + (overlays-in (point-min) (point-max))) (save-excursion (let ((inhibit-read-only t) (org-depend-tag-blocked nil) @@ -2881,11 +2890,11 @@ bind it in the options section.") (max (point-min) (1- (point-at-bol))) (point-at-bol)) e (point-at-eol) - ov (org-make-overlay b e)) + ov (make-overlay b e)) (if invis1 - (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'face 'org-agenda-dimmed-todo-face)) - (org-overlay-put ov 'org-type 'org-blocked-todo))))))) + (overlay-put ov 'invisible t) + (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) + (overlay-put ov 'org-type 'org-blocked-todo))))))) (defvar org-agenda-skip-function nil "Function to be called at each match during agenda construction. @@ -2896,7 +2905,7 @@ This may also be a Lisp form, it will be evaluated. Never set this variable using `setq' or so, 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.") +it is through options in `org-agenda-custom-commands'.") (defun org-agenda-skip () "Throw to `:skip' in places that should be skipped. @@ -2958,10 +2967,10 @@ no longer in use." (org-agenda-get-some-entry-text m org-agenda-entry-text-maxlines " > ")))) (when (string-match "\\S-" txt) - (setq o (org-make-overlay (point-at-bol) (point-at-eol))) - (org-overlay-put o 'evaporate t) - (org-overlay-put o 'org-overlay-type 'agenda-entry-content) - (org-overlay-put o 'after-string txt)))) + (setq o (make-overlay (point-at-bol) (point-at-eol))) + (overlay-put o 'evaporate t) + (overlay-put o 'org-overlay-type 'agenda-entry-content) + (overlay-put o 'after-string txt)))) (defun org-agenda-entry-text-show () "Add entry context for all agenda lines." @@ -2978,10 +2987,10 @@ no longer in use." "Remove any shown entry context." (delq nil (mapcar (lambda (o) - (if (eq (org-overlay-get o 'org-overlay-type) + (if (eq (overlay-get o 'org-overlay-type) 'agenda-entry-content) - (progn (org-delete-overlay o) t))) - (org-overlays-in (point-min) (point-max))))) + (progn (delete-overlay o) t))) + (overlays-in (point-min) (point-max))))) ;;; Agenda timeline @@ -2995,7 +3004,6 @@ under the current date. If the buffer contains an active region, only check the region for dates." (interactive "P") - (require 'calendar) (org-compile-prefix-format 'timeline) (org-set-sorting-strategy 'timeline) (let* ((dopast t) @@ -3127,7 +3135,7 @@ When EMPTY is non-nil, also include days without any entries." (defvar org-agenda-start-day nil ; dynamically scoped parameter "Custom commands can set this variable in the options section.") (defvar org-agenda-last-arguments nil - "The arguments of the previous call to org-agenda") + "The arguments of the previous call to `org-agenda'.") (defvar org-starting-day nil) ; local variable in the agenda buffer (defvar org-agenda-span nil) ; local variable in the agenda buffer (defvar org-include-all-loc nil) ; local variable @@ -3197,7 +3205,6 @@ given in `org-agenda-start-on-weekday'." (setq org-agenda-last-arguments (list include-all start-day ndays)) (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) - (require 'calendar) (let* ((org-agenda-start-on-weekday (if (or (equal ndays 7) (and (null ndays) (equal 7 org-agenda-ndays))) org-agenda-start-on-weekday nil)) @@ -3400,7 +3407,7 @@ is, or it can be broken into a number of snippets, each of which must match in a Boolean way to select an entry. The default depends on the variable `org-agenda-search-view-always-boolean'. Even if this is turned off (the default) you can always switch to -Boolean search dynamically by preceeding the first word with \"+\" or \"-\". +Boolean search dynamically by preceding the first word with \"+\" or \"-\". The default is a direct search of the whole phrase, where each space in the search string can expand to an arbitrary amount of whitespace, @@ -3415,9 +3422,9 @@ match whole words, not parts of a word) if `org-agenda-search-view-force-full-words' is set (default is nil). Boolean search snippets enclosed by curly braces are interpreted as -regular expressions that must or (when preceeded with \"-\") must not +regular expressions that must or (when preceded with \"-\") must not match in the entry. Snippets enclosed into double quotes will be taken -as a whole, to incude whitespace. +as a whole, to include whitespace. - If the search string starts with an asterisk, search only in headlines. - If (possibly after the leading star) the search string starts with an @@ -3441,6 +3448,7 @@ in `org-agenda-text-search-extra-files'." 'mouse-face 'highlight 'help-echo (format "mouse-2 or RET jump to location"))) (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 marker category tags c neg re boolean ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) @@ -3618,13 +3626,12 @@ in `org-agenda-text-search-extra-files'." ;;;###autoload (defun org-todo-list (arg) - "Show all TODO entries from all agenda file in a single list. + "Show all (not done) TODO entries from all agenda file in a single list. The prefix arg can be used to select a specific TODO keyword and limit the list to these. When using \\[universal-argument], you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in `org-todo-keywords-1'." (interactive "P") - (require 'calendar) (org-compile-prefix-format 'todo) (org-set-sorting-strategy 'todo) (org-prepare-agenda "TODO") @@ -3771,7 +3778,7 @@ This variable should not be set directly, but custom commands can bind it in the options section.") (defun org-agenda-skip-entry-when-regexp-matches () - "Checks if the current entry contains match for `org-agenda-skip-regexp'. + "Check if the current entry contains match for `org-agenda-skip-regexp'. If yes, it returns the end position of this entry, causing agenda commands to skip the entry but continuing the search in the subtree. This is a function that can be put into `org-agenda-skip-function' for the duration @@ -3783,7 +3790,7 @@ of a command." (and skip end))) (defun org-agenda-skip-subtree-when-regexp-matches () - "Checks if the current subtree contains match for `org-agenda-skip-regexp'. + "Check if the current subtree contains match for `org-agenda-skip-regexp'. If yes, it returns the end position of this tree, causing agenda commands to skip this subtree. This is a function that can be put into `org-agenda-skip-function' for the duration of a command." @@ -3794,7 +3801,7 @@ to skip this subtree. This is a function that can be put into (and skip end))) (defun org-agenda-skip-entry-when-regexp-matches-in-subtree () - "Checks if the current subtree contains match for `org-agenda-skip-regexp'. + "Check if the current subtree contains match for `org-agenda-skip-regexp'. If yes, it returns the end position of the current entry (NOT the tree), causing agenda commands to skip the entry but continuing the search in the subtree. This is a function that can be put into @@ -4342,7 +4349,7 @@ the documentation of `org-diary'." clockp (and org-agenda-include-inactive-timestamps (or (string-match org-clock-string tmp) (string-match "]-+\\'" tmp))) - todo-state (org-get-todo-state) + todo-state (ignore-errors (org-get-todo-state)) donep (member todo-state org-done-keywords)) (if (or scheduledp deadlinep closedp clockp (and donep org-agenda-skip-timestamp-if-done)) @@ -4423,7 +4430,7 @@ the documentation of `org-diary'." "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS. The order of the first 2 times 3 arguments depends on the variable `calendar-date-style' or, if that is not defined, on `european-calendar-style'. -So for american calendars, give this as MONTH DAY YEAR, for european as +So for American calendars, give this as MONTH DAY YEAR, for European as DAY MONTH YEAR, and for ISO as YEAR MONTH DAY. DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS is any number of ISO weeks in the block period for which the item should @@ -4500,15 +4507,15 @@ be skipped." (setq clocked (match-string 2 rest))) (setq clocked "-"))) (save-excursion + (setq extra nil) (cond - ((not org-agenda-log-mode-add-notes) (setq extra nil)) + ((not org-agenda-log-mode-add-notes)) (statep (and (looking-at ".*\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$") (setq extra (match-string 1)))) (clockp (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") - (setq extra (match-string 1)))) - (t (setq extra nil))) + (setq extra (match-string 1))))) (if (not (re-search-backward "^\\*+ " nil t)) (setq txt org-agenda-no-heading-message) (goto-char (match-beginning 0)) @@ -4788,13 +4795,20 @@ FRACTION is what fraction of the head-warning time has passed." (setq tags (org-get-tags-at)) (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") (setq head (match-string 1)) - (setq txt (org-format-agenda-item - (format - (nth (if (= d1 d2) 0 1) - org-agenda-timerange-leaders) - (1+ (- d0 d1)) (1+ (- d2 d1))) - head category tags - timestr))) + (let ((remove-re + (if org-agenda-remove-timeranges-from-blocks + (concat + "<" (regexp-quote s1) ".*?>" + "--" + "<" (regexp-quote s2) ".*?>") + nil))) + (setq txt (org-format-agenda-item + (format + (nth (if (= d1 d2) 0 1) + org-agenda-timerange-leaders) + (1+ (- d0 d1)) (1+ (- d2 d1))) + head category tags + timestr nil remove-re)))) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date @@ -4817,9 +4831,9 @@ The flag is set if the currently compiled format contains a `%T'.") "A flag, set by `org-compile-prefix-format'. The flag is set if the currently compiled format contains a `%e'.") (defvar org-prefix-category-length nil - "Used by `org-compile-prefix-format' to remember the category field widh.") + "Used by `org-compile-prefix-format' to remember the category field width.") (defvar org-prefix-category-max-length nil - "Used by `org-compile-prefix-format' to remember the category field widh.") + "Used by `org-compile-prefix-format' to remember the category field width.") (defun org-format-agenda-item (extra txt &optional category tags dotime noprefix remove-re habitp) @@ -5160,11 +5174,12 @@ HH:MM." (or (match-end 1) (match-end 0)) (match-end 0) (list 'face (org-get-todo-face (match-string 2 x))) x) - (setq x (concat (substring x 0 (match-end 1)) - (format org-agenda-todo-keyword-format - (match-string 2 x)) - (org-add-props " " (text-properties-at 0 x)) - (substring x (match-end 3))))) + (when (match-end 1) + (setq x (concat (substring x 0 (match-end 1)) + (format org-agenda-todo-keyword-format + (match-string 2 x)) + (org-add-props " " (text-properties-at 0 x)) + (substring x (match-end 3)))))) x))) (defsubst org-cmp-priority (a b) @@ -5215,6 +5230,28 @@ HH:MM." ((< lb la) +1) (t nil)))) +(defsubst org-cmp-alpha (a b) + "Compare the headlines, alphabetically." + (let* ((pla (get-text-property 0 'prefix-length a)) + (plb (get-text-property 0 'prefix-length b)) + (ta (and pla (substring a pla))) + (tb (and plb (substring b plb)))) + (when pla + (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "") + "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta) + (setq ta (substring ta (match-end 0)))) + (setq ta (downcase ta))) + (when plb + (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "") + "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") tb) + (setq tb (substring tb (match-end 0)))) + (setq tb (downcase tb))) + (cond ((not ta) +1) + ((not tb) -1) + ((string-lessp ta tb) -1) + ((string-lessp tb ta) +1) + (t nil)))) + (defsubst org-cmp-tag (a b) "Compare the string values of the first tags of A and B." (let ((ta (car (last (get-text-property 1 'tags a)))) @@ -5242,25 +5279,39 @@ HH:MM." ((and (not ha) hb) +1) (t nil)))) +(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* ((time-up (org-cmp-time a b)) - (time-down (if time-up (- time-up) nil)) - (priority-up (org-cmp-priority a b)) - (priority-down (if priority-up (- priority-up) nil)) - (effort-up (org-cmp-effort a b)) - (effort-down (if effort-up (- effort-up) nil)) - (category-up (org-cmp-category a b)) - (category-down (if category-up (- category-up) nil)) - (category-keep (if category-up +1 nil)) - (tag-up (org-cmp-tag a b)) - (tag-down (if tag-up (- tag-up) nil)) - (todo-state-up (org-cmp-todo-state a b)) + (let* ((ss org-agenda-sorting-strategy-selected) + (time-up (and (org-em 'time-up 'time-down ss) + (org-cmp-time a b))) + (time-down (if time-up (- time-up) nil)) + (priority-up (and (org-em 'priority-up 'priority-down ss) + (org-cmp-priority a b))) + (priority-down (if priority-up (- priority-up) nil)) + (effort-up (and (org-em 'effort-up 'effort-down ss) + (org-cmp-effort a b))) + (effort-down (if effort-up (- effort-up) nil)) + (category-up (and (or (org-em 'category-up 'category-down ss) + (memq 'category-keep ss)) + (org-cmp-category a b))) + (category-down (if category-up (- category-up) nil)) + (category-keep (if category-up +1 nil)) + (tag-up (and (org-em 'tag-up 'tag-down ss) + (org-cmp-tag a b))) + (tag-down (if tag-up (- tag-up) nil)) + (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss) + (org-cmp-todo-state a b))) (todo-state-down (if todo-state-up (- todo-state-up) nil)) - (habit-up (org-cmp-habit-p a b)) - (habit-down (if habit-up (- habit-up) nil)) + (habit-up (and (org-em 'habit-up 'habit-down ss) + (org-cmp-habit-p a b))) + (habit-down (if habit-up (- habit-up) nil)) + (alpha-up (and (org-em 'alpha-up 'alpha-down ss) + (org-cmp-alpha a b))) + (alpha-down (if alpha-up (- alpha-up) nil)) user-defined-up user-defined-down) (if (and org-agenda-cmp-user-defined (functionp org-agenda-cmp-user-defined)) @@ -5273,12 +5324,12 @@ HH:MM." ;;; Agenda restriction lock -(defvar org-agenda-restriction-lock-overlay (org-make-overlay 1 1) +(defvar org-agenda-restriction-lock-overlay (make-overlay 1 1) "Overlay to mark the headline to which agenda commands are restricted.") -(org-overlay-put org-agenda-restriction-lock-overlay - 'face 'org-agenda-restriction-lock) -(org-overlay-put org-agenda-restriction-lock-overlay - 'help-echo "Agendas are currently limited to this subtree.") +(overlay-put org-agenda-restriction-lock-overlay + 'face 'org-agenda-restriction-lock) +(overlay-put org-agenda-restriction-lock-overlay + 'help-echo "Agendas are currently limited to this subtree.") (org-detach-overlay org-agenda-restriction-lock-overlay) (defun org-agenda-set-restriction-lock (&optional type) @@ -5301,7 +5352,7 @@ 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) - (org-move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol)) + (move-overlay org-agenda-restriction-lock-overlay (point) (point-at-eol)) (move-marker org-agenda-restrict-begin (point)) (move-marker org-agenda-restrict-end (save-excursion (org-end-of-subtree t))) @@ -5390,8 +5441,9 @@ Org-mode buffers visited directly by the user will not be touched." (org-agenda-quit)) (defun org-agenda-execute (arg) - "Execute another agenda command, keeping same window.\\<global-map> -So this is just a shortcut for `\\[org-agenda]', available in the agenda." + "Execute another agenda command, keeping same window. +So this is just a shortcut for \\<global-map>`\\[org-agenda]', available +in the agenda." (interactive "P") (let ((org-agenda-window-setup 'current-window)) (org-agenda arg))) @@ -5548,7 +5600,7 @@ to switch to narrowing." (defun org-agenda-filter-effort-form (e) "Return the form to compare the effort of the current line with what E says. -E looks line \"+<2:25\"." +E looks like \"+<2:25\"." (let (op) (setq e (substring e 1)) (setq op (string-to-char e) e (substring e 1)) @@ -5587,25 +5639,25 @@ If the line does not have an effort defined, return nil." (defun org-agenda-filter-by-tag-hide-line () (let (ov) - (setq ov (org-make-overlay (max (point-min) (1- (point-at-bol))) + (setq ov (make-overlay (max (point-min) (1- (point-at-bol))) (point-at-eol))) - (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'type 'tags-filter) + (overlay-put ov 'invisible t) + (overlay-put ov 'type 'tags-filter) (push ov org-agenda-filter-overlays))) (defun org-agenda-fix-tags-filter-overlays-at (&optional pos) (setq pos (or pos (point))) (save-excursion - (dolist (ov (org-overlays-at pos)) - (when (and (org-overlay-get ov 'invisible) - (eq (org-overlay-get ov 'type) 'tags-filter)) + (dolist (ov (overlays-at pos)) + (when (and (overlay-get ov 'invisible) + (eq (overlay-get ov 'type) 'tags-filter)) (goto-char pos) - (if (< (org-overlay-start ov) (point-at-eol)) - (org-move-overlay ov (point-at-eol) - (org-overlay-end ov))))))) + (if (< (overlay-start ov) (point-at-eol)) + (move-overlay ov (point-at-eol) + (overlay-end ov))))))) (defun org-agenda-filter-by-tag-show-all () - (mapc 'org-delete-overlay org-agenda-filter-overlays) + (mapc 'delete-overlay org-agenda-filter-overlays) (setq org-agenda-filter-overlays nil) (setq org-agenda-filter nil) (setq org-agenda-filter-form nil) @@ -5880,17 +5932,16 @@ so that the date SD will be in that range." (error "No previous date before this line in this buffer"))) ;; Initialize the highlight -(defvar org-hl (org-make-overlay 1 1)) -(org-overlay-put org-hl 'face 'highlight) +(defvar org-hl (make-overlay 1 1)) +(overlay-put org-hl 'face 'highlight) (defun org-highlight (begin end &optional buffer) "Highlight a region with overlay." - (funcall (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay) - org-hl begin end (or buffer (current-buffer)))) + (move-overlay org-hl begin end (or buffer (current-buffer)))) (defun org-unhighlight () "Detach overlay INDEX." - (funcall (if (featurep 'xemacs) 'detach-extent 'delete-overlay) org-hl)) + (org-detach-overlay org-hl)) ;; FIXME this is currently not used. (defun org-highlight-until-next-command (beg end &optional buffer) @@ -6042,7 +6093,7 @@ When called with a prefix argument, include all archive files as well." 'org-agenda-type)))) (defun org-agenda-next-line () - "Move cursor to the next line, and show if follow-mode is active." + "Move cursor to the next line, and show if follow mode is active." (interactive) (call-interactively 'next-line) (org-agenda-do-context-action)) @@ -6055,7 +6106,7 @@ When called with a prefix argument, include all archive files as well." (org-agenda-do-context-action)) (defun org-agenda-do-context-action () - "Show outline path and, maybe, follow-mode window." + "Show outline path and, maybe, follow mode window." (let ((m (org-get-at-bol 'org-marker))) (if (and org-agenda-follow-mode m) (org-agenda-show)) @@ -6089,6 +6140,7 @@ and by additional input from the age of a schedules or deadline entry." (pos (marker-position marker))) (switch-to-buffer-other-window buffer) (widen) + (push-mark) (goto-char pos) (when (org-mode-p) (org-show-context 'agenda) @@ -6205,7 +6257,7 @@ If this information is not given, the function uses the tree at point." (delete-region (point-at-bol) (1+ (point-at-eol))))) (beginning-of-line 0)))))) -(defun org-agenda-refile (&optional goto rfloc) +(defun org-agenda-refile (&optional goto rfloc no-update) "Refile the item at point." (interactive "P") (if (equal goto '(16)) @@ -6224,7 +6276,8 @@ If this information is not given, the function uses the tree at point." (widen) (goto-char marker) (org-remove-subtree-entries-from-agenda) - (org-refile goto buffer rfloc))))))) + (org-refile goto buffer rfloc))))) + (unless no-update (org-agenda-redo)))) (defun org-agenda-open-link (&optional arg) "Follow the link in the current line, if any. @@ -6434,8 +6487,8 @@ docstring of `org-agenda-show-1'." This calls the command `org-tree-to-indirect-buffer' from the original Org-mode buffer. With numerical prefix arg ARG, go up to this level and then take that tree. -With a C-u prefix, make a separate frame for this tree (i.e. don't use the -dedicated frame)." +With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't +use the dedicated frame)." (interactive) (org-agenda-check-no-diary) (let* ((marker (or (org-get-at-bol 'org-marker) @@ -6925,13 +6978,14 @@ m Mark the entry at point for an agenda action s Schedule the marked entry to the date at the cursor d Set the deadline of the marked entry to the date at the cursor r Call `org-remember' with cursor date as the default date +c Call `org-capture' with cursor date as the default date SPC Show marked entry in other window TAB Visit marked entry in other window The cursor may be at a date in the calendar, or in the Org agenda." (interactive) (let (ans) - (message "Select action: [m]ark | [s]chedule [d]eadline [r]emember [ ]show") + (message "Select action: [m]ark | [s]chedule [d]eadline [r]emember [c]apture [ ]show") (setq ans (read-char-exclusive)) (cond ((equal ans ?m) @@ -6952,6 +7006,8 @@ The cursor may be at a date in the calendar, or in the Org agenda." (org-agenda-do-action '(org-deadline nil org-overriding-default-time))) ((equal ans ?r) (org-agenda-do-action '(org-remember) t)) + ((equal ans ?c) + (org-agenda-do-action '(org-capture) t)) ((equal ans ?\ ) (let ((cw (selected-window))) (org-switch-to-buffer-other-window @@ -7370,11 +7426,11 @@ This is a command that has to be installed in `calendar-mode-map'." (unless (org-agenda-bulk-marked-p) (unless m (error "Nothing to mark at point")) (push m org-agenda-bulk-marked-entries) - (setq ov (org-make-overlay (point-at-bol) (+ 2 (point-at-bol)))) + (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol)))) (org-overlay-display ov "> " (org-get-todo-face "TODO") 'evaporate) - (org-overlay-put ov 'type 'org-marked-entry-overlay)) + (overlay-put ov 'type 'org-marked-entry-overlay)) (beginning-of-line 2) (while (and (get-char-property (point) 'invisible) (not (eobp))) (beginning-of-line 2)) @@ -7411,9 +7467,9 @@ This only removes the overlays, it does not remove the markers from the list in `org-agenda-bulk-marked-entries'." (interactive) (mapc (lambda (ov) - (and (eq (org-overlay-get ov 'type) 'org-marked-entry-overlay) - (org-delete-overlay ov))) - (org-overlays-in (or beg (point-min)) (or end (point-max))))) + (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay) + (delete-overlay ov))) + (overlays-in (or beg (point-min)) (or end (point-max))))) (defun org-agenda-bulk-remove-all-marks () "Remove all marks in the agenda buffer. @@ -7433,6 +7489,7 @@ The prefix arg is passed through to the command if possible." (let* ((action (read-char-exclusive)) (org-log-refile (if org-log-refile 'time nil)) (entries (reverse org-agenda-bulk-marked-entries)) + redo-at-end cmd rfloc state e tag pos (cnt 0) (cntskip 0)) (cond ((equal action ?$) @@ -7446,13 +7503,15 @@ The prefix arg is passed through to the command if possible." "Refile to: " (marker-buffer (car org-agenda-bulk-marked-entries)) org-refile-allow-creating-parent-nodes)) - (setcar (nthcdr 3 rfloc) - (move-marker (make-marker) (nth 3 rfloc) - (or (get-file-buffer (nth 1 rfloc)) - (find-buffer-visiting (nth 1 rfloc)) - (error "This should not happen")))) + (if (nth 3 rfloc) + (setcar (nthcdr 3 rfloc) + (move-marker (make-marker) (nth 3 rfloc) + (or (get-file-buffer (nth 1 rfloc)) + (find-buffer-visiting (nth 1 rfloc)) + (error "This should not happen"))))) - (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc)))) + (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t) + redo-at-end t)) ((equal action ?t) (setq state (org-icompleting-read @@ -7513,6 +7572,7 @@ The prefix arg is passed through to the command if possible." (setq cnt (1+ cnt)))) (setq org-agenda-bulk-marked-entries nil) (org-agenda-bulk-remove-all-marks) + (when redo-at-end (org-agenda-redo)) (message "Acted on %d entries%s" cnt (if (= cntskip 0) @@ -7592,7 +7652,6 @@ either 'headline or 'category. For example: will only add headlines containing IMPORTANT or headlines belonging to the \"Work\" category." (interactive "P") - (require 'calendar) (if refresh (setq appt-time-msg-list nil)) (if (eq filter t) (setq filter (read-from-minibuffer "Regexp filter: "))) diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index b9bd8a447d2..31ae488d4d8 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el index 3d86e7a5230..730f8bdfa41 100644 --- a/lisp/org/org-ascii.el +++ b/lisp/org/org-ascii.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -26,7 +26,10 @@ ;; ;;; Commentary: +;;; Code: + (require 'org-exp) + (eval-when-compile (require 'cl)) @@ -541,7 +544,7 @@ publishing directory." (current-buffer)))) (defun org-export-ascii-preprocess (parameters) - "Do extra work for ASCII export" + "Do extra work for ASCII export." ;; ;; Realign tables to get rid of narrowing (when org-export-ascii-table-widen-columns @@ -550,9 +553,8 @@ publishing directory." (org-ascii-replace-entities) (goto-char (point-min)) (org-table-map-tables - (lambda () - (org-if-unprotected - (org-table-align)))))) + (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) @@ -566,7 +568,12 @@ publishing directory." (goto-char (point-min)) (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t) (org-if-unprotected-at (match-beginning 1) - (replace-match "\\1\\2")))) + (replace-match "\\1\\2"))) + ;; Remove list start counters + (goto-char (point-min)) + (while (re-search-forward "\\[@start:[0-9]+\\] ?" nil t) + (org-if-unprotected + (replace-match "")))) (defun org-html-expand-for-ascii (line) "Handle quoted HTML for ASCII export." diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index 42a3894388e..573244beed4 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -4,7 +4,7 @@ ;; Author: John Wiegley <johnw@newartisans.com> ;; Keywords: org data task -;; Version: 6.35i +;; Version: 7.01 ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el index 8915faa565a..0d7b5fa086a 100644 --- a/lisp/org/org-bbdb.el +++ b/lisp/org/org-bbdb.el @@ -7,7 +7,7 @@ ;; Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -207,7 +207,7 @@ date year)." (defun org-bbdb-export (path desc format) "Create the export version of a BBDB link specified by PATH or DESC. If exporting to either HTML or LaTeX FORMAT the link will be -italicised, in all other cases it is left unchanged." +italicized, in all other cases it is left unchanged." (cond ((eq format 'html) (format "<i>%s</i>" (or desc path))) ((eq format 'latex) (format "\\textit{%s}" (or desc path))) diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el index c4bf197c22c..06853b8bd63 100644 --- a/lisp/org/org-beamer.el +++ b/lisp/org/org-beamer.el @@ -2,7 +2,7 @@ ;; ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; -;; Version: 6.35i +;; Version: 7.01 ;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Keywords: org, wp, tex @@ -27,8 +27,11 @@ ;; 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) @@ -47,7 +50,7 @@ "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 se this to 4 as well, if you at the same time set +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 :type '(choice @@ -64,7 +67,9 @@ And example for this is \"[allowframebreaks]\"." "%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 - :type '(string :tag "Beamer column view format")) + :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}" @@ -72,7 +77,9 @@ And example for this is \"[allowframebreaks]\"." 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 - :type '(string :tag "Beamer column view format")) + :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" @@ -105,7 +112,7 @@ These are just a completion help.") "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 emite the heading as +\"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. @@ -125,7 +132,7 @@ 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 excapes +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 @@ -178,7 +185,7 @@ close The closing string of the environment." (defun org-beamer-select-environment () "Select the environment to be used by beamer for this entry. -While this uses (for convenince) a tag selection interface, the result +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 @@ -383,11 +390,12 @@ the value will be inserted right after the documentclass statement." org-beamer-header-extra) (goto-char (point-min)) (cond - ((re-search-forward "^[ \t]*BEAMER-HEADER-EXTRA-HERE[ \t]*$" nil t) + ((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]*\\\\documentclass\\>" nil t) - (beginning-of-line 2) + ((re-search-forward "^[ \t]*\\\\begin{document}" nil t) + (beginning-of-line 1) (insert org-beamer-header-extra) (or (bolp) (insert "\n")))))) @@ -412,7 +420,7 @@ the value will be inserted right after the documentclass statement." (setq org-beamer-export-is-beamer-p nil)) (defun org-beamer-after-initial-vars () - "Find special setings for beamer and store them. + "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 @@ -479,7 +487,7 @@ The effect is that these values will be accessible during export." (defun org-beamer-auto-fragile-frames () "Mark any frames containing verbatim environments as fragile. -This funcion will run in the final LaTeX document." +This function will run in the final LaTeX document." (when org-beamer-export-is-beamer-p (let (opts) (goto-char (point-min)) @@ -507,9 +515,9 @@ This funcion will run in the final LaTeX document." ) (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." + "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 :type '(string :tag "Outline frame options") ) @@ -571,7 +579,7 @@ square brackets." (add-hook 'org-export-preprocess-before-selecting-backend-code-hook 'org-beamer-select-beamer-code) -(defun org-beamer-settings-template (kind) +(defun org-insert-beamer-options-template (kind) "Insert a settings template, to make sure users do this right." (interactive (progn (message "Current [s]ubtree or [g]lobal?") @@ -587,14 +595,18 @@ square brackets." (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf") (org-entry-put nil "BEAMER_FRAME_LEVEL" (number-to-string org-beamer-frame-level)) - (org-entry-put nil "BEAMER_HEADER_EXTRA" org-beamer-themes) - (org-entry-put nil "COLUMNS" org-beamer-column-view-format) + (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") - (insert "#+BEAMER_HEADER_EXTRA: " org-beamer-themes "\n") - (insert "#+COLUMNS: " org-beamer-column-view-format "\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"))) diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index fc5a605c186..f7f6595f5a1 100644 --- a/lisp/org/org-bibtex.el +++ b/lisp/org/org-bibtex.el @@ -5,7 +5,7 @@ ;; Author: Bastien Guerry <bzg at altern dot org> ;; Carsten Dominik <carsten dot dominik at gmail dot com> ;; Keywords: org, wp, remember -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el new file mode 100644 index 00000000000..c6197d69fb3 --- /dev/null +++ b/lisp/org/org-capture.el @@ -0,0 +1,1321 @@ +;;; org-capture.el --- Fast note taking in Org-mode + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 7.01 +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains an alternative implementation of the same functionality +;; that is also provided by org-remember.el. The implementation is more +;; streamlined, can produce more target types (e.g. plain list items or +;; table lines). Also, it does not use a temporary buffer for editing +;; the captured entry - instead it uses an indirect buffer that visits +;; the new entry already in the target buffer (this was an idea by Samuel +;; Wales). John Wiegley's excellent `remember.el' is not needed for this +;; implementation, even though we borrow heavily from its ideas. + +;; This implementation heavily draws on ideas by James TD Smith and +;; Samuel Wales, and, of cause, uses John Wiegley's remember.el as inspiration. + +;;; TODO + +;; - find a clever way to not always insert an annotation maybe a +;; predicate function that can check for conditions for %a to be +;; used. This could be one of the properties. + +;; - Should there be plist members that arrange for properties to be +;; asked for, like James proposed in his RFC? + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'org) +(require 'org-mks) + +(declare-function org-datetree-find-date-create "org-datetree" + (DATE &optional KEEP-RESTRICTION)) +(declare-function org-table-get-specials "org-table" ()) +(declare-function org-table-goto-line "org-table" (N)) +(defvar org-remember-default-headline) +(defvar org-remember-templates) +(defvar org-table-hlines) + +(defvar org-capture-clock-was-started nil + "Internal flag, noting if the clock was started.") + +(defvar org-capture-last-stored-marker (make-marker) + "Marker pointing to the entry most recently stored with `org-capture'.") + +;; The following variable is scoped dynamically by org-protocol +;; to indicate that the link properties have already been stored +(defvar org-capture-link-is-already-stored nil) + +(defgroup org-capture nil + "Options concerning capturing new entries." + :tag "Org Capture" + :group 'org) + +(defcustom org-capture-templates nil + "Templates for the creation of new entries. + +Each entry is a list with the following items: + +keys The keys that will select the template, as a string, characters + only, for example \"a\" for a template to be selected with a + single key, or \"bt\" for selection with two keys. When using + several keys, keys using the same prefix key must be together + in the list and preceded by a 2-element entry explaining the + prefix key, for example + + (\"b\" \"Templates for marking stuff to buy\") + + The \"C\" key is used by default for quick access to the + customization of the template variable. But if you want to use + that key for a template, you can. + +description A short string describing the template, will be shown during + selection. + +type The type of entry. Valid types are: + entry an Org-mode node, with a headline. Will be + filed as the child of the target entry or as + a top-level entry. + item a plain list item, will be placed in the + first plain list at the target + location. + checkitem a checkbox item. This differs from the + plain list item only is so far as it uses a + different default template. + table-line a new line in the first table at target location. + plain text to be inserted as it is. + +target Specification of where the captured item should be placed. + In Org-mode files, targets usually define a node. Entries will + become children of this node, other types will be added to the + table or list in the body of this node. + + Valid values are: + + (file \"path/to/file\") + Text will be placed at the beginning or end of that file + + (id \"id of existing org entry\") + File as child of this entry, or in the body of the entry + + (file+headline \"path/to/file\" \"node headline\") + Fast configuration if the target heading is unique in the file + + (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...) + For non-unique headings, the full path is safer + + (file+regexp \"path/to/file\" \"regexp to find location\") + File to the entry matching regexp + + (file+datetree \"path/to/file\") + Will create a heading in a date tree + + (file+function \"path/to/file\" function-finding-location) + A function to find the right location in the file + + (clock) + File to the entry that is currently being clocked + + (function function-finding-location) + Most general way, write your own function to find both + file and location + +template The template for creating the capture item. If you leave this + empty, an appropriate default template will be used. See below + for more details. Instead of a string, this may also be one of + + (file \"/path/to/template-file\") + (function function-returning-the-template) + + in order to get a template from a file, or dynamically + from a function. + +The rest of the entry is a property list of additional options. Recognized +properties are: + + :prepend Normally newly captured information will be appended at + the target location (last child, last table line, + last list item...). Setting this property will + change that. + + :immediate-finish When set, do not offer to edit the information, just + file it away immediately. This makes sense if the + template only needs information that can be added + automatically. + + :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. + + :clock-in Start the clock in this item. + + :clock-resume Start the interrupted clock when finishing the capture. + + :unnarrowed Do not narrow the target buffer, simply show the + full buffer. Default is to narrow it so that you + only see the new stuff. + + :table-line-pos Specification of the location in the table where the + new line should be inserted. It looks like \"II-3\" + which means that the new line should become the third + line before the second horizontal separator line. + +The template defines the text to be inserted. Often this is an org-mode +entry (so the first line should start with a star) that will be filed as a +child of the target headline. It can also be freely formatted text. +Furthermore, the following %-escapes will be replaced with content: + + %^{prompt} prompt the user for a string and replace this sequence with it. + A default value and a completion table ca be specified like this: + %^{prompt|default|completion2|completion3|...} + %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 + %n user name (taken from `user-full-name') + %a annotation, normally the link created with `org-store-link' + %i initial content, copied from the active region. If %i is + indented, the entire inserted text will be indented as well. + %c current kill ring head + %x content of the X clipboard + %^C interactive selection of which kill or clip to use + %^L like %^C, but insert as link + %k title of currently clocked task + %K link to currently clocked task + %^g prompt for tags, with completion on tags in target file + %^G prompt for tags, with completion on all tags in all agenda files + %^{prop}p prompt the user for a value for property `prop' + %:keyword specific information for certain link types, see below + %[pathname] insert the contents of the file given by `pathname' + %(sexp) evaluate elisp `(sexp)' and replace with the result + + %? 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 `org-capture' in emails +or gnus will record the author and the subject of the message, which you +can access with \"%:author\" 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 +w3, w3m | %:type %:url +info | %:type %:file %:node +calendar | %:type %:date" + :group 'org-capture + :type + '(repeat + (choice :value ("" "" entry (file "~/org/notes.org") "") + (list :tag "Multikey description" + (string :tag "Keys ") + (string :tag "Description")) + (list :tag "Template entry" + (string :tag "Keys ") + (string :tag "Description ") + (choice :tag "Capture Type " :value entry + (const :tag "Org entry" entry) + (const :tag "Plain list item" item) + (const :tag "Checkbox item" checkitem) + (const :tag "Plain text" plain) + (const :tag "Table line" table-line)) + (choice :tag "Target location" + (list :tag "File" + (const :format "" file) + (file :tag " File")) + (list :tag "ID" + (const :format "" id) + (string :tag " ID")) + (list :tag "File & Headline" + (const :format "" file+headline) + (file :tag " File ") + (string :tag " Headline")) + (list :tag "File & Outline path" + (const :format "" file+olp) + (file :tag " File ") + (repeat :tag "Outline path" :inline t + (string :tag "Headline"))) + (list :tag "File & Regexp" + (const :format "" file+regexp) + (file :tag " File ") + (regexp :tag " Regexp")) + (list :tag "File & Date tree" + (const :format "" file+datetree) + (file :tag " File")) + (list :tag "File & function" + (const :format "" file+function) + (file :tag " File ") + (sexp :tag " Function")) + (list :tag "Current clocking task" + (const :format "" clock)) + (list :tag "Function" + (const :format "" function) + (sexp :tag " Function"))) + (choice :tag "Template" + (string) + (list :tag "File" + (const :format "" file) + (file :tag "Template file")) + (list :tag "Function" + (const :format "" function) + (file :tag "Template function"))) + (plist :inline t + ;; Give the most common options as checkboxes + :options (((const :format "%v " :prepend) (const t)) + ((const :format "%v " :immediate-finish) (const t)) + ((const :format "%v " :empty-lines) (const 1)) + ((const :format "%v " :clock-in) (const t)) + ((const :format "%v " :clock-resume) (const t)) + ((const :format "%v " :unnarrowed) (const t)))))))) + +(defcustom org-capture-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-capture + :type 'hook) + +;;; The property list for keeping information about the capture process + +(defvar org-capture-plist nil + "Plist for the current capture process, global, to avoid having to pass it.") +(defvar org-capture-current-plist nil + "Local variable holding the plist in a capture buffer. +This is used to store the plist for use when finishing a capture process. +Another such process might have changed the global variable by then.") + +(defun org-capture-put (&rest stuff) + (while stuff + (setq org-capture-plist (plist-put org-capture-plist + (pop stuff) (pop stuff))))) +(defun org-capture-get (prop &optional local) + (plist-get (if local org-capture-current-plist org-capture-plist) prop)) + +(defun org-capture-member (prop) + (plist-get org-capture-plist prop)) + +;;; The minor mode + +(defvar org-capture-mode-map (make-sparse-keymap) + "Keymap for `org-capture-mode', a minor mode. +Use this map to set additional keybindings for when Org-mode is used +for a Remember buffer.") + +(defvar org-capture-mode-hook nil + "Hook for the minor `org-capture-mode'.") + +(define-minor-mode org-capture-mode + "Minor mode for special key bindings in a remember buffer." + nil " Rem" org-capture-mode-map + (org-set-local + 'header-line-format + "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.") + (run-hooks 'org-capture-mode-hook)) +(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize) +(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill) +(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile) + +;;; The main commands + +;;;###autoload +(defun org-capture (&optional goto keys) + "Capture something. +\\<org-capture-mode-map> +This will let you select a template from `org-capture-templates', and then +file the newly captured information. The text is immediately inserted +at the target location, and an indirect buffer is shown where you can +edit it. Pressing \\[org-capture-finalize] brings you back to the previous state +of Emacs, so that you can continue your work. + +When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture +anything, just go to the file/headline where the selected template +stores its notes. With a double prefix argument \ +\\[universal-argument] \\[universal-argument], go to the last note +stored. + +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 in +`org-capture-templates'. In this case, interactive selection will be +bypassed." + (interactive "P") + (cond + ((equal goto '(4)) (org-capture-goto-target)) + ((equal goto '(16)) (org-capture-goto-last-stored)) + (t + ;; FIXME: Are these needed? + (let* ((orig-buf (current-buffer)) + (annotation (if (and (boundp 'org-capture-link-is-already-stored) + org-capture-link-is-already-stored) + (plist-get org-store-link-plist :annotation) + (org-store-link nil))) + (initial (and (org-region-active-p) + (buffer-substring (point) (mark)))) + (entry (org-capture-select-template keys))) + (cond + ((equal entry "C") + (customize-variable 'org-capture-templates)) + ((equal entry "q") + (error "Abort")) + (t + (org-capture-set-plist entry) + (org-capture-get-template) + (org-capture-put :original-buffer orig-buf :annotation annotation + :initial initial) + (org-capture-put :default-time + (or org-overriding-default-time + (org-current-time))) + (org-capture-set-target-location) + (condition-case error + (org-capture-put :template (org-capture-fill-template)) + ((error quit) + (if (get-buffer "*Capture*") (kill-buffer "*Capture*")) + (error "Capture abort: %s" error))) + + (if (equal goto 0) + ;;insert at point + (org-capture-insert-template-here) + (condition-case error + (org-capture-place-template) + ((error quit) + (if (and (buffer-base-buffer (current-buffer)) + (string-match "\\`CAPTURE-" (buffer-name))) + (kill-buffer (current-buffer))) + (set-window-configuration (org-capture-get :return-to-wconf)) + (error "Capture template `%s': %s" + (org-capture-get :key) + (nth 1 error)))) + (if (org-capture-get :immediate-finish) + (org-capture-finalize) + (if (and (org-mode-p) + (org-capture-get :clock-in)) + (condition-case nil + (progn + (if (org-clock-is-active) + (org-capture-put :interrupted-clock + (copy-marker org-clock-marker))) + (org-clock-in) + (org-set-local 'org-capture-clock-was-started t)) + (error + "Could not start the clock in this capture buffer"))))))))))) + + +(defun org-capture-get-template () + "Get the template from a file or a function if necessary." + (let ((txt (org-capture-get :template)) file) + (cond + ((and (listp txt) (eq (car txt) 'file)) + (if (file-exists-p + (setq file (expand-file-name (nth 1 txt) org-directory))) + (setq txt (org-file-contents file)) + (setq txt (format "* Template file %s not found" (nth 1 txt))))) + ((and (listp txt) (eq (car txt) 'function)) + (if (fboundp (nth 1 txt)) + (setq txt (funcall (nth 1 txt))) + (setq txt (format "* Template function %s not found" (nth 1 txt))))) + ((not txt) (setq txt "")) + ((stringp txt)) + (t (setq txt "* Invalid capture template"))) + (org-capture-put :template txt))) + +(defun org-capture-finalize () + "Finalize the capture process." + (interactive) + (unless (and org-capture-mode + (buffer-base-buffer (current-buffer))) + (error "This does not seem to be a capture buffer for Org-mode")) + + ;; Did we start the clock in this capture buffer? + (when (and org-capture-clock-was-started + org-clock-marker (marker-buffer org-clock-marker) + (equal (marker-buffer org-clock-marker) (buffer-base-buffer)) + (> org-clock-marker (point-min)) + (< org-clock-marker (point-max))) + ;; Looks like the clock we started is still running. Clock out. + (let (org-log-note-clock-out) (org-clock-out)) + (when (and (org-capture-get :clock-resume 'local) + (markerp (org-capture-get :interrupted-clock 'local)) + (buffer-live-p (marker-buffer + (org-capture-get :interrupted-clock 'local)))) + (org-with-point-at (org-capture-get :interrupted-clock 'local) + (org-clock-in)) + (message "Interrupted clock has been resumed"))) + + (let ((beg (point-min)) + (end (point-max)) + (abort-note nil)) + (widen) + + (if org-note-abort + (let ((m1 (org-capture-get :begin-marker 'local)) + (m2 (org-capture-get :end-marker 'local))) + (if (and m1 m2 (= m1 beg) (= m2 end)) + (progn + (setq abort-note 'clean) + (kill-region m1 m2)) + (setq abort-note 'dirty))) + + ;; Make sure that the empty lines after are correct + (when (and (> (point-max) end) ; indeed, the buffer was still narrowed + (member (org-capture-get :type 'local) + '(entry item checkitem plain))) + (save-excursion + (goto-char end) + (or (bolp) (newline)) + (org-capture-empty-lines-after + (or (org-capture-get :empty-lines 'local) 0)))) + ;; Postprocessing: Update Statistics cookies, do the sorting + (when (org-mode-p) + (save-excursion + (when (ignore-errors (org-back-to-heading)) + (org-update-parent-todo-statistics) + (org-update-checkbox-count))) + ;; FIXME Here we should do the sorting + ;; If we have added a table line, maybe recompute? + (when (and (eq (org-capture-get :type 'local) 'table-line) + (org-at-table-p)) + (if (org-table-get-stored-formulas) + (org-table-recalculate 'all) ;; FIXME: Should we iterate??? + (org-table-align))) + ) + ;; Store this place as the last one where we stored something + ;; Do the marking in the base buffer, so that it makes sense after + ;; the indirect buffer has been killed. + (org-capture-bookmark-last-stored-position) + + ;; Run the hook + (run-hooks 'org-capture-before-finalize-hook) + ) + + ;; Kill the indirect buffer + (save-buffer) + (let ((return-wconf (org-capture-get :return-to-wconf 'local))) + (kill-buffer (current-buffer)) + ;; Restore the window configuration before capture + (set-window-configuration return-wconf)) + (when abort-note + (cond + ((equal abort-note 'clean) + (message "Capture process aborted and target file cleaned up")) + ((equal abort-note 'dirty) + (error "Capture process aborted, but target buffer could not be cleaned up correctly")))))) + +(defun org-capture-refile () + "Finalize the current capture and then refile the entry. +Refiling is done from the base buffer, because the indirect buffer is then +already gone." + (interactive) + (unless (eq (org-capture-get :type 'local) 'entry) + (error + "Refiling from a capture buffer makes only sense for `entry'-type templates")) + (let ((pos (point)) + (base (buffer-base-buffer (current-buffer))) + (org-refile-for-capture t)) + (org-capture-finalize) + (save-window-excursion + (with-current-buffer (or base (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (call-interactively 'org-refile))))))) + +(defun org-capture-kill () + "Abort the current capture process." + (interactive) + ;; FIXME: This does not do the right thing, we need to remove the new stuff + ;; By hand it is easy: undo, then kill the buffer + (let ((org-note-abort t) (org-capture-before-finalize-hook nil)) + (org-capture-finalize))) + +(defun org-capture-goto-last-stored () + "Go to the location where the last remember note was stored." + (interactive) + (org-goto-marker-or-bmk org-capture-last-stored-marker + "org-capture-last-stored") + (message "This is the last note stored by a capture process")) + +;;; Supporting functions for handling the process + +(defun org-capture-set-target-location (&optional target) + "Find target buffer and position and store then in the property list." + (let ((target-entry-p t)) + (setq target (or target (org-capture-get :target))) + (save-excursion + (cond + ((eq (car target) 'file) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (setq target-entry-p nil)) + + ((eq (car target) 'id) + (let ((loc (org-id-find (nth 1 target)))) + (if (not loc) + (error "Cannot find target ID \"%s\"" (nth 1 target)) + (set-buffer (org-capture-target-buffer (car loc))) + (goto-char (cdr loc))))) + + ((eq (car target) 'file+headline) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (let ((hd (nth 2 target))) + (goto-char (point-min)) + (if (re-search-forward + (format org-complex-heading-regexp-format (regexp-quote hd)) + nil t) + (goto-char (point-at-bol)) + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (insert "* " hd "\n") + (beginning-of-line 0)))) + + ((eq (car target) 'file+olp) + (let ((m (org-find-olp (cdr target)))) + (set-buffer (marker-buffer m)) + (goto-char m))) + + ((eq (car target) 'file+regexp) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (goto-char (point-min)) + (if (re-search-forward (nth 2 target) nil t) + (progn + (goto-char (if (org-capture-get :prepend) + (match-beginning 0) (match-end 0))) + (org-capture-put :exact-position (point)) + (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) + (error "No match for target regexp in file %s" (nth 1 target)))) + + ((eq (car target) 'file+datetree) + (require 'org-datetree) + (set-buffer (org-capture-target-buffer (nth 1 target))) + ;; Make a date tree entry, with the current date (or yesterday, + ;; if we are extending dates for a couple of hours) + (org-datetree-find-date-create + (calendar-gregorian-from-absolute + (if org-overriding-default-time + (time-to-days org-overriding-default-time) + (time-to-days + (time-subtract (current-time) + (list 0 (* 3600 org-extend-today-until) 0))))))) + + ((eq (car target) 'file+function) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (funcall (nth 2 target)) + (org-capture-put :exact-position (point)) + (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) + + ((eq (car target) 'function) + (funcall (nth 1 target)) + (org-capture-put :exact-position (point)) + (setq target-entry-p (and (org-mode-p) (org-at-heading-p)))) + + ((eq (car target) 'clock) + (if (and (markerp org-clock-hd-marker) + (marker-buffer org-clock-hd-marker)) + (progn (set-buffer (marker-buffer org-clock-hd-marker)) + (goto-char org-clock-hd-marker)) + (error "No running clock that could be used as capture target"))) + + (t (error "Invalid capture target specification"))) + + (org-capture-put :buffer (current-buffer) :pos (point) + :target-entry-p target-entry-p)))) + +(defun org-capture-target-buffer (file) + "Get a buffer for FILE." + (or (org-find-base-buffer-visiting file) + (find-file-noselect (expand-file-name file org-directory)))) + +(defun org-capture-steal-local-variables (buffer) + "Install Org-mode local variables." + (mapc (lambda (v) + (ignore-errors (org-set-local (car v) (cdr v)))) + (buffer-local-variables buffer))) + +(defun org-capture-place-template () + "Insert the template at the target location, and display the buffer." + (org-capture-put :return-to-wconf (current-window-configuration)) + (delete-other-windows) + (org-switch-to-buffer-other-window + (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) + (show-all) + (goto-char (org-capture-get :pos)) + (org-set-local 'org-capture-target-marker + (move-marker (make-marker) (point))) + (let* ((template (org-capture-get :template)) + (type (org-capture-get :type))) + (case type + ((nil entry) (org-capture-place-entry)) + (table-line (org-capture-place-table-line)) + (plain (org-capture-place-plain-text)) + (item (org-capture-place-item)))) + (org-capture-mode 1) + (org-set-local 'org-capture-current-plist org-capture-plist)) + +(defun org-capture-place-entry () + "Place the template as a new Org entry." + (let* ((txt (org-capture-get :template)) + (reversed (org-capture-get :prepend)) + (target-entry-p (org-capture-get :target-entry-p)) + level beg end file) + + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((not target-entry-p) + ;; Insert as top-level entry, either at beginning or at end of file + (setq level 1) + (if reversed + (progn (goto-char (point-min)) + (outline-next-heading)) + (goto-char (point-max)) + (or (bolp) (insert "\n")))) + (t + ;; Insert as a child of the current entry + (and (looking-at "\\*+") + (setq level (- (match-end 0) (match-beginning 0)))) + (setq level (org-get-valid-level (or level 1) 1)) + (if reversed + (progn + (outline-next-heading) + (or (bolp) (insert "\n"))) + (org-end-of-subtree t t) + (or (bolp) (insert "\n"))))) + (org-capture-empty-lines-before) + (setq beg (point)) + (org-paste-subtree level txt 'for-yank) + (org-capture-empty-lines-after 1) + (org-capture-position-for-last-stored beg) + (outline-next-heading) + (setq end (point)) + (org-capture-mark-kill-region beg (1- end)) + (org-capture-narrow beg (1- end)) + (if (re-search-forward "%\\?" end t) (replace-match "")))) + +(defun org-capture-place-item () + "Place the template as a new plain list item." + (let* ((txt (org-capture-get :template)) + (target-entry-p (org-capture-get :target-entry-p)) + (ind 0) + beg end) + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((not target-entry-p) + ;; Insert as top-level entry, either at beginning or at end of file + (setq beg (point-min) end (point-max))) + (t + (setq beg (1+ (point-at-eol)) + end (save-excursion (outline-next-heading) (point))))) + (if (org-capture-get :prepend) + (progn + (goto-char beg) + (if (re-search-forward (concat "^" (org-item-re)) nil t) + (progn + (goto-char (match-beginning 0)) + (setq ind (org-get-indentation))) + (goto-char end) + (setq ind 0))) + (goto-char end) + (if (re-search-backward (concat "^" (org-item-re)) nil t) + (progn + (setq ind (org-get-indentation)) + (org-end-of-item)) + (setq ind 0))) + ;; Remove common indentation + (setq txt (org-remove-indentation txt)) + ;; Make sure this is indeed an item + (unless (string-match (concat "\\`" (org-item-re)) txt) + (setq txt (concat "- " + (mapconcat 'identity (split-string txt "\n") + "\n ")))) + ;; Set the correct indentation, depending on context + (setq ind (make-string ind ?\ )) + (setq txt (concat ind + (mapconcat 'identity (split-string txt "\n") + (concat "\n" ind)) + "\n")) + ;; Insert, with surrounding empty lines + (org-capture-empty-lines-before) + (setq beg (point)) + (insert txt) + (or (bolp) (insert "\n")) + (org-capture-empty-lines-after 1) + (org-capture-position-for-last-stored beg) + (forward-char 1) + (setq end (point)) + (org-capture-mark-kill-region beg (1- end)) + (org-capture-narrow beg (1- end)) + (if (re-search-forward "%\\?" end t) (replace-match "")))) + +(defun org-capture-place-table-line () + "Place the template as a table line." + (require 'org-table) + (let* ((txt (org-capture-get :template)) + (target-entry-p (org-capture-get :target-entry-p)) + (table-line-pos (org-capture-get :table-line-pos)) + ind beg end) + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((not target-entry-p) + ;; Table is not necessarily under a heading + (setq beg (point-min) end (point-max))) + (t + ;; WE are at a heading, limit search to the body + (setq beg (1+ (point-at-eol)) + end (save-excursion (outline-next-heading) (point))))) + (if (re-search-forward org-table-dataline-regexp end t) + (let ((b (org-table-begin)) (e (org-table-end))) + (goto-char e) + (if (looking-at "[ \t]*#\\+TBLFM:") + (forward-line 1)) + (narrow-to-region b (point))) + (goto-char end) + (insert "\n| |\n|----|\n| |\n") + (narrow-to-region (1+ end) (point))) + ;; We are narrowed to the table, or to an empty line if there was no table + + ;; Check if the template is good + (if (not (string-match org-table-dataline-regexp txt)) + (setq txt "| %?Bad template |\n")) + (cond + ((and table-line-pos + (string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos)) + ;; we have a complex line specification + (goto-char (point-min)) + (let ((nh (- (match-end 1) (match-beginning 1))) + (delta (string-to-number (match-string 2 table-line-pos))) + ll) + ;; The user wants a special position in the table + (org-table-get-specials) + (setq ll (ignore-errors (aref org-table-hlines nh))) + (unless ll (error "Invalid table line specification \"%s\"" + table-line-pos)) + (setq ll (+ ll delta (if (< delta 0) 0 -1))) + (org-goto-line ll) + (org-table-insert-row 'below) + (beginning-of-line 1) + (delete-region (point) (1+ (point-at-eol))) + (setq beg (point)) + (insert txt) + (setq end (point)))) + ((org-capture-get :prepend) + (goto-char (point-min)) + (re-search-forward org-table-hline-regexp nil t) + (beginning-of-line 1) + (re-search-forward org-table-dataline-regexp nil t) + (beginning-of-line 1) + (setq beg (point)) + (org-table-insert-row) + (beginning-of-line 1) + (delete-region (point) (1+ (point-at-eol))) + (insert txt) + (setq end (point))) + (t + (goto-char (point-max)) + (re-search-backward org-table-dataline-regexp nil t) + (beginning-of-line 1) + (org-table-insert-row 'below) + (beginning-of-line 1) + (delete-region (point) (1+ (point-at-eol))) + (setq beg (point)) + (insert txt) + (setq end (point)))) + (goto-char beg) + (org-capture-position-for-last-stored 'table-line) + (if (re-search-forward "%\\?" end t) (replace-match "")) + (org-table-align))) + +(defun org-capture-place-plain-text () + "Place the template plainly." + (let* ((txt (org-capture-get :template)) + beg end) + (goto-char (cond + ((org-capture-get :exact-position)) + ((org-capture-get :prepend) (point-min)) + (t (point-max)))) + (or (bolp) (newline)) + (org-capture-empty-lines-before) + (setq beg (point)) + (insert txt) + (org-capture-empty-lines-after 1) + (org-capture-position-for-last-stored beg) + (setq end (point)) + (org-capture-mark-kill-region beg (1- end)) + (org-capture-narrow beg (1- end)) + (if (re-search-forward "%\\?" end t) (replace-match "")))) + +(defun org-capture-mark-kill-region (beg end) + "Mark the region that will have to be killed when aborting capture." + (let ((m1 (move-marker (make-marker) beg)) + (m2 (move-marker (make-marker) end))) + (org-capture-put :begin-marker m1) + (org-capture-put :end-marker m2))) + +(defun org-capture-position-for-last-stored (where) + "Memorize the position that should later become the position of last capture." + (cond + ((integerp where) + (org-capture-put :position-for-last-stored + (move-marker (make-marker) where + (or (buffer-base-buffer (current-buffer)) + (current-buffer))))) + ((eq where 'table-line) + (org-capture-put :position-for-last-stored + (list 'table-line + (org-table-current-dline)))) + (t (error "This should not happen")))) + +(defun org-capture-bookmark-last-stored-position () + "Bookmark the last-captured position." + (let* ((where (org-capture-get :position-for-last-stored 'local)) + (pos (cond + ((markerp where) + (prog1 (marker-position where) + (move-marker where nil))) + ((and (listp where) (eq (car where) 'table-line)) + (if (org-at-table-p) + (save-excursion + (org-table-goto-line (nth 1 where)) + (point-at-bol)) + (point)))))) + (with-current-buffer (buffer-base-buffer (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (bookmark-set "org-capture-last-stored") + (move-marker org-capture-last-stored-marker (point))))))) + +(defun org-capture-narrow (beg end) + "Narrow, unless configuration says not to narrow." + (unless (org-capture-get :unnarrowed) + (narrow-to-region beg end) + (goto-char beg))) + +(defun org-capture-empty-lines-before (&optional n) + "Arrange for 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) 0)) + (let ((pos (point))) + (org-back-over-empty-lines) + (delete-region (point) pos) + (newline n))) + +(defun org-capture-empty-lines-after (&optional n) + "Arrange for 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) 0)) + (org-back-over-empty-lines) + (while (looking-at "[ \t]*\n") (replace-match "")) + (let ((pos (point))) + (newline n) + (goto-char pos))) + +(defvar org-clock-marker) ; Defined in org.el +;;;###autoload +(defun org-capture-insert-template-here () + (let* ((template (org-capture-get :template)) + (type (org-capture-get :type)) + beg end pp) + (or (bolp) (newline)) + (setq beg (point)) + (cond + ((and (eq type 'entry) (org-mode-p)) + (org-paste-subtree nil template t)) + ((and (memq type '(item checkitem)) + (org-mode-p) + (save-excursion (skip-chars-backward " \t\n") + (setq pp (point)) + (org-in-item-p))) + (goto-char pp) + (org-insert-item) + (skip-chars-backward " ") + (skip-chars-backward "-+*0123456789).") + (delete-region (point) (point-at-eol)) + (setq beg (point)) + (org-remove-indentation template) + (insert template) + (org-capture-empty-lines-after) + (goto-char beg) + (org-maybe-renumber-ordered-list) + (org-end-of-item) + (setq end (point))) + (t (insert template))) + (setq end (point)) + (goto-char beg) + (if (re-search-forward "%\\?" end t) + (replace-match "")))) + +(defun org-capture-set-plist (entry) + "Initialize the property list from the template definition." + (setq org-capture-plist (copy-sequence (nthcdr 5 entry))) + (org-capture-put :key (car entry) :description (nth 1 entry) + :target (nth 3 entry)) + (let ((txt (nth 4 entry)) (type (or (nth 2 entry) 'entry))) + (when (or (not txt) (and (stringp txt) (not (string-match "\\S-" txt)))) + ;; The template may be empty or omitted for special types. + ;; Here we insert the default templates for such cases. + (cond + ((eq type 'item) (setq txt "- %?")) + ((eq type 'checkitem) (setq txt "- [ ] %?")) + ((eq type 'table-line) (setq txt "| %? |")) + ((member type '(nil entry)) (setq txt "* %?\n %a")))) + (org-capture-put :template txt :type type))) + +(defun org-capture-goto-target (&optional template-key) + "Go to the target location of a capture template. +The user is queried for the template." + (interactive) + (let* (org-select-template-temp-major-mode + (entry (org-capture-select-template template-key))) + (unless entry + (error "No capture template selected")) + (org-capture-set-plist entry) + (org-capture-set-target-location) + (switch-to-buffer (org-capture-get :buffer)) + (goto-char (org-capture-get :pos)))) + +(defun org-capture-get-indirect-buffer (&optional buffer prefix) + "Make an indirect buffer for a capture process. +Use PREFIX as a prefix for the name of the indirect buffer." + (setq buffer (or buffer (current-buffer))) + (let ((n 1) (base (buffer-name buffer)) bname) + (setq bname (concat prefix "-" base)) + (while (buffer-live-p (get-buffer bname)) + (setq bname (concat prefix "-" (number-to-string (incf n)) "-" base))) + (condition-case nil + (make-indirect-buffer buffer bname 'clone) + (error (make-indirect-buffer buffer bname))))) + + +;;; 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." + (when org-capture-templates + (if keys + (or (assoc keys org-capture-templates) + (error "No capture template referred to by \"%s\" keys" keys)) + (if (= 1 (length org-capture-templates)) + (car org-capture-templates) + (org-mks org-capture-templates + "Select a capture template\n=========================" + "Template key: " + '(("C" "Customize org-capture-templates") + ("q" "Abort"))))))) + +(defun org-capture-fill-template (&optional template initial annotation) + "Fill a template and return the filled template as a string. +The template may still contain \"%?\" for cursor positioning." + (setq template (or template (org-capture-get :template))) + (when (stringp initial) + (setq initial (org-no-properties initial)) + (remove-text-properties 0 (length initial) '(read-only t) initial)) + (let* ((buffer (org-capture-get :buffer)) + (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) + (ct (org-capture-get :default-time)) + (dct (decode-time ct)) + (ct1 + (if (< (nth 2 dct) org-extend-today-until) + (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) + ct)) + (plist-p (if org-store-link-plist t nil)) + (v-c (and (> (length kill-ring) 0) (current-kill 0))) + (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' might habe been passed. + ;; But if the property list has them, we prefer those values + (v-i (or (plist-get org-store-link-plist :initial) + initial + (org-capture-get :initial) + "")) + (v-a (or (plist-get org-store-link-plist :annotation) + annotation + (org-capture-get :annotation) + "")) + ;; Is the link empty? Then we do not want it... + (v-a (if (equal v-a "[[]]") "" v-a)) + (clipboards (remove nil (list v-i + (org-get-x-clipboard 'PRIMARY) + (org-get-x-clipboard 'CLIPBOARD) + (org-get-x-clipboard 'SECONDARY) + v-c))) + (v-A (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-substring-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) + + (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 template (setq template "") (message "No template") (ding) + (sit-for 1)) + (save-window-excursion + (delete-other-windows) + (switch-to-buffer (get-buffer-create "*Capture*")) + (erase-buffer) + (insert template) + (goto-char (point-min)) + (org-capture-steal-local-variables buffer) + (setq buffer-file-name nil) + + ;; %[] Insert contents of a file. + (goto-char (point-min)) + (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) + (unless (org-capture-escaped-%) + (let ((start (match-beginning 0)) + (end (match-end 0)) + (filename (expand-file-name (match-string 1)))) + (goto-char start) + (delete-region start end) + (condition-case error + (insert-file-contents filename) + (error (insert (format "%%![Couldn't insert %s: %s]" + filename error))))))) + ;; %() embedded elisp + (goto-char (point-min)) + (while (re-search-forward "%\\((.+)\\)" nil t) + (unless (org-capture-escaped-%) + (goto-char (match-beginning 0)) + (let ((template-start (point))) + (forward-char 1) + (let ((result + (condition-case error + (eval (read (current-buffer))) + (error (format "%%![Error: %s]" error))))) + (delete-region template-start (point)) + (insert result))))) + + ;; Simple %-escapes + (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) + (unless (org-capture-escaped-%) + (when (and initial (equal (match-string 0) "%i")) + (save-match-data + (let* ((lead (buffer-substring + (point-at-bol) (match-beginning 0)))) + (setq v-i (mapconcat 'identity + (org-split-string initial "\n") + (concat "\n" lead)))))) + (replace-match + (or (eval (intern (concat "v-" (match-string 1)))) "") + t t))) + + ;; From the property list + (when plist-p + (goto-char (point-min)) + (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) + (unless (org-capture-escaped-%) + (and (setq x (or (plist-get org-store-link-plist + (intern (match-string 1))) "")) + (replace-match x t t))))) + + ;; Turn on org-mode in temp buffer, set local variables + ;; This is to support completion in interactive prompts + (let ((org-inhibit-startup t)) (org-mode)) + ;; Interactive template entries + (goto-char (point-min)) + (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" + nil t) + (unless (org-capture-escaped-%) + (setq char (if (match-end 3) (match-string 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-capture-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-substring-no-properties prompt)) + (pall (concat prop "_ALL")) + (allowed + (with-current-buffer + (get-buffer (file-name-nondirectory 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 + (get-buffer (file-name-nondirectory 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) char) t nil + prompt)) + (if (equal (upcase char) char) (setq org-time-was-given t)) + (org-insert-time-stamp time org-time-was-given + (member char '("u" "U")) + nil nil (list org-end-time-was-given))) + (t + (let (org-completion-use-ido) + (insert (org-completing-read-no-i + (concat (if prompt prompt "Enter string") + (if default (concat " [" default "]")) + ": ") + completions nil nil nil histvar default))))))) + ;; Make sure there are no empty lines before the text, and that + ;; it ends with a newline character + (goto-char (point-min)) + (while (looking-at "[ \t]*\n") (replace-match "")) + (if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n")) + ;; Return the expanded tempate and kill the temporary buffer + (untabify (point-min) (point-max)) + (set-buffer-modified-p nil) + (prog1 (buffer-string) (kill-buffer (current-buffer)))))) + +(defun org-capture-escaped-% () + "Check if % was escaped - if yes, unescape it now." + (if (equal (char-before (match-beginning 0)) ?\\) + (progn + (delete-region (1- (match-beginning 0)) (match-beginning 0)) + t) + nil)) + +;;;###autoload +(defun org-capture-import-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? ") + (yes-or-no-p + "Note that this will remove any templates currently defined in `org-capture-templates'. Do you still want to go ahead? ")) + (require 'org-remember) + (setq org-capture-templates + (mapcar + (lambda (entry) + (let ((desc (car entry)) + (key (char-to-string (nth 1 entry))) + (template (nth 2 entry)) + (file (or (nth 3 entry) org-default-notes-file)) + (position (or (nth 4 entry) org-remember-default-headline)) + (type 'entry) + (prepend org-reverse-note-order) + immediate target) + (cond + ((member position '(top bottom)) + (setq target (list 'file file) + prepend (eq position 'top))) + ((eq position 'date-tree) + (setq target (list 'file+datetree file) + prepend nil)) + (t (setq target (list 'file+headline file position)))) + + (when (string-match "%!" template) + (setq template (replace-match "" t t template) + immediate t)) + + (append (list key desc type target template) + (if prepend '(:prepend t)) + (if immediate '(:immediate-finish t))))) + + org-remember-templates)))) + +(provide 'org-capture) + +;; arch-tag: 986bf41b-8ada-4e28-bf20-e8388a7205a0 + +;;; org-capture.el ends here + + diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 02ad4bf8b50..f451cf80792 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -29,9 +29,10 @@ ;; This file contains the time clocking code for Org-mode (require 'org) +;;; Code: + (eval-when-compile - (require 'cl) - (require 'calendar)) + (require 'cl)) (declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) (defvar org-time-stamp-formats) @@ -83,7 +84,7 @@ clocking out." (defcustom org-clock-in-switch-to-state nil "Set task to a special todo state while clocking it. The value should be the state to which the entry should be -switched. If the value is a function, it must take one +switched. If the value is a function, it must take one parameter (the current TODO state of the item) and return the state to switch it to." :group 'org-clock @@ -96,7 +97,7 @@ state to switch it to." (defcustom org-clock-out-switch-to-state nil "Set task to a special todo state after clocking out. The value should be the state to which the entry should be -switched. If the value is a function, it must take one +switched. If the value is a function, it must take one parameter (the current TODO state of the item) and return the state to switch it to." :group 'org-clock @@ -124,7 +125,7 @@ The function is called with point at the beginning of the headline." :type 'function) (defcustom org-clock-string-limit 0 - "Maximum length of clock strings in the modeline. 0 means no limit." + "Maximum length of clock strings in the modeline. 0 means no limit." :group 'org-clock :type 'integer) @@ -136,8 +137,8 @@ the clock can be resumed from that point." :type 'boolean) (defcustom org-clock-persist nil - "When non-nil, save the running clock when emacs is closed. -The clock is resumed when emacs restarts. + "When non-nil, save the running clock when Emacs is closed. +The clock is resumed when Emacs restarts. When this is t, both the running clock, and the entire clock history are saved. When this is the symbol `clock', only the running clock is saved. @@ -245,6 +246,11 @@ string as argument." :group 'org-clock :type 'boolean) +(defcustom org-clock-resolve-expert nil + "Non-nil means do not show the splash buffer with the clock resolver." + :group 'org-clock + :type 'boolean) + (defvar org-clock-in-prepare-hook nil "Hook run when preparing the clock. This hook is run before anything happens to the task that @@ -277,7 +283,7 @@ to add an effort property.") "If non-nil, user cancelled a clock; this is when leftover time started.") (defvar org-clock-effort "" - "Effort estimate of the currently clocking task") + "Effort estimate of the currently clocking task.") (defvar org-clock-total-time nil "Holds total time, spent previously on currently clocked item. @@ -310,7 +316,10 @@ of a different task.") (defun org-clock-history-push (&optional pos buffer) "Push a marker to the clock history." (setq org-clock-history-length (max 1 (min 35 org-clock-history-length))) - (let ((m (move-marker (make-marker) (or pos (point)) buffer)) n l) + (let ((m (move-marker (make-marker) + (or pos (point)) (org-base-buffer + (or buffer (current-buffer))))) + n l) (while (setq n (member m org-clock-history)) (move-marker (car n) nil)) (setq org-clock-history @@ -334,11 +343,11 @@ of a different task.") org-clock-history)) (defun org-clocking-buffer () - "Returns clocking buffer if we are currently clocking a task or nil" + "Return the clocking buffer if we are currently clocking a task or nil." (marker-buffer org-clock-marker)) (defun org-clocking-p () - "Returns t when clocking a task" + "Return t when clocking a task." (not (equal (org-clocking-buffer) nil))) (defun org-clock-select-task (&optional prompt) @@ -501,7 +510,8 @@ the mode line." ;; A string. See if it is a delta (setq sign (string-to-char value)) (if (member sign '(?- ?+)) - (setq current (org-hh:mm-string-to-minutes (substring current 1))) + (setq current (org-hh:mm-string-to-minutes current) + value (substring value 1)) (setq current 0)) (setq value (org-hh:mm-string-to-minutes value)) (if (equal ?- sign) @@ -587,7 +597,7 @@ Use alsa's aplay tool if available." (save-excursion (goto-char (point-min)) (while (re-search-forward "CLOCK: \\(\\[.*?\\]\\)$" nil t) - (push (cons (copy-marker (1- (match-end 1)) t) + (push (cons (copy-marker (match-end 1) t) (org-time-string-to-time (match-string 1))) clocks)))) clocks)) @@ -624,12 +634,12 @@ This macro also protects the current active clock from being altered." (put 'org-with-clock 'lisp-indent-function 1) -(defsubst org-clock-clock-in (clock &optional resume) +(defsubst org-clock-clock-in (clock &optional resume start-time) "Clock in to the clock located by CLOCK. If necessary, clock-out of the currently active clock." (org-with-clock-position clock (let ((org-clock-in-resume (or resume org-clock-in-resume))) - (org-clock-in)))) + (org-clock-in nil start-time)))) (defsubst org-clock-clock-out (clock &optional fail-quietly at-time) "Clock out of the clock located by CLOCK." @@ -655,39 +665,10 @@ If necessary, clock-out of the currently active clock." (defvar org-clock-resolving-clocks nil) (defvar org-clock-resolving-clocks-due-to-idleness nil) -(defun org-clock-resolve-clock (clock resolve-to &optional close-p - restart-p fail-quietly) +(defun org-clock-resolve-clock (clock resolve-to clock-out-time + &optional close-p restart-p fail-quietly) "Resolve `CLOCK' given the time `RESOLVE-TO', and the present. -`CLOCK' is a cons cell of the form (MARKER START-TIME). -This routine can do one of many things: - - if `RESOLVE-TO' is nil - if `CLOSE-P' is non-nil, give an error - if this clock is the active clock, cancel it - else delete the clock line (as if it never happened) - if `RESTART-P' is non-nil, start a new clock - - else if `RESOLVE-TO' is the symbol `now' - if `RESTART-P' is non-nil, give an error - if `CLOSE-P' is non-nil, clock out the entry and - if this clock is the active clock, stop it - else if this clock is the active clock, do nothing - else if there is no active clock, resume this clock - else ask to cancel the active clock, and if so, - resume this clock after cancelling it - - else if `RESOLVE-TO' is some date in the future - give an error about `RESOLVE-TO' being invalid - - else if `RESOLVE-TO' is some date in the past - if `RESTART-P' is non-nil, give an error - if `CLOSE-P' is non-nil, enter a closing time and - if this clock is the active clock, stop it - else if this clock is the active clock, enter a - closing time, stop the current clock, then - start a new clock for the same item - else just enter a closing time for this clock - and then start a new clock for the same item" +`CLOCK' is a cons cell of the form (MARKER START-TIME)." (let ((org-clock-resolving-clocks t)) (cond ((null resolve-to) @@ -709,11 +690,41 @@ This routine can do one of many things: (t (if restart-p (error "RESTART-P is not valid here")) - (org-clock-clock-out clock fail-quietly resolve-to) + (org-clock-clock-out clock fail-quietly (or clock-out-time + resolve-to)) (unless org-clock-clocking-in (if close-p - (setq org-clock-leftover-time resolve-to) - (org-clock-clock-in clock))))))) + (setq org-clock-leftover-time (and (null clock-out-time) + resolve-to)) + (org-clock-clock-in clock nil (and clock-out-time + resolve-to)))))))) + +(defun org-clock-jump-to-current-clock (&optional effective-clock) + (interactive) + (let ((clock (or effective-clock (cons org-clock-marker + org-clock-start-time)))) + (unless (marker-buffer (car clock)) + (error "No clock is currently running")) + (org-with-clock clock (org-clock-goto)) + (with-current-buffer (marker-buffer (car clock)) + (goto-char (car clock)) + (if org-clock-into-drawer + (let ((logbook + (if (stringp org-clock-into-drawer) + (concat ":" org-clock-into-drawer ":") + ":LOGBOOK:"))) + (ignore-errors + (outline-flag-region + (save-excursion + (outline-back-to-heading t) + (search-forward logbook) + (goto-char (match-beginning 0))) + (save-excursion + (outline-back-to-heading t) + (search-forward logbook) + (search-forward ":END:") + (goto-char (match-end 0))) + nil))))))) (defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly) "Resolve an open org-mode clock. @@ -739,51 +750,66 @@ was started." (save-window-excursion (save-excursion (unless org-clock-resolving-clocks-due-to-idleness - (org-with-clock clock (org-clock-goto)) - (with-current-buffer (marker-buffer (car clock)) - (goto-char (car clock)) - (if org-clock-into-drawer - (let ((logbook - (if (stringp org-clock-into-drawer) - (concat ":" org-clock-into-drawer ":") - ":LOGBOOK:"))) - (ignore-errors - (outline-flag-region - (save-excursion - (outline-back-to-heading t) - (search-forward logbook) - (goto-char (match-beginning 0))) - (save-excursion - (outline-back-to-heading t) - (search-forward logbook) - (search-forward ":END:") - (goto-char (match-end 0))) - nil)))))) + (org-clock-jump-to-current-clock clock)) + (unless org-clock-resolve-expert + (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. + +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 +to be CLOCKED OUT."))) + (org-fit-window-to-buffer (get-buffer-window "*Org Clock*")) (let (char-pressed) - (if (featurep 'xemacs) - (progn - (message (concat (funcall prompt-fn clock) - " [(kK)eep (sS)ubtract (C)ancel]? ")) - (setq char-pressed (read-char-exclusive))) + (when (featurep 'xemacs) + (message (concat (funcall prompt-fn clock) + " [jkKgGsScCiq]? ")) + (setq char-pressed (read-char-exclusive))) (while (or (null char-pressed) - (and (not (memq char-pressed '(?k ?K ?s ?S ?C ?i))) + (and (not (memq char-pressed + '(?k ?K ?g ?G ?s ?S ?C + ?j ?J ?i ?q))) (or (ding) t))) (setq char-pressed (read-char (concat (funcall prompt-fn clock) - " [(kK)p (sS)ub (C)ncl (i)gn]? ") + " [jkKgGSscCiq]? ") nil 45))) - (and (not (eq char-pressed ?i)) char-pressed)))))) - (default (floor (/ (org-float-time - (time-subtract (current-time) last-valid)) 60))) - (keep (and (memq ch '(?k ?K)) - (read-number "Keep how many minutes? " default))) + (and (not (memq char-pressed '(?i ?q))) char-pressed))))) + (default + (floor (/ (org-float-time + (time-subtract (current-time) last-valid)) 60))) + (keep + (and (memq ch '(?k ?K)) + (read-number "Keep how many minutes? " default))) + (gotback + (and (memq ch '(?g ?G)) + (read-number "Got back how many minutes ago? " default))) (subtractp (memq ch '(?s ?S))) (barely-started-p (< (- (org-float-time last-valid) (org-float-time (cdr clock))) 45)) (start-over (and subtractp barely-started-p))) - (if (or (null ch) - (not (memq ch '(?k ?K ?s ?S ?C)))) - (message "") + (cond + ((memq ch '(?j ?J)) + (if (eq ch ?J) + (org-clock-resolve-clock clock 'now nil t nil fail-quietly)) + (org-clock-jump-to-current-clock clock)) + ((or (null ch) + (not (memq ch '(?k ?K ?g ?G ?s ?S ?C)))) + (message "")) + (t (org-clock-resolve-clock clock (cond ((or (eq ch ?C) @@ -792,21 +818,29 @@ was started." ;; time... start-over) nil) - (subtractp + ((or subtractp + (and gotback (= gotback 0))) last-valid) - ((= keep default) + ((or (and keep (= keep default)) + (and gotback (= gotback default))) 'now) + (keep + (time-add last-valid (seconds-to-time (* 60 keep)))) + (gotback + (time-subtract (current-time) + (seconds-to-time (* 60 gotback)))) (t - (time-add last-valid (seconds-to-time (* 60 keep))))) - (memq ch '(?K ?S)) + (error "Unexpected, please report this as a bug"))) + (and gotback last-valid) + (memq ch '(?K ?G ?S)) (and start-over - (not (memq ch '(?K ?S ?C)))) - fail-quietly)))) + (not (memq ch '(?K ?G ?S ?C)))) + fail-quietly))))) -(defun org-resolve-clocks (&optional also-non-dangling-p prompt-fn last-valid) +(defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid) "Resolve all currently open org-mode clocks. -If `also-non-dangling-p' is non-nil, also ask to resolve -non-dangling (i.e., currently open and valid) clocks." +If `only-dangling-p' is non-nil, only ask to resolve dangling +\(i.e., not currently open and valid) clocks." (interactive "P") (unless org-clock-resolving-clocks (let ((org-clock-resolving-clocks t)) @@ -815,7 +849,7 @@ non-dangling (i.e., currently open and valid) clocks." (dolist (clock clocks) (let ((dangling (or (not (org-clock-is-active)) (/= (car clock) org-clock-marker)))) - (unless (and (not dangling) (not also-non-dangling-p)) + (if (or (not only-dangling-p) dangling) (org-clock-resolve clock (or prompt-fn @@ -837,11 +871,11 @@ non-dangling (i.e., currently open and valid) clocks." 0))) (defun org-mac-idle-seconds () - "Return the current Mac idle time in seconds" + "Return the current Mac idle time in seconds." (string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'"))) (defun org-x11-idle-seconds () - "Return the current X11 idle time in seconds" + "Return the current X11 idle time in seconds." (/ (string-to-number (shell-command-to-string "x11idle")) 1000)) (defun org-user-idle-seconds () @@ -882,11 +916,13 @@ so long." 60.0)))) org-clock-user-idle-start))))) -(defun org-clock-in (&optional select) +(defun org-clock-in (&optional select start-time) "Start the clock on the current item. If necessary, clock-out of the currently active clock. -With prefix arg SELECT, offer a list of recently clocked tasks to -clock into. When SELECT is `C-u C-u', clock into the current task and mark +With a prefix argument SELECT (\\[universal-argument]), offer a list of \ +recently clocked tasks to +clock into. When SELECT is \\[universal-argument] \\[universal-argument], \ +clock into the current task and mark is as the default task, a special task that will always be offered in the clocking selection, associated with the letter `d'." (interactive "P") @@ -930,7 +966,8 @@ the clocking selection, associated with the letter `d'." (move-marker org-clock-interrupted-task (marker-position org-clock-marker) (org-clocking-buffer)) - (org-clock-out t)))) + (let ((org-clock-clocking-in t)) + (org-clock-out t))))) (when (equal select '(16)) ;; Mark as default clocking task @@ -1027,6 +1064,7 @@ the clocking selection, associated with the letter `d'." (/ (- (org-float-time (current-time)) (org-float-time leftover)) 60))) leftover) + start-time (current-time))) (setq ts (org-insert-time-stamp org-clock-start-time 'with-hm 'inactive)))) @@ -1059,7 +1097,7 @@ the clocking selection, associated with the letter `d'." "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 (org-get-heading))) + (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)) @@ -1196,11 +1234,14 @@ line and position cursor in that line." If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (interactive) (catch 'exit - (if (not (org-clocking-p)) - (if fail-quietly (throw 'exit t) (error "No active clock"))) + (when (not (org-clocking-p)) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (force-mode-line-update) + (if fail-quietly (throw 'exit t) (error "No active clock"))) (let (ts te s h m remove) - (save-excursion - (set-buffer (org-clocking-buffer)) + (save-excursion ; Do not replace this with `with-current-buffer'. + (with-no-warnings (set-buffer (org-clocking-buffer))) (save-restriction (widen) (goto-char org-clock-marker) @@ -1263,12 +1304,15 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (org-clock-delete-current)))))) (defun org-clock-cancel () - "Cancel the running clock be removing the start timestamp." + "Cancel the running clock by removing the start timestamp." (interactive) - (if (not (org-clocking-p)) - (error "No active clock")) - (save-excursion - (set-buffer (org-clocking-buffer)) + (when (not (org-clocking-p)) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (force-mode-line-update) + (error "No active clock")) + (save-excursion ; Do not replace this with `with-current-buffer'. + (with-no-warnings (set-buffer (org-clocking-buffer))) (goto-char org-clock-marker) (delete-region (1- (point-at-bol)) (point-at-eol)) ;; Just in case, remove any empty LOGBOOK left over @@ -1313,10 +1357,13 @@ With prefix arg SELECT, offer recently clocked tasks for selection." "Holds the file total time in minutes, after a call to `org-clock-sum'.") (make-variable-buffer-local 'org-clock-file-total-minutes) -(defun org-clock-sum (&optional tstart tend) +(defun org-clock-sum (&optional tstart tend headline-filter) "Sum the times for each subtree. Puts the resulting times in minutes as a text property on each headline. -TSTART and TEND can mark a time range to be considered." +TSTART and TEND can mark a time range to be considered. HEADLINE-FILTER is a +zero-arg function that, if specified, is called for each headline in the time +range with point at the headline. Headlines for which HEADLINE-FILTER returns +nil are excluded from the clock summation." (interactive) (let* ((bmp (buffer-modified-p)) (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" @@ -1332,7 +1379,9 @@ TSTART and TEND can mark a time range to be considered." (if (stringp tend) (setq tend (org-time-string-to-seconds tend))) (if (consp tstart) (setq tstart (org-float-time tstart))) (if (consp tend) (setq tend (org-float-time tend))) - (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) + (remove-text-properties (point-min) (point-max) + '(:org-clock-minutes t + :org-clock-force-headline-inclusion t)) (save-excursion (goto-char (point-max)) (while (re-search-backward re nil t) @@ -1357,24 +1406,47 @@ TSTART and TEND can mark a time range to be considered." ;; Add the currently clocking item time to the total (when (and org-clock-report-include-clocking-task (equal (org-clocking-buffer) (current-buffer)) - (equal (marker-position org-clock-hd-marker) (point))) - (let ((time (floor (- (org-float-time) - (org-float-time org-clock-start-time)) 60))) - (setq t1 (+ t1 time)))) - (setq level (- (match-end 1) (match-beginning 1))) - (when (or (> t1 0) (> (aref ltimes level) 0)) - (loop for l from 0 to level do - (aset ltimes l (+ (aref ltimes l) t1))) - (setq t1 0 time (aref ltimes level)) - (loop for l from level to (1- lmax) do - (aset ltimes l 0)) - (goto-char (match-beginning 0)) - (put-text-property (point) (point-at-eol) :org-clock-minutes time))))) + (equal (marker-position org-clock-hd-marker) (point)) + tstart + tend + (>= (org-float-time org-clock-start-time) tstart) + (<= (org-float-time org-clock-start-time) tend)) + (let ((time (floor (- (org-float-time) + (org-float-time org-clock-start-time)) 60))) + (setq t1 (+ t1 time)))) + (let* ((headline-forced + (get-text-property (point) + :org-clock-force-headline-inclusion)) + (headline-included + (or (null headline-filter) + (save-excursion + (save-match-data (funcall headline-filter)))))) + (setq level (- (match-end 1) (match-beginning 1))) + (when (or (> t1 0) (> (aref ltimes level) 0)) + (when (or headline-included headline-forced) + (if headline-included + (loop for l from 0 to level do + (aset ltimes l (+ (aref ltimes l) t1)))) + (setq time (aref ltimes level)) + (goto-char (match-beginning 0)) + (put-text-property (point) (point-at-eol) :org-clock-minutes time) + (if headline-filter + (save-excursion + (save-match-data + (while + (> (funcall outline-level) 1) + (outline-up-heading 1 t) + (put-text-property + (point) (point-at-eol) + :org-clock-force-headline-inclusion t)))))) + (setq t1 0) + (loop for l from level to (1- lmax) do + (aset ltimes l 0))))))) (setq org-clock-file-total-minutes (aref ltimes 0))) (set-buffer-modified-p bmp))) (defun org-clock-sum-current-item (&optional tstart) - "Returns time, clocked on current item in total" + "Return time, clocked on current item in total." (save-excursion (save-restriction (org-narrow-to-subtree) @@ -1430,7 +1502,7 @@ will be easy to remove." (org-move-to-column c) (unless (eolp) (skip-chars-backward "^ \t")) (skip-chars-backward " \t") - (setq ov (org-make-overlay (1- (point)) (point-at-eol)) + (setq ov (make-overlay (1- (point)) (point-at-eol)) tx (concat (buffer-substring (1- (point)) (point)) (make-string (+ off (max 0 (- c (current-column)))) ?.) (org-add-props (if org-time-clocksum-use-fractional @@ -1444,9 +1516,9 @@ will be easy to remove." (list 'face 'org-clock-overlay)) "")) (if (not (featurep 'xemacs)) - (org-overlay-put ov 'display tx) - (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'end-glyph (make-glyph tx))) + (overlay-put ov 'display tx) + (overlay-put ov 'invisible t) + (overlay-put ov 'end-glyph (make-glyph tx))) (push ov org-clock-overlays))) (defun org-clock-remove-overlays (&optional beg end noremove) @@ -1455,7 +1527,7 @@ BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." (interactive) (unless org-inhibit-highlight-removal - (mapc 'org-delete-overlay org-clock-overlays) + (mapc 'delete-overlay org-clock-overlays) (setq org-clock-overlays nil) (unless noremove (remove-hook 'before-change-functions @@ -1689,6 +1761,8 @@ the currently selected interval size." (te (plist-get params :tend)) (block (plist-get params :block)) (link (plist-get params :link)) + (tags (plist-get params :tags)) + (matcher (if tags (cdr (org-make-tags-matcher tags)))) ipos time p level hlc hdl tsp props content recalc formula pcol cc beg end pos tbl tbl1 range-text rm-file-column scope-is-list st) (setq org-clock-file-total-minutes nil) @@ -1770,7 +1844,14 @@ the currently selected interval size." (goto-char pos) (unless scope-is-list - (org-clock-sum ts te) + (org-clock-sum ts te + (unless (null matcher) + (lambda () + (let ((tags-list + (org-split-string + (or (org-entry-get (point) "ALLTAGS") "") + ":"))) + (eval matcher))))) (goto-char (point-min)) (setq st t) (while (or (and (bobp) (prog1 st (setq st nil)) @@ -1874,7 +1955,8 @@ the currently selected interval size." (org-table-recalculate 'all)) (when rm-file-column (forward-char 1) - (org-table-delete-column))))))) + (org-table-delete-column)) + total-time))))) (defun org-clocktable-steps (params) (let* ((p1 (copy-sequence params)) @@ -1882,8 +1964,9 @@ the currently selected interval size." (te (plist-get p1 :tend)) (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) + cc range-text step-time) (when block (setq cc (org-clock-special-range block nil t) ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) @@ -1904,8 +1987,14 @@ the currently selected interval size." (seconds-to-time (setq ts (+ ts step)))))) (insert "\n" (if (eq step0 'day) "Daily report: " "Weekly report starting on: ") (plist-get p1 :tstart) "\n") - (org-dblock-write:clocktable p1) + (setq step-time (org-dblock-write:clocktable p1)) (re-search-forward "#\\+END:") + (when (and (equal step-time 0) stepskip0) + ;; Remove the empty table + (delete-region (point-at-bol) + (save-excursion + (re-search-backward "^\\(Daily\\|Weekly\\) report" nil t) + (point)))) (end-of-line 0)))) (defun org-clocktable-add-file (file table) @@ -2038,7 +2127,7 @@ The details of what will be saved are regulated by the variable ;;;###autoload (defun org-clock-persistence-insinuate () - "Set up hooks for clock persistence" + "Set up hooks for clock persistence." (add-hook 'org-mode-hook 'org-clock-load) (add-hook 'kill-emacs-hook 'org-clock-save)) diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index 38938a53837..8e45fdf3e3c 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -36,6 +36,9 @@ (declare-function org-agenda-redo "org-agenda" ()) (declare-function org-agenda-do-context-action "org-agenda" ()) +(when (featurep 'xemacs) + (error "Do not load this file into XEmacs, use 'org-colview-xemacs.el'.")) + ;;; Column View (defvar org-columns-overlays nil @@ -146,8 +149,8 @@ This is the compiled version of the format.") (defun org-columns-new-overlay (beg end &optional string face) "Create a new column overlay and add it to the list." - (let ((ov (org-make-overlay beg end))) - (org-overlay-put ov 'face (or face 'secondary-selection)) + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face (or face 'secondary-selection)) (org-overlay-display ov string face) (push ov org-columns-overlays) ov)) @@ -220,12 +223,12 @@ This is the compiled version of the format.") (org-unmodified (setq ov (org-columns-new-overlay beg (setq beg (1+ beg)) string (if dateline face1 face))) - (org-overlay-put ov 'keymap org-columns-map) - (org-overlay-put ov 'org-columns-key property) - (org-overlay-put ov 'org-columns-value (cdr ass)) - (org-overlay-put ov 'org-columns-value-modified modval) - (org-overlay-put ov 'org-columns-pom pom) - (org-overlay-put ov 'org-columns-format f)) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'org-columns-key property) + (overlay-put ov 'org-columns-value (cdr ass)) + (overlay-put ov 'org-columns-value-modified modval) + (overlay-put ov 'org-columns-pom pom) + (overlay-put ov 'org-columns-format f)) (if (or (not (char-after beg)) (equal (char-after beg) ?\n)) (let ((inhibit-read-only t)) @@ -235,12 +238,12 @@ This is the compiled version of the format.") ;; Make the rest of the line disappear. (org-unmodified (setq ov (org-columns-new-overlay beg (point-at-eol))) - (org-overlay-put ov 'invisible t) - (org-overlay-put ov 'keymap org-columns-map) - (org-overlay-put ov 'intangible t) + (overlay-put ov 'invisible t) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'intangible t) (push ov org-columns-overlays) - (setq ov (org-make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) - (org-overlay-put ov 'keymap org-columns-map) + (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) + (overlay-put ov 'keymap org-columns-map) (push ov org-columns-overlays) (let ((inhibit-read-only t)) (put-text-property (max (point-min) (1- (point-at-bol))) @@ -298,7 +301,7 @@ for the duration of the command.") (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local))) (defun org-columns-hscoll-title () - "Set the header-line-format so that it scrolls along with the table." + "Set the `header-line-format' so that it scrolls along with the table." (sit-for .0001) ; need to force a redisplay to update window-hscroll (when (not (= (window-hscroll) org-columns-previous-hscroll)) (setq header-line-format @@ -323,7 +326,7 @@ for the duration of the command.") (move-marker org-columns-begin-marker nil) (move-marker org-columns-top-level-marker nil) (org-unmodified - (mapc 'org-delete-overlay org-columns-overlays) + (mapc 'delete-overlay org-columns-overlays) (setq org-columns-overlays nil) (let ((inhibit-read-only t)) (remove-text-properties (point-min) (point-max) '(read-only t)))) @@ -495,7 +498,7 @@ Where possible, use the standard interface for changing this line." (progn (setq org-columns-overlays (org-delete-all line-overlays org-columns-overlays)) - (mapc 'org-delete-overlay line-overlays) + (mapc 'delete-overlay line-overlays) (org-columns-eval eval)) (org-columns-display-here))) (org-move-to-column col) @@ -624,7 +627,7 @@ an integer, select that value." (progn (setq org-columns-overlays (org-delete-all line-overlays org-columns-overlays)) - (mapc 'org-delete-overlay line-overlays) + (mapc 'delete-overlay line-overlays) (org-columns-eval '(org-entry-put pom key nval))) (org-columns-display-here))) (org-move-to-column col) @@ -746,17 +749,17 @@ around it." (lambda (x) (- org-columns-time x)))) "Operator <-> format,function,calc map. Used to compile/uncompile columns format and completing read in -interactive function org-columns-new. +interactive function `org-columns-new'. operator string used in #+COLUMNS definition describing the summary type format symbol describing summary type selected interactively in - org-columns-new and internally in - org-columns-number-to-string and - org-columns-string-to-number + `org-columns-new' and internally in + `org-columns-number-to-string' and + `org-columns-string-to-number' function called with a list of values as argument to calculate the summary value -calc function called on every element before summarizing. This is +calc function called on every element before summarizing. This is optional and should only be specified if needed") (defun org-columns-new (&optional prop title width op fmt fun &rest rest) @@ -918,15 +921,15 @@ Don't set this, this is meant for dynamic scoping.") (let (fmt val pos) (save-excursion (mapc (lambda (ov) - (when (equal (org-overlay-get ov 'org-columns-key) property) - (setq pos (org-overlay-start ov)) + (when (equal (overlay-get ov 'org-columns-key) property) + (setq pos (overlay-start ov)) (goto-char pos) (when (setq val (cdr (assoc property (get-text-property (point-at-bol) 'org-summaries)))) - (setq fmt (org-overlay-get ov 'org-columns-format)) - (org-overlay-put ov 'org-columns-value val) - (org-overlay-put ov 'display (format fmt val))))) + (setq fmt (overlay-get ov 'org-columns-format)) + (overlay-put ov 'org-columns-value val) + (overlay-put ov 'display (format fmt val))))) org-columns-overlays)))) (defun org-columns-compute (property) @@ -1109,8 +1112,7 @@ operator the operator if any format the output format for computed results, derived from operator printf a printf format for computed values fun the lisp function to compute summary values, derived from operator -calc function to get values from base elements -" +calc function to get values from base elements" (let ((start 0) width prop title op op-match f printf fun calc) (setq org-columns-current-fmt-compiled nil) (while (string-match @@ -1479,7 +1481,7 @@ This will add overlays to the date lines, to show the summary for each day." (org-columns-compute (car fm))))))))))) (defun org-format-time-period (interval) - "Convert time in fractional days to days/hours/minutes/seconds" + "Convert time in fractional days to days/hours/minutes/seconds." (if (numberp interval) (let* ((days (floor interval)) (frac-hours (* 24 (- interval days))) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 80a45d61f22..1b96b8d0535 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -39,7 +39,10 @@ (declare-function find-library-name "find-func" (library)) (declare-function w32-focus-frame "term/w32-win" (frame)) -(defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself +;; The following constant is for backward compatibility. We do not use +;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs) +;; at compilation time and can therefore optimize code better. +(defconst org-xemacs-p (featurep 'xemacs)) (defconst org-format-transports-properties-p (let ((x "a")) (add-text-properties 0 1 '(test t) x) @@ -86,25 +89,44 @@ any other entries, and any resulting duplicates will be removed entirely." (t specs))) (put 'org-compatible-face 'lisp-indent-function 1) +(defun org-version-check (version feature level) + (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) + (v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) + (rmaj (or (nth 0 v1) 99)) + (rmin (or (nth 1 v1) 99)) + (rbld (or (nth 2 v1) 99)) + (maj (or (nth 0 v2) 0)) + (min (or (nth 1 v2) 0)) + (bld (or (nth 2 v2) 0))) + (if (or (< maj rmaj) + (and (= maj rmaj) + (< min rmin)) + (and (= maj rmaj) + (= min rmin) + (< bld rbld))) + (if (eq level :predicate) + ;; just return if we have the version + nil + (let ((msg (format "Emacs %s or greater is recommended for %s" + version feature))) + (display-warning 'org msg level) + t)) + t))) + ;;;; Emacs/XEmacs compatibility +;; Keys +(defconst org-xemacs-key-equivalents + '(([mouse-1] . [button1]) + ([mouse-2] . [button2]) + ([mouse-3] . [button3]) + ([C-mouse-4] . [(control mouse-4)]) + ([C-mouse-5] . [(control mouse-5)])) + "Translation alist for a couple of keys.") + ;; Overlay compatibility functions -(defun org-make-overlay (beg end &optional buffer) - (if (featurep 'xemacs) - (make-extent beg end buffer) - (make-overlay beg end buffer))) -(defun org-delete-overlay (ovl) - (if (featurep 'xemacs) (progn (delete-extent ovl) nil) (delete-overlay ovl))) (defun org-detach-overlay (ovl) (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) -(defun org-move-overlay (ovl beg end &optional buffer) - (if (featurep 'xemacs) - (set-extent-endpoints ovl beg end (or buffer (current-buffer))) - (move-overlay ovl beg end buffer))) -(defun org-overlay-put (ovl prop value) - (if (featurep 'xemacs) - (set-extent-property ovl prop value) - (overlay-put ovl prop value))) (defun org-overlay-display (ovl text &optional face evap) "Make overlay OVL display TEXT with face FACE." (if (featurep 'xemacs) @@ -124,32 +146,24 @@ any other entries, and any resulting duplicates will be removed entirely." (if face (org-add-props text nil 'face face)) (overlay-put ovl 'before-string text) (if evap (overlay-put ovl 'evaporate t)))) -(defun org-overlay-get (ovl prop) - (if (featurep 'xemacs) - (extent-property ovl prop) - (overlay-get ovl prop))) -(defun org-overlays-at (pos) - (if (featurep 'xemacs) (extents-at pos) (overlays-at pos))) -(defun org-overlays-in (&optional start end) - (if (featurep 'xemacs) - (extent-list nil start end) - (overlays-in start end))) -(defun org-overlay-start (o) - (if (featurep 'xemacs) (extent-start-position o) (overlay-start o))) -(defun org-overlay-end (o) - (if (featurep 'xemacs) (extent-end-position o) (overlay-end o))) -(defun org-overlay-buffer (o) - (if (featurep 'xemacs) (extent-buffer o) (overlay-buffer o))) (defun org-find-overlays (prop &optional pos delete) "Find all overlays specifying PROP at POS or point. If DELETE is non-nil, delete all those overlays." - (let ((overlays (org-overlays-at (or pos (point)))) + (let ((overlays (overlays-at (or pos (point)))) ov found) (while (setq ov (pop overlays)) - (if (org-overlay-get ov prop) - (if delete (org-delete-overlay ov) (push ov found)))) + (if (overlay-get ov prop) + (if delete (delete-overlay ov) (push ov found)))) found)) +(defun org-get-x-clipboard (value) + "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21." + (if (eq window-system 'x) + (let ((x (org-get-x-clipboard-compat value))) + (if x (org-no-properties x))))) + +;; Miscellaneous functions + (defun org-add-hook (hook function &optional append local) "Add-hook, compatible with both Emacsen." (if (and local (featurep 'xemacs)) @@ -170,7 +184,7 @@ that will be added to PLIST. Returns the string that was modified." "Fit WINDOW to the buffer, but only if it is not a side-by-side window. WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call -`shrink-window-if-larger-than-buffer' instead, the hight limit are +`shrink-window-if-larger-than-buffer' instead, the height limit is ignored in this case." (cond ((if (fboundp 'window-full-width-p) (not (window-full-width-p window)) @@ -206,19 +220,6 @@ Works on both Emacs and XEmacs." ;; Invisibility compatibility -(defun org-add-to-invisibility-spec (arg) - "Add elements to `buffer-invisibility-spec'. -See documentation for `buffer-invisibility-spec' for the kind of elements -that can be added." - (cond - ((fboundp 'add-to-invisibility-spec) - (add-to-invisibility-spec arg)) - ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t)) - (setq buffer-invisibility-spec (list arg))) - (t - (setq buffer-invisibility-spec - (cons arg buffer-invisibility-spec))))) - (defun org-remove-from-invisibility-spec (arg) "Remove elements from `buffer-invisibility-spec'." (if (fboundp 'remove-from-invisibility-spec) @@ -233,62 +234,42 @@ that can be added." (member arg buffer-invisibility-spec) nil)) +(defmacro org-xemacs-without-invisibility (&rest body) + "Turn off exents with invisibility while executing BODY." + `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol) + 'all-extents-closed-open 'invisible)) + ext-inv-specs) + (dolist (ext ext-inv) + (when (extent-property ext 'invisible) + (add-to-list 'ext-inv-specs (list ext (extent-property + ext 'invisible))) + (set-extent-property ext 'invisible nil))) + ,@body + (dolist (ext-inv-spec ext-inv-specs) + (set-extent-property (car ext-inv-spec) 'invisible + (cadr ext-inv-spec))))) + (defun org-indent-to-column (column &optional minimum buffer) "Work around a bug with extents with invisibility in XEmacs." (if (featurep 'xemacs) - (let ((ext-inv (extent-list - nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property - ext 'invisible))) - (set-extent-property ext 'invisible nil))) - (indent-to-column column minimum buffer) - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec)))) + (org-xemacs-without-invisibility (indent-to-column column minimum buffer)) (indent-to-column column minimum))) (defun org-indent-line-to (column) "Work around a bug with extents with invisibility in XEmacs." (if (featurep 'xemacs) - (let ((ext-inv (extent-list - nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property - ext 'invisible))) - (set-extent-property ext 'invisible nil))) - (indent-line-to column) - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec)))) + (org-xemacs-without-invisibility (indent-line-to column)) (indent-line-to column))) (defun org-move-to-column (column &optional force buffer) (if (featurep 'xemacs) - (let ((ext-inv (extent-list - nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property ext - 'invisible))) - (set-extent-property ext 'invisible nil))) - (move-to-column column force buffer) - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec)))) + (org-xemacs-without-invisibility (move-to-column column force buffer)) (move-to-column column force))) (defun org-get-x-clipboard-compat (value) - "Get the clipboard value on XEmacs or Emacs 21" - (cond (org-xemacs-p (org-no-warnings (get-selection-no-error value))) + "Get the clipboard value on XEmacs or Emacs 21." + (cond ((featurep 'xemacs) + (org-no-warnings (get-selection-no-error value))) ((fboundp 'x-get-selection) (condition-case nil (or (x-get-selection value 'UTF8_STRING) @@ -362,6 +343,18 @@ TIME defaults to the current time." (time-to-seconds (or time (current-time))) (float-time time))) +(defun org-string-match-p (&rest args) + (if (fboundp 'string-match-p) + (apply 'string-match-p args) + (save-match-data + (apply 'string-match args)))) + +(defun org-looking-at-p (&rest args) + (if (fboundp 'looking-at-p) + (apply 'looking-at-p args) + (save-match-data + (apply 'looking-at-p args)))) + ; XEmacs does not have `looking-back'. (if (fboundp 'looking-back) (defalias 'org-looking-back 'looking-back) diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el index 04f519a7aa9..d93981227e5 100644 --- a/lisp/org/org-crypt.el +++ b/lisp/org/org-crypt.el @@ -4,7 +4,7 @@ ;; Emacs Lisp Archive Entry ;; Filename: org-crypt.el -;; Version: 6.35i +;; Version: 7.01 ;; Keywords: org-mode ;; Author: John Wiegley <johnw@gnu.org> ;; Maintainer: Peter Jones <pjones@pmade.com> @@ -45,6 +45,7 @@ ;; decrypt it. This makes it possible to leave secure notes that ;; only the intended recipient can read in a shared-org-mode-files ;; scenario. +;; If the key is not set, org-crypt will default to symmetric encryption. ;; ;; 3. To later decrypt an entry, use `org-decrypt-entries' or ;; `org-decrypt-entry'. It might be useful to bind this to a key, @@ -66,6 +67,8 @@ (require 'org) +;;; Code: + (declare-function epg-decrypt-string "epg" (context cipher)) (declare-function epg-list-keys "epg" (context &optional name mode)) (declare-function epg-make-context "epg" @@ -80,24 +83,25 @@ :tag "Org Crypt" :group 'org) (defcustom org-crypt-tag-matcher "crypt" - "The tag matcher used to find headings whose contents should be -encrypted. See the \"Match syntax\" section of the org manual -for more details." + "The tag matcher used to find headings whose contents should be encrypted. + +See the \"Match syntax\" section of the org manual for more details." :type 'string :group 'org-crypt) (defcustom org-crypt-key nil - "The default key to use when encrypting the contents of a -heading. This can also be overridden in the CRYPTKEY property." + "The default key to use when encrypting the contents of a heading. + +This setting can also be overridden in the CRYPTKEY property." :type 'string :group 'org-crypt) (defun org-crypt-key-for-heading () - "Returns the encryption key for the current heading." + "Return the encryption key for the current heading." (save-excursion (org-back-to-heading t) (or (org-entry-get nil "CRYPTKEY" 'selective) org-crypt-key (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to) - (error "No crypt key set")))) + (message "No crypt key set, using symmetric encryption.")))) (defun org-encrypt-entry () "Encrypt the content of the current headline." @@ -105,52 +109,54 @@ heading. This can also be overridden in the CRYPTKEY property." (require 'epg) (save-excursion (org-back-to-heading t) - (forward-line) - (when (not (looking-at "-----BEGIN PGP MESSAGE-----")) - (let ((folded (org-invisible-p)) - (epg-context (epg-make-context nil t t)) - (crypt-key (org-crypt-key-for-heading)) - (beg (point)) - end encrypted-text) - (org-end-of-subtree t t) - (org-back-over-empty-lines) - (setq end (point) - encrypted-text - (epg-encrypt-string - epg-context - (buffer-substring-no-properties beg end) - (epg-list-keys epg-context crypt-key))) - (delete-region beg end) - (insert encrypted-text) - (when folded - (save-excursion - (org-back-to-heading t) - (hide-subtree))) - nil)))) + (let ((start-heading (point))) + (forward-line) + (when (not (looking-at "-----BEGIN PGP MESSAGE-----")) + (let ((folded (org-invisible-p)) + (epg-context (epg-make-context nil t t)) + (crypt-key (org-crypt-key-for-heading)) + (beg (point)) + end encrypted-text) + (goto-char start-heading) + (org-end-of-subtree t t) + (org-back-over-empty-lines) + (setq end (point) + encrypted-text + (epg-encrypt-string + epg-context + (buffer-substring-no-properties beg end) + (epg-list-keys epg-context crypt-key))) + (delete-region beg end) + (insert encrypted-text) + (when folded + (goto-char start-heading) + (hide-subtree)) + nil))))) (defun org-decrypt-entry () "Decrypt the content of the current headline." (interactive) (require 'epg) - (save-excursion - (org-back-to-heading t) - (forward-line) - (when (looking-at "-----BEGIN PGP MESSAGE-----") - (let* ((beg (point)) - (end (save-excursion - (search-forward "-----END PGP MESSAGE-----") - (forward-line) - (point))) - (epg-context (epg-make-context nil t t)) - (decrypted-text - (decode-coding-string - (epg-decrypt-string - epg-context - (buffer-substring-no-properties beg end)) - 'utf-8))) - (delete-region beg end) - (insert decrypted-text) - nil)))) + (unless (org-before-first-heading-p) + (save-excursion + (org-back-to-heading t) + (forward-line) + (when (looking-at "-----BEGIN PGP MESSAGE-----") + (let* ((beg (point)) + (end (save-excursion + (search-forward "-----END PGP MESSAGE-----") + (forward-line) + (point))) + (epg-context (epg-make-context nil t t)) + (decrypted-text + (decode-coding-string + (epg-decrypt-string + epg-context + (buffer-substring-no-properties beg end)) + 'utf-8))) + (delete-region beg end) + (insert decrypted-text) + nil))))) (defun org-encrypt-entries () "Encrypt all top-level entries in the current buffer." @@ -167,8 +173,7 @@ heading. This can also be overridden in the CRYPTKEY property." (cdr (org-make-tags-matcher org-crypt-tag-matcher)))) (defun org-crypt-use-before-save-magic () - "Adds a hook that will automatically encrypt entries before a -file is saved to disk." + "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)))) diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 0a0023898a5..fc6b192e566 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -3,10 +3,10 @@ ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Paul Sexton <eeeickythump@gmail.com> -;; Version: 1.0 +;; Version: 7.01 ;; Keywords: org, wp -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -134,7 +134,10 @@ ;; (message "-- rebuilding tags tables...") ;; (mapc 'org-create-tags tags-table-list)) +;;; Code: + (eval-when-compile (require 'cl)) + (require 'org) (defgroup org-ctags nil @@ -146,8 +149,8 @@ "Activate ctags support in org mode?") (defvar org-ctags-tag-regexp "/<<([^>]+)>>/\\1/d,definition/" - "Regexp expression used by ctags external program, that matches -tag destinations in org-mode files. + "Regexp expression used by ctags external program. +The regexp matches tag destinations in org-mode files. Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/ See the ctags documentation for more information.") @@ -164,8 +167,7 @@ See the ctags documentation for more information.") '(org-ctags-find-tag org-ctags-ask-rebuild-tags-file-then-find-tag org-ctags-ask-append-topic) - "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS when -ORG-CTAGS is active." + "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS when ORG-CTAGS is active." :group 'org-ctags :type 'hook :options '(org-ctags-find-tag @@ -179,8 +181,8 @@ ORG-CTAGS is active." (defvar org-ctags-tag-list nil - "List of all tags in the active TAGS file. Created as a local -variable in each buffer.") + "List of all tags in the active TAGS file. +Created as a local variable in each buffer.") (defcustom org-ctags-new-topic-template "* <<%t>>\n\n\n\n\n\n" @@ -218,12 +220,12 @@ The following patterns are replaced in the string: (add-hook 'org-open-link-functions fn t))) -;;; General utility functions. =============================================== +;;; General utility functions. =============================================== ;; These work outside org-ctags mode. (defun org-ctags-get-filename-for-tag (tag) - "TAG is a string. Search the active TAGS file for a matching tag, -and if found, return a list containing the filename, line number, and + "TAG is a string. Search the active TAGS file for a matching tag. +If the tag is found, return a list containing the filename, line number, and buffer position where the tag is found." (interactive "sTag: ") (unless tags-file-name @@ -279,8 +281,8 @@ Return the list." (defun org-ctags-open-file (name &optional title) - "Visit or create a file called `NAME.org', and insert a new topic titled -NAME (or TITLE if supplied)." + "Visit or create a file called `NAME.org', and insert a new topic. +The new topic will be titled NAME (or TITLE if supplied)." (interactive "sFile name: ") (let ((filename (substitute-in-file-name (expand-file-name name)))) (condition-case v @@ -349,7 +351,7 @@ If there is no plausible default, return nil." (defun org-ctags-find-tag (name) "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Look for a tag called `NAME' in the current TAGS table. If it is found, +Look for a tag called `NAME' in the current TAGS table. If it is found, visit the file and location where the tag is found." (interactive "sTag: ") (let ((old-buf (current-buffer)) @@ -368,11 +370,11 @@ visit the file and location where the tag is found." (defun org-ctags-visit-buffer-or-file (name &optional create) "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Visit buffer named `NAME.org'. If there is no such buffer, visit the file -with the same name if it exists. If the file does not exist, then behaviour +Visit buffer named `NAME.org'. If there is no such buffer, visit the file +with the same name if it exists. If the file does not exist, then behavior depends on the value of CREATE. -If CREATE is nil (default), then return nil. Do not create a new file. +If CREATE is nil (default), then return nil. Do not create a new file. If CREATE is t, create the new file and visit it. If CREATE is the symbol `ask', then ask the user if they wish to create the new file." @@ -453,7 +455,7 @@ Wrapper for org-ctags-rebuild-tags-file-then-find-tag." (if (and (buffer-file-name) (y-or-n-p (format - "Tag `%s' not found. Rebuild table `%s/TAGS' and look again?" + "Tag `%s' not found. Rebuild table `%s/TAGS' and look again?" name (file-name-directory (buffer-file-name))))) (org-ctags-rebuild-tags-file-then-find-tag name) @@ -463,7 +465,7 @@ Wrapper for org-ctags-rebuild-tags-file-then-find-tag." (defun org-ctags-fail-silently (name) "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. Put as the last function in the list if you want to prevent org's default -behaviour of free text search." +behavior of free text search." t) @@ -471,14 +473,14 @@ behaviour of free text search." (defun org-ctags-create-tags (&optional directory-name) - "(Re)create tags file in the directory of the active buffer, -containing tag definitions for all the files in the directory and its -subdirectories which are recognised by ctags. This will include -files ending in `.org' as well as most other source files (.C, -.H, .EL, .LISP, etc). All the resulting tags end up in one file, -called TAGS, located in the directory. This function -may take several seconds to finish if the directory or its -subdirectories contain large numbers of taggable files." + "(Re)create tags file in the directory of the active buffer. +The file will contain tag definitions for all the files in the +directory and its subdirectories which are recognized by ctags. +This will include files ending in `.org' as well as most other +source files (.C, .H, .EL, .LISP, etc). All the resulting tags +end up in one file, called TAGS, located in the directory. This +function may take several seconds to finish if the directory or +its subdirectories contain large numbers of taggable files." (interactive) (assert (buffer-file-name)) (let ((dir-name (or directory-name @@ -509,8 +511,8 @@ subdirectories contain large numbers of taggable files." "History of tags visited by org-ctags-find-tag-interactive.") (defun org-ctags-find-tag-interactive () - "Prompt for the name of a tag, with autocompletion, then visit -the named tag. Uses ido-mode if available. + "Prompt for the name of a tag, with autocompletion, then visit the named tag. +Uses `ido-mode' if available. If the user enters a string that does not match an existing tag, create a new topic." (interactive) diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el index d1a42731b51..331d6d6a1d1 100644 --- a/lisp/org/org-datetree.el +++ b/lisp/org/org-datetree.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -36,8 +36,8 @@ (defvar org-datetree-base-level 1 "The level at which years should be placed in the date tree. This is normally one, but if the buffer has an entry with a DATE_TREE -property, the date tree will become a subtree under that entry, so the -base level will be properly adjusted.") +property (any value), the date tree will become a subtree under that entry, +so the base level will be properly adjusted.") ;;;###autoload (defun org-datetree-find-date-create (date &optional keep-restriction) diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el index e5ee98bb344..12ab96deff9 100644 --- a/lisp/org/org-docbook.el +++ b/lisp/org/org-docbook.el @@ -4,7 +4,7 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-docbook.el -;; Version: 6.35i +;; Version: 7.01 ;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com> ;; Keywords: org, wp, docbook @@ -26,7 +26,7 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -;; Commentary: +;;; 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. @@ -76,6 +76,7 @@ (require 'org) (require 'org-exp) (require 'org-html) +(require 'format-spec) ;;; Variables: @@ -141,8 +142,8 @@ people work on the same document." :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 + "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) @@ -154,7 +155,7 @@ avoid same set of footnote IDs being used multiple times." ("=" "<code>" "</code>") ("~" "<literal>" "</literal>") ("+" "<emphasis role=\"strikethrough\">" "</emphasis>")) - "Alist of DocBook expressions to convert emphasis fontifiers. + "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 formatting string to wrap fontified text with. @@ -183,32 +184,39 @@ default, but users can override them using `#+ATTR_DocBook:'." :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 + :type 'string) + (defcustom org-export-docbook-xslt-proc-command nil - "XSLT processor command used by DocBook exporter. -This is the command used to process a DocBook XML file to -generate the formatting object (FO) file. + "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 two `%s' arguments: the first one is for the output FO -file name, and the second one is for the input DocBook XML file -name. +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 %s %s /path/to/docbook.xsl\" + \"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 %s -in %s -xsl /path/to/docbook.xsl\" + \"java org.apache.xalan.xslt.Process -out %o -in %i -xsl %s\" For xsltproc, the following string should work: - \"xsltproc --output %s /path/to/docbook.xsl %s\" - -You need to replace \"/path/to/docbook.xsl\" with the actual path -to the DocBook stylesheet file on your machine. You can also -replace it with your own customization layer if you have one. + \"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 @@ -217,18 +225,19 @@ processor." :type 'string) (defcustom org-export-docbook-xsl-fo-proc-command nil - "XSL-FO processor command used by DocBook exporter. -This is the command used to process a formatting object (FO) file -to generate the PDF file. + "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 `%s' arguments: the first one is for the input FO -file name, and the second one is for the output PDF file name. +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 %s %s\"" + \"fop %i %o\"" :group 'org-export-docbook :type 'string) @@ -333,13 +342,18 @@ in a window. A non-interactive call will only return the buffer." "Export as DocBook XML file, and generate PDF file." (interactive "P") (if (or (not org-export-docbook-xslt-proc-command) - (not (string-match "%s.+%s" 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 "%s.+%s" 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 hidden ext-plist to-buffer body-only pub-dir)) (filename (buffer-file-name docbook-buf)) @@ -348,10 +362,17 @@ in a window. A non-interactive call will only return the buffer." (pdffile (concat base ".pdf"))) (and (file-exists-p pdffile) (delete-file pdffile)) (message "Processing DocBook XML file...") - (shell-command (format org-export-docbook-xslt-proc-command - fofile (shell-quote-argument filename))) - (shell-command (format org-export-docbook-xsl-fo-proc-command - fofile pdffile)) + (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") @@ -533,7 +554,7 @@ publishing directory." table-buffer table-orig-buffer ind item-type starter didclose rpl path attr caption label desc descp desc1 desc2 link - fnc item-tag + fnc item-tag initial-number footref-seen footnote-list id-file ) @@ -998,7 +1019,11 @@ publishing directory." starter (if (match-beginning 2) (substring (match-string 2 line) 0 -1)) line (substring line (match-beginning 5)) - item-tag nil) + item-tag nil + initial-number nil) + (if (string-match "\\`\\[@start:\\([0-9]+\\)\\][ \t]?" line) + (setq initial-number (match-string 1 line) + line (replace-match "" t t line))) (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) (setq item-type "d" item-tag (match-string 1 line) @@ -1031,7 +1056,18 @@ publishing directory." (org-export-docbook-close-para-maybe) (insert (cond ((equal item-type "u") "<itemizedlist>\n<listitem>\n") - ((equal item-type "o") "<orderedlist>\n<listitem>\n") + ((equal item-type "o") + ;; Check for a specific start number. If it + ;; is specified, we use the ``override'' + ;; attribute of element <listitem> to pass the + ;; info to DocBook. We could also use the + ;; ``startingnumber'' attribute of element + ;; <orderedlist>, but the former works on both + ;; DocBook 5.0 and prior versions. + (if initial-number + (format "<orderedlist>\n<listitem override=\"%s\">\n" + initial-number) + "<orderedlist>\n<listitem>\n")) ((equal item-type "d") (format "<variablelist>\n<varlistentry><term>%s</term><listitem>\n" item-tag)))) ;; For DocBook, we need to open a para right after tag @@ -1228,7 +1264,8 @@ When TITLE is nil, just close all open levels." (setq section-number (org-section-number level)) (insert (format "\n<section xml:id=\"%s%s\">\n<title>%s</title>" org-export-docbook-section-id-prefix - section-number title)) + (replace-regexp-in-string "\\." "_" section-number) + title)) (org-export-docbook-open-para)))) (defun org-docbook-expand (string) diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el index ad507546696..cac13e6ddfc 100644 --- a/lisp/org/org-docview.el +++ b/lisp/org/org-docview.el @@ -2,10 +2,10 @@ ;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. -;; Author: Jan Böcker <jan.boecker at jboecker dot de> +;; Author: Jan Böcker <jan.boecker at jboecker dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -62,7 +62,7 @@ ))) (defun org-docview-store-link () - "Store a link to a docview buffer" + "Store a link to a docview buffer." (when (eq major-mode 'doc-view-mode) ;; This buffer is in doc-view-mode (let* ((path buffer-file-name) @@ -75,11 +75,16 @@ :description path)))) (defun org-docview-complete-link () - "Use the existing file name completion for file: links to get the file name, - then ask the user for the page number and append it." + "Use the existing file name completion for file. +Links to get the file name, then ask the user for the page number +and append it." (concat (replace-regexp-in-string "^file:" "docview:" (org-file-complete-link)) "::" (read-from-minibuffer "Page:" "1"))) (provide 'org-docview) + +;; arch-tag: dd147a78-cce1-481b-b40a-15869417debe + +;;; org-docview.el ends here diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index 4dfe3a95e1b..70c88afa6a2 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -6,7 +6,7 @@ ;; Ulf Stegemann <ulf at zeitform dot de> ;; Keywords: outlines, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -26,6 +26,8 @@ ;; ;;; Commentary: +;;; Code: + (require 'org-macs) (declare-function org-table-align "org-table" ()) @@ -46,11 +48,11 @@ in backends where the corresponding character is not available." :type 'boolean) (defcustom org-entities-user nil - "User-defined entities used in Org-mode to preduce special characters. -Each entry in this list is a list of strings. It associate the name + "User-defined entities used in Org-mode to produce special characters. +Each entry in this list is a list of strings. It associates the name of the entity that can be inserted into an Org file as \\name with the appropriate replacements for the different export backends. The order -of the fields is he following +of the fields is the following name As a string, without the leading backslash LaTeX replacement In ready LaTeX, no further processing will take place @@ -59,10 +61,10 @@ LaTeX mathp A Boolean, either t or nil. t if this entity needs HTML replacement In ready HTML, no further processing will take place. Usually this will be an &...; entity. ASCII replacement Plain ASCII, no extensions. Symbols that cannot be - represented will be written out as an explanatory text. - But see the variable `org-entities-ascii-keep-macro-form'. + represented will be left as they are, but see the. + variable `org-entities-ascii-explanatory'. Latin1 replacement Use the special characters available in latin1. -utf-8 replacement Use special character available in utf-8. +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'." @@ -78,229 +80,245 @@ loaded, add these packages to `org-export-latex-packages-alist'." (string :tag "utf-8 ")))) (defconst org-entities - '(("nbsp" "~" nil " " " " " " " ") - ("iexcl" "!`" nil "¡" "!" "¡" "¡") - ("cent" "\\textcent{}" nil "¢" "cent" "¢" "¢") - ("pound" "\\pounds{}" nil "£" "pound" "ÂŁ" "ÂŁ") - ("curren" "\\textcurrency{}" nil "¤" "curr." "¤" "¤") - ("yen" "\\textyen{}" nil "¥" "yen" "ÂĄ" "ÂĄ") - ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") - ("vert" "\\vert{}" t "|" "|" "|" "|") - ("sect" "\\S" nil "§" "paragraph" "§" "§") - ("uml" "\\textasciidieresis{}" nil "¨" "[diaeresis]" "¨" "¨") - ("copy" "\\textcopyright{}" nil "©" "(c)" "©" "©") - ("ordf" "\\textordfeminine{}" nil "ª" "_a_" "ÂŞ" "ÂŞ") - ("laquo" "\\guillemotleft{}" nil "«" "<<" "«" "«") - ("not" "\\textlnot{}" nil "¬" "[angled dash]" "¬" "¬") - ("shy" "\\-" nil "­" "" "" "") - ("reg" "\\textregistered{}" nil "®" "(r)" "®" "®") - ("macr" "\\textasciimacron{}" nil "¯" "[macron]" "ÂŻ" "ÂŻ") - ("deg" "\\textdegree{}" nil "deg" "degree" "°" "°") - ("pm" "\\textpm{}" nil "±" "+-" "±" "±") - ("plusmn" "\\textpm{}" nil "±" "+-" "±" "±") - ("sup2" "\\texttwosuperior{}" nil "²" "^2" "²" "²") - ("sup3" "\\textthreesuperior{}" nil "³" "^3" "Âł" "Âł") - ("acutex" "\\acute x" t "´x" "'x" "'x" "đť‘ĄĚ") - ("micro" "\\textmu{}" nil "µ" "micro" "µ" "µ") - ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶") - ("middot" "\\textperiodcentered{}" nil "·" "." "·" "·") - ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "Ę") - ("star" "\\star" t "*" "*" "*" "⋆") - ("cedil" "\\c{}" nil "¸" "[cedilla]" "¸" "¸") - ("sup1" "\\textonesuperior{}" nil "¹" "^1" "Âą" "Âą") - ("ordm" "\\textordmasculine{}" nil "º" "_o_" "Âş" "Âş") - ("raquo" "\\guillemotright{}" nil "»" ">>" "»" "»") - ("iquest" "?`" nil "¿" "?" "Âż" "Âż") + '( + "* Letters" + "** Latin" ("Agrave" "\\`{A}" nil "À" "A" "Ă€" "Ă€") + ("agrave" "\\`{a}" nil "à" "a" "Ă " "Ă ") ("Aacute" "\\'{A}" nil "Á" "A" "Ă" "Ă") + ("aacute" "\\'{a}" nil "á" "a" "á" "á") ("Acirc" "\\^{A}" nil "Â" "A" "Ă‚" "Ă‚") + ("acirc" "\\^{a}" nil "â" "a" "â" "â") ("Atilde" "\\~{A}" nil "Ã" "A" "Ă" "Ă") + ("atilde" "\\~{a}" nil "ã" "a" "ĂŁ" "ĂŁ") ("Auml" "\\\"{A}" nil "Ä" "Ae" "Ă„" "Ă„") + ("auml" "\\\"{a}" nil "ä" "ae" "ä" "ä") ("Aring" "\\AA{}" nil "Å" "A" "Ă…" "Ă…") ("AA" "\\AA{}" nil "Å" "A" "Ă…" "Ă…") - ("AElig" "\\AE{}" nil "Æ" "AE" "Æ" "Æ") - ("Ccedil" "\\c{C}" nil "Ç" "C" "Ç" "Ç") - ("Egrave" "\\`{E}" nil "È" "E" "Ă" "Ă") - ("Eacute" "\\'{E}" nil "É" "E" "É" "É") - ("Ecirc" "\\^{E}" nil "Ê" "E" "ĂŠ" "ĂŠ") - ("Euml" "\\\"{E}" nil "Ë" "E" "Ă‹" "Ă‹") - ("Igrave" "\\`{I}" nil "Ì" "I" "ĂŚ" "ĂŚ") - ("Iacute" "\\'{I}" nil "Í" "I" "ĂŤ" "ĂŤ") - ("Icirc" "\\^{I}" nil "Î" "I" "ĂŽ" "ĂŽ") - ("Iuml" "\\\"{I}" nil "Ï" "I" "ĂŹ" "ĂŹ") - ("ETH" "\\DH{}" nil "Ð" "D" "Ă" "Ă") - ("Ntilde" "\\~{N}" nil "Ñ" "N" "Ă‘" "Ă‘") - ("Ograve" "\\`{O}" nil "Ò" "O" "Ă’" "Ă’") - ("Oacute" "\\'{O}" nil "Ó" "O" "Ă“" "Ă“") - ("Ocirc" "\\^{O}" nil "Ô" "O" "Ă”" "Ă”") - ("Otilde" "\\~{O}" nil "Õ" "O" "Ă•" "Ă•") - ("Ouml" "\\\"{O}" nil "Ö" "Oe" "Ă–" "Ă–") - ("times" "\\texttimes{}" nil "×" "*" "Ă—" "Ă—") - ("Oslash" "\\O" nil "Ø" "O" "Ă" "Ă") - ("Ugrave" "\\`{U}" nil "Ù" "U" "Ă™" "Ă™") - ("Uacute" "\\'{U}" nil "Ú" "U" "Ăš" "Ăš") - ("Ucirc" "\\^{U}" nil "Û" "U" "Ă›" "Ă›") - ("Uuml" "\\\"{U}" nil "Ü" "Ue" "Ăś" "Ăś") - ("Yacute" "\\'{Y}" nil "Ý" "Y" "Ăť" "Ăť") - ("THORN" "\\TH{}" nil "Þ" "TH" "Ăž" "Ăž") - ("szlig" "\\ss{}" nil "ß" "ss" "Ăź" "Ăź") - ("agrave" "\\`{a}" nil "à" "a" "Ă " "Ă ") - ("aacute" "\\'{a}" nil "á" "a" "á" "á") - ("acirc" "\\^{a}" nil "â" "a" "â" "â") - ("atilde" "\\~{a}" nil "ã" "a" "ĂŁ" "ĂŁ") - ("auml" "\\\"{a}" nil "ä" "ae" "ä" "ä") ("aring" "\\aa{}" nil "å" "a" "ĂĄ" "ĂĄ") + ("AElig" "\\AE{}" nil "Æ" "AE" "Æ" "Æ") ("aelig" "\\ae{}" nil "æ" "ae" "æ" "æ") + ("Ccedil" "\\c{C}" nil "Ç" "C" "Ç" "Ç") ("ccedil" "\\c{c}" nil "ç" "c" "ç" "ç") - ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "âś“") + ("Egrave" "\\`{E}" nil "È" "E" "Ă" "Ă") ("egrave" "\\`{e}" nil "è" "e" "è" "è") + ("Eacute" "\\'{E}" nil "É" "E" "É" "É") ("eacute" "\\'{e}" nil "é" "e" "Ă©" "Ă©") + ("Ecirc" "\\^{E}" nil "Ê" "E" "ĂŠ" "ĂŠ") ("ecirc" "\\^{e}" nil "ê" "e" "ĂŞ" "ĂŞ") + ("Euml" "\\\"{E}" nil "Ë" "E" "Ă‹" "Ă‹") ("euml" "\\\"{e}" nil "ë" "e" "Ă«" "Ă«") + ("Igrave" "\\`{I}" nil "Ì" "I" "ĂŚ" "ĂŚ") ("igrave" "\\`{i}" nil "ì" "i" "ì" "ì") + ("Iacute" "\\'{I}" nil "Í" "I" "ĂŤ" "ĂŤ") ("iacute" "\\'{i}" nil "í" "i" "Ă" "Ă") + ("Icirc" "\\^{I}" nil "Î" "I" "ĂŽ" "ĂŽ") ("icirc" "\\^{i}" nil "î" "i" "Ă®" "Ă®") + ("Iuml" "\\\"{I}" nil "Ï" "I" "ĂŹ" "ĂŹ") ("iuml" "\\\"{i}" nil "ï" "i" "ĂŻ" "ĂŻ") - ("eth" "\\dh{}" nil "ð" "dh" "Ă°" "Ă°") + ("Ntilde" "\\~{N}" nil "Ñ" "N" "Ă‘" "Ă‘") ("ntilde" "\\~{n}" nil "ñ" "n" "ñ" "ñ") + ("Ograve" "\\`{O}" nil "Ò" "O" "Ă’" "Ă’") ("ograve" "\\`{o}" nil "ò" "o" "ò" "ò") + ("Oacute" "\\'{O}" nil "Ó" "O" "Ă“" "Ă“") ("oacute" "\\'{o}" nil "ó" "o" "Ăł" "Ăł") + ("Ocirc" "\\^{O}" nil "Ô" "O" "Ă”" "Ă”") ("ocirc" "\\^{o}" nil "ô" "o" "Ă´" "Ă´") + ("Otilde" "\\~{O}" nil "Õ" "O" "Ă•" "Ă•") ("otilde" "\\~{o}" nil "õ" "o" "õ" "õ") + ("Ouml" "\\\"{O}" nil "Ö" "Oe" "Ă–" "Ă–") ("ouml" "\\\"{o}" nil "ö" "oe" "ö" "ö") + ("Oslash" "\\O" nil "Ø" "O" "Ă" "Ă") ("oslash" "\\o{}" nil "ø" "o" "ø" "ø") + ("OElig" "\\OE{}" nil "Œ" "OE" "OE" "Ĺ’") + ("oelig" "\\oe{}" nil "œ" "oe" "oe" "Ĺ“") + ("Scaron" "\\v{S}" nil "Š" "S" "S" "Ĺ ") + ("scaron" "\\v{s}" nil "š" "s" "s" "š") + ("szlig" "\\ss{}" nil "ß" "ss" "Ăź" "Ăź") + ("Ugrave" "\\`{U}" nil "Ù" "U" "Ă™" "Ă™") ("ugrave" "\\`{u}" nil "ù" "u" "Ăą" "Ăą") + ("Uacute" "\\'{U}" nil "Ú" "U" "Ăš" "Ăš") ("uacute" "\\'{u}" nil "ú" "u" "Ăş" "Ăş") + ("Ucirc" "\\^{U}" nil "Û" "U" "Ă›" "Ă›") ("ucirc" "\\^{u}" nil "û" "u" "Ă»" "Ă»") + ("Uuml" "\\\"{U}" nil "Ü" "Ue" "Ăś" "Ăś") ("uuml" "\\\"{u}" nil "ü" "ue" "ĂĽ" "ĂĽ") + ("Yacute" "\\'{Y}" nil "Ý" "Y" "Ăť" "Ăť") ("yacute" "\\'{y}" nil "ý" "y" "Ă˝" "Ă˝") - ("thorn" "\\th{}" nil "þ" "th" "Ăľ" "Ăľ") + ("Yuml" "\\\"{Y}" nil "Ÿ" "Y" "Y" "Ÿ") ("yuml" "\\\"{y}" nil "ÿ" "y" "Ăż" "Ăż") + + "** Latin (special face)" ("fnof" "\\textit{f}" nil "ƒ" "f" "f" "Ć’") + ("real" "\\Re" t "ℜ" "R" "R" "â„ś") + ("image" "\\Im" t "ℑ" "I" "I" "â„‘") + ("weierp" "\\wp" t "℘" "P" "P" "â„") + + "** Greek" ("Alpha" "A" nil "Α" "Alpha" "Alpha" "Α") - ("Beta" "B" nil "Β" "Beta" "Beta" "Î’") - ("Gamma" "\\Gamma" t "Γ" "Gamma" "Gamma" "Γ") - ("Delta" "\\Delta" t "Δ" "Delta" "Gamma" "Δ") - ("Epsilon" "E" nil "Ε" "Epsilon" "Epsilon" "Ε") - ("Zeta" "Z" nil "Ζ" "Zeta" "Zeta" "Ζ") - ("Eta" "H" nil "Η" "Eta" "Eta" "Η") - ("Theta" "\\Theta" t "Θ" "Theta" "Theta" "Î") - ("Iota" "I" nil "Ι" "Iota" "Iota" "Ι") - ("Kappa" "K" nil "Κ" "Kappa" "Kappa" "Κ") - ("Lambda" "\\Lambda" t "Λ" "Lambda" "Lambda" "Λ") - ("Mu" "M" nil "Μ" "Mu" "Mu" "Îś") - ("Nu" "N" nil "Ν" "Nu" "Nu" "Îť") - ("Xi" "\\Xi" t "Ξ" "Xi" "Xi" "Ξ") - ("Omicron" "O" nil "Ο" "Omicron" "Omicron" "Îź") - ("Pi" "\\Pi" t "Π" "Pi" "Pi" "Î ") - ("Rho" "P" nil "Ρ" "Rho" "Rho" "Ρ") - ("Sigma" "\\Sigma" t "Σ" "Sigma" "Sigma" "ÎŁ") - ("Tau" "T" nil "Τ" "Tau" "Tau" "Τ") - ("Upsilon" "\\Upsilon" t "Υ" "Upsilon" "Upsilon" "ÎĄ") - ("Phi" "\\Phi" t "Φ" "Phi" "Phi" "Φ") - ("Chi" "X" nil "Χ" "Chi" "Chi" "Χ") - ("Psi" "\\Psi" t "Ψ" "Psi" "Psi" "Ψ") - ("Omega" "\\Omega" t "Ω" "Omega" "Omega" "Ω") ("alpha" "\\alpha" t "α" "alpha" "alpha" "α") + ("Beta" "B" nil "Β" "Beta" "Beta" "Î’") ("beta" "\\beta" t "β" "beta" "beta" "β") + ("Gamma" "\\Gamma" t "Γ" "Gamma" "Gamma" "Γ") ("gamma" "\\gamma" t "γ" "gamma" "gamma" "Îł") + ("Delta" "\\Delta" t "Δ" "Delta" "Gamma" "Δ") ("delta" "\\delta" t "δ" "delta" "delta" "δ") + ("Epsilon" "E" nil "Ε" "Epsilon" "Epsilon" "Ε") ("epsilon" "\\epsilon" t "ε" "epsilon" "epsilon" "ε") ("varepsilon" "\\varepsilon" t "ε" "varepsilon" "varepsilon" "ε") + ("Zeta" "Z" nil "Ζ" "Zeta" "Zeta" "Ζ") ("zeta" "\\zeta" t "ζ" "zeta" "zeta" "ζ") + ("Eta" "H" nil "Η" "Eta" "Eta" "Η") ("eta" "\\eta" t "η" "eta" "eta" "η") + ("Theta" "\\Theta" t "Θ" "Theta" "Theta" "Î") ("theta" "\\theta" t "θ" "theta" "theta" "θ") + ("thetasym" "\\vartheta" t "ϑ" "theta" "theta" "Ď‘") + ("vartheta" "\\vartheta" t "ϑ" "theta" "theta" "Ď‘") + ("Iota" "I" nil "Ι" "Iota" "Iota" "Ι") ("iota" "\\iota" t "ι" "iota" "iota" "Îą") + ("Kappa" "K" nil "Κ" "Kappa" "Kappa" "Κ") ("kappa" "\\kappa" t "κ" "kappa" "kappa" "Îş") + ("Lambda" "\\Lambda" t "Λ" "Lambda" "Lambda" "Λ") ("lambda" "\\lambda" t "λ" "lambda" "lambda" "λ") + ("Mu" "M" nil "Μ" "Mu" "Mu" "Îś") ("mu" "\\mu" t "μ" "mu" "mu" "ÎĽ") ("nu" "\\nu" t "ν" "nu" "nu" "ν") + ("Nu" "N" nil "Ν" "Nu" "Nu" "Îť") + ("Xi" "\\Xi" t "Ξ" "Xi" "Xi" "Ξ") ("xi" "\\xi" t "ξ" "xi" "xi" "Îľ") + ("Omicron" "O" nil "Ο" "Omicron" "Omicron" "Îź") ("omicron" "\\textit{o}" nil "ο" "omicron" "omicron" "Îż") + ("Pi" "\\Pi" t "Π" "Pi" "Pi" "Î ") ("pi" "\\pi" t "π" "pi" "pi" "Ď€") + ("Rho" "P" nil "Ρ" "Rho" "Rho" "Ρ") ("rho" "\\rho" t "ρ" "rho" "rho" "Ď") + ("Sigma" "\\Sigma" t "Σ" "Sigma" "Sigma" "ÎŁ") + ("sigma" "\\sigma" t "σ" "sigma" "sigma" "Ď") ("sigmaf" "\\varsigma" t "ς" "sigmaf" "sigmaf" "Ď‚") ("varsigma" "\\varsigma" t "ς" "varsigma" "varsigma" "Ď‚") - ("sigma" "\\sigma" t "σ" "sigma" "sigma" "Ď") - ("tau" "\\tau" t "τ" "tau" "tau" "Ď„") + ("Tau" "T" nil "Τ" "Tau" "Tau" "Τ") + ("Upsilon" "\\Upsilon" t "Υ" "Upsilon" "Upsilon" "ÎĄ") + ("upsih" "\\Upsilon" t "ϒ" "upsilon" "upsilon" "Ď’") ("upsilon" "\\upsilon" t "υ" "upsilon" "upsilon" "Ď…") + ("Phi" "\\Phi" t "Φ" "Phi" "Phi" "Φ") ("phi" "\\phi" t "φ" "phi" "phi" "φ") + ("Chi" "X" nil "Χ" "Chi" "Chi" "Χ") ("chi" "\\chi" t "χ" "chi" "chi" "χ") + ("acutex" "\\acute x" t "´x" "'x" "'x" "đť‘ĄĚ") + ("Psi" "\\Psi" t "Ψ" "Psi" "Psi" "Ψ") ("psi" "\\psi" t "ψ" "psi" "psi" "Ď") + ("tau" "\\tau" t "τ" "tau" "tau" "Ď„") + ("Omega" "\\Omega" t "Ω" "Omega" "Omega" "Ω") ("omega" "\\omega" t "ω" "omega" "omega" "ω") - ("thetasym" "\\vartheta" t "ϑ" "theta" "theta" "Ď‘") - ("vartheta" "\\vartheta" t "ϑ" "theta" "theta" "Ď‘") - ("upsih" "\\Upsilon" t "ϒ" "upsilon" "upsilon" "Ď’") ("piv" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "Ď–") - ("bull" "\\textbullet{}" nil "•" "*" "*" "•") - ("bullet" "\\textbullet{}" nil "•" "*" "*" "•") - ("hellip" "\\dots{}" nil "…" "..." "..." "…") + ("partial" "\\partial" t "∂" "[partial differential]" "[partial differential]" "â‚") + + "** Hebrew" + ("alefsym" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") + + "** Dead languages" + ("ETH" "\\DH{}" nil "Ð" "D" "Ă" "Ă") + ("eth" "\\dh{}" nil "ð" "dh" "Ă°" "Ă°") + ("THORN" "\\TH{}" nil "Þ" "TH" "Ăž" "Ăž") + ("thorn" "\\th{}" nil "þ" "th" "Ăľ" "Ăľ") + + "* Punctuation" + "** Dots and Marks" ("dots" "\\dots{}" nil "…" "..." "..." "…") - ("prime" "\\prime" t "′" "'" "'" "′") - ("Prime" "\\prime{}\\prime" t "″" "''" "''" "″") - ("oline" "\\overline{~}" t "‾" "[overline]" "ÂŻ" "‾") - ("frasl" "/" nil "⁄" "/" "/" "â„") - ("weierp" "\\wp" t "℘" "P" "P" "â„") - ("image" "\\Im" t "ℑ" "I" "I" "â„‘") - ("real" "\\Re" t "ℜ" "R" "R" "â„ś") + ("hellip" "\\dots{}" nil "…" "..." "..." "…") + ("middot" "\\textperiodcentered{}" nil "·" "." "·" "·") + ("iexcl" "!`" nil "¡" "!" "¡" "¡") + ("iquest" "?`" nil "¿" "?" "Âż" "Âż") + + "** Dash-like" + ("shy" "\\-" nil "­" "" "" "") + ("ndash" "--" nil "–" "-" "-" "–") + ("mdash" "---" nil "—" "--" "--" "—") + + "** Quotations" + ("quot" "\\textquotedbl{}" nil """ "\"" "\"" "\"") + ("acute" "\\textasciiacute{}" nil "´" "'" "´" "´") + ("ldquo" "\\textquotedblleft{}" nil "“" "\"" "\"" "“") + ("rdquo" "\\textquotedblright{}" nil "”" "\"" "\"" "”") + ("bdquo" "\\quotedblbase{}" nil "„" "\"" "\"" "„") + ("lsquo" "\\textquoteleft{}" nil "‘" "`" "`" "â€") + ("rsquo" "\\textquoteright{}" nil "’" "'" "'" "’") + ("sbquo" "\\quotesinglbase{}" nil "‚" "," "," "‚") + ("laquo" "\\guillemotleft{}" nil "«" "<<" "«" "«") + ("raquo" "\\guillemotright{}" nil "»" ">>" "»" "»") + ("lsaquo" "\\guilsinglleft{}" nil "‹" "<" "<" "‹") + ("rsaquo" "\\guilsinglright{}" nil "›" ">" ">" "›") + + "* Other" + "** Misc. (often used)" + ("circ" "\\circ" t "ˆ" "^" "^" "ˆ") + ("vert" "\\vert{}" t "|" "|" "|" "|") + ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") + ("sect" "\\S" nil "§" "paragraph" "§" "§") + ("amp" "\\&" nil "&" "&" "&" "&") + ("lt" "\\textless{}" nil "<" "<" "<" "<") + ("gt" "\\textgreater{}" nil ">" ">" ">" ">") + ("tilde" "\\~{}" nil "˜" "~" "~" "~") + ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") + ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") + + "** Whitespace" + ("nbsp" "~" nil " " " " " " " ") + ("ensp" "\\hspace*{.5em}" nil " " " " " " " ") + ("emsp" "\\hspace*{1em}" nil " " " " " " "â€") + ("thinsp" "\\hspace*{.2em}" nil " " " " " " " ") + + "** Currency" + ("curren" "\\textcurrency{}" nil "¤" "curr." "¤" "¤") + ("cent" "\\textcent{}" nil "¢" "cent" "¢" "¢") + ("pound" "\\pounds{}" nil "£" "pound" "ÂŁ" "ÂŁ") + ("yen" "\\textyen{}" nil "¥" "yen" "ÂĄ" "ÂĄ") + ("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€") + ("EUR" "\\EUR{}" nil "€" "EUR" "EUR" "€") + ("EURdig" "\\EURdig{}" nil "€" "EUR" "EUR" "€") + ("EURhv" "\\EURhv{}" nil "€" "EUR" "EUR" "€") + ("EURcr" "\\EURcr{}" nil "€" "EUR" "EUR" "€") + ("EURtm" "\\EURtm{}" nil "€" "EUR" "EUR" "€") + + "** Property Marks" + ("copy" "\\textcopyright{}" nil "©" "(c)" "©" "©") + ("reg" "\\textregistered{}" nil "®" "(r)" "®" "®") ("trade" "\\texttrademark{}" nil "™" "TM" "TM" "™") - ("alefsym" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") - ("larr" "\\leftarrow" t "←" "<-" "<-" "â†") - ("leftarrow" "\\leftarrow" t "←" "<-" "<-" "â†") - ("gets" "\\gets" t "←" "<-" "<-" "â†") - ("uarr" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") - ("uparrow" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") - ("rarr" "\\rightarrow" t "→" "->" "->" "→") - ("to" "\\to" t "→" "->" "->" "→") - ("rightarrow" "\\rightarrow" t "→" "->" "->" "→") - ("darr" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") - ("downarrow" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") - ("harr" "\\leftrightarrow" t "↔" "<->" "<->" "↔") - ("leftrightarrow" "\\leftrightarrow" t "↔" "<->" "<->" "↔") - ("crarr" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") - ("hookleftarrow" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") - ("lArr" "\\Leftarrow" t "⇐" "<=" "<=" "â‡") - ("Leftarrow" "\\Leftarrow" t "⇐" "<=" "<=" "â‡") - ("uArr" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") - ("Uparrow" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") - ("rArr" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") - ("Rightarrow" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") - ("dArr" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") - ("Downarrow" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") - ("hArr" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") - ("Leftrightarrow" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") - ("forall" "\\forall" t "∀" "[for all]" "[for all]" "â€") - ("partial" "\\partial" t "∂" "[partial differential]" "[partial differential]" "â‚") - ("exist" "\\exists" t "∃" "[there exists]" "[there exists]" "â") - ("exists" "\\exists" t "∃" "[there exists]" "[there exists]" "â") - ("empty" "\\empty" t "∅" "[empty set]" "[empty set]" "â…") - ("emptyset" "\\emptyset" t "∅" "[empty set]" "[empty set]" "â…") - ("nabla" "\\nabla" t "∇" "[nabla]" "[nabla]" "â‡") - ("isin" "\\in" t "∈" "[element of]" "[element of]" "â") - ("in" "\\in" t "∈" "[element of]" "[element of]" "â") - ("notin" "\\notin" t "∉" "[not an element of]" "[not an element of]" "â‰") - ("ni" "\\ni" t "∋" "[contains as member]" "[contains as member]" "â‹") - ("prod" "\\prod" t "∏" "[product]" "[n-ary product]" "âŹ") - ("sum" "\\sum" t "∑" "[sum]" "[sum]" "â‘") -; ("minus" "\\minus" t "−" "-" "-" "â’") - ("minus" "-" t "−" "-" "-" "â’") - ("lowast" "\\ast" t "∗" "*" "*" "â—") - ("ast" "\\ast" t "∗" "*" "*" "*") + + "** Science et al." + ("minus" "\\minus" t "−" "-" "-" "â’") + ("pm" "\\textpm{}" nil "±" "+-" "±" "±") + ("plusmn" "\\textpm{}" nil "±" "+-" "±" "±") + ("times" "\\texttimes{}" nil "×" "*" "Ă—" "Ă—") + ("frasl" "/" nil "⁄" "/" "/" "â„") + ("div" "\\textdiv{}" nil "÷" "/" "Ă·" "Ă·") + ("frac12" "\\textonehalf{}" nil "½" "1/2" "½" "½") + ("frac14" "\\textonequarter{}" nil "¼" "1/4" "ÂĽ" "ÂĽ") + ("frac34" "\\textthreequarters{}" nil "¾" "3/4" "Âľ" "Âľ") + ("permil" "\\textperthousand{}" nil "‰" "per thousand" "per thousand" "‰") + ("sup1" "\\textonesuperior{}" nil "¹" "^1" "Âą" "Âą") + ("sup2" "\\texttwosuperior{}" nil "²" "^2" "²" "²") + ("sup3" "\\textthreesuperior{}" nil "³" "^3" "Âł" "Âł") ("radic" "\\sqrt{\\,}" t "√" "[square root]" "[square root]" "âš") - ("prop" "\\propto" t "∝" "[proportional to]" "[proportional to]" "âť") - ("proptp" "\\propto" t "∝" "[proportional to]" "[proportional to]" "âť") + ("sum" "\\sum" t "∑" "[sum]" "[sum]" "â‘") + ("prod" "\\prod" t "∏" "[product]" "[n-ary product]" "âŹ") + ("micro" "\\textmu{}" nil "µ" "micro" "µ" "µ") + ("macr" "\\textasciimacron{}" nil "¯" "[macron]" "ÂŻ" "ÂŻ") + ("deg" "\\textdegree{}" nil "deg" "degree" "°" "°") + ("prime" "\\prime" t "′" "'" "'" "′") + ("Prime" "\\prime{}\\prime" t "″" "''" "''" "″") ("infin" "\\propto" t "∞" "[infinity]" "[infinity]" "âž") ("infty" "\\infty" t "∞" "[infinity]" "[infinity]" "âž") - ("ang" "\\angle" t "∠" "[angle]" "[angle]" "â ") - ("angle" "\\angle" t "∠" "[angle]" "[angle]" "â ") - ("and" "\\wedge" t "∧" "[logical and]" "[logical and]" "â§") + ("prop" "\\propto" t "∝" "[proportional to]" "[proportional to]" "âť") + ("proptp" "\\propto" t "∝" "[proportional to]" "[proportional to]" "âť") + ("not" "\\textlnot{}" nil "¬" "[angled dash]" "¬" "¬") + ("land" "\\land" t "∧" "[logical and]" "[logical and]" "â§") ("wedge" "\\wedge" t "∧" "[logical and]" "[logical and]" "â§") - ("or" "\\vee" t "∨" "[logical or]" "[logical or]" "â¨") + ("lor" "\\lor" t "∨" "[logical or]" "[logical or]" "â¨") ("vee" "\\vee" t "∨" "[logical or]" "[logical or]" "â¨") ("cap" "\\cap" t "∩" "[intersection]" "[intersection]" "â©") ("cup" "\\cup" t "∪" "[union]" "[union]" "âŞ") ("int" "\\int" t "∫" "[integral]" "[integral]" "â«") -; ("there4" "\\uptherefore" t "∴" "[therefore]" "[therefore]" "â´") ("there4" "\\therefore" t "∴" "[therefore]" "[therefore]" "â´") ("sim" "\\sim" t "∼" "~" "~" "âĽ") ("cong" "\\cong" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") @@ -318,9 +336,20 @@ loaded, add these packages to `org-export-latex-packages-alist'." ("supset" "\\supset" t "⊃" "[superset of]" "[superset of]" "âŠ") ("nsub" "\\not\\subset" t "⊄" "[not a subset of]" "[not a subset of" "⊄") ("sube" "\\subseteq" t "⊆" "[subset of or equal to]" "[subset of or equal to]" "⊆") + ("nsup" "\\not\\supset" t "⊅" "[not a superset of]" "[not a superset of]" "⊅") ("supe" "\\supseteq" t "⊇" "[superset of or equal to]" "[superset of or equal to]" "⊇") - ("oplus" "\\oplus" t "⊕" "[circled plus]" "[circled plus]" "⊕") - ("otimes" "\\otimes" t "⊗" "[circled times]" "[circled times]" "⊗") + ("forall" "\\forall" t "∀" "[for all]" "[for all]" "â€") + ("exist" "\\exists" t "∃" "[there exists]" "[there exists]" "â") + ("exists" "\\exists" t "∃" "[there exists]" "[there exists]" "â") + ("empty" "\\empty" t "∅" "[empty set]" "[empty set]" "â…") + ("emptyset" "\\emptyset" t "∅" "[empty set]" "[empty set]" "â…") + ("isin" "\\in" t "∈" "[element of]" "[element of]" "â") + ("in" "\\in" t "∈" "[element of]" "[element of]" "â") + ("notin" "\\notin" t "∉" "[not an element of]" "[not an element of]" "â‰") + ("ni" "\\ni" t "∋" "[contains as member]" "[contains as member]" "â‹") + ("nabla" "\\nabla" t "∇" "[nabla]" "[nabla]" "â‡") + ("ang" "\\angle" t "∠" "[angle]" "[angle]" "â ") + ("angle" "\\angle" t "∠" "[angle]" "[angle]" "â ") ("perp" "\\perp" t "⊥" "[up tack]" "[up tack]" "⊥") ("sdot" "\\cdot" t "⋅" "[dot]" "[dot]" "â‹…") ("cdot" "\\cdot" t "⋅" "[dot]" "[dot]" "â‹…") @@ -330,56 +359,34 @@ loaded, add these packages to `org-export-latex-packages-alist'." ("rfloor" "\\rfloor" t "⌋" "[right floor]" "[right floor]" "⌋") ("lang" "\\langle" t "⟨" "<" "<" "⟨") ("rang" "\\rangle" t "⟩" ">" ">" "âź©") - ("loz" "\\diamond" t "◊" "[lozenge]" "[lozenge]" "â—Š") - ("Diamond" "\\diamond" t "⋄" "[diamond]" "[diamond]" "â‹„") - ("spades" "\\spadesuit" t "♠" "[spades]" "[spades]" "â™ ") - ("spadesuit" "\\spadesuit" t "♠" "[spades]" "[spades]" "â™ ") - ("clubs" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") - ("clubsuit" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") - ("hearts" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") - ("heartsuit" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") - ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") - ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") - ("smile" "\\smile" t "☺" ":-)" ":-)" "⌣") - ("blacksmile" "\\blacksmiley{}" nil "☻" ":-)" ":-)" "â»") - ("sad" "\\frownie{}" nil "☹" ":-(" ":-(" "âą") - ("quot" "\\textquotedbl{}" nil """ "\"" "\"" "\"") - ("amp" "\\&" nil "&" "&" "&" "&") - ("lt" "\\textless{}" nil "<" "<" "<" "<") - ("gt" "\\textgreater{}" nil ">" ">" ">" ">") - ("OElig" "\\OE{}" nil "Œ" "OE" "OE" "Ĺ’") - ("oelig" "\\oe{}" nil "œ" "oe" "oe" "Ĺ“") - ("Scaron" "\\v{S}" nil "Š" "S" "S" "Ĺ ") - ("scaron" "\\v{s}" nil "š" "s" "s" "š") - ("Yuml" "\\\"{Y}" nil "Ÿ" "Y" "Y" "Ÿ") - ("circ" "\\circ" t "ˆ" "^" "^" "ˆ") - ("tilde" "\\~{}" nil "˜" "~" "~" "~") - ("ensp" "\\hspace*{.5em}" nil " " " " " " " ") - ("emsp" "\\hspace*{1em}" nil " " " " " " "â€") - ("thinsp" "\\hspace*{.2em}" nil " " " " " " " ") - ("zwnj" "\\/{}" nil "‌" "" "" "‌") - ("zwj" "" nil "‍" "" "" "‍") - ("lrm" "" nil "‎" "" "" "‎") - ("rlm" "" nil "‏" "" "" "‏") - ("ndash" "--" nil "–" "-" "-" "–") - ("mdash" "---" nil "—" "--" "--" "—") - ("lsquo" "\\textquoteleft{}" nil "‘" "`" "`" "â€") - ("rsquo" "\\textquoteright{}" nil "’" "'" "'" "’") - ("sbquo" "\\quotesinglbase{}" nil "‚" "," "," "‚") - ("ldquo" "\\textquotedblleft{}" nil "“" "\"" "\"" "“") - ("rdquo" "\\textquotedblright{}" nil "”" "\"" "\"" "”") - ("bdquo" "\\quotedblbase{}" nil "„" "\"" "\"" "„") - ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") - ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") - ("permil" "\\textperthousand{}" nil "‰" "per thousand" "per thousand" "‰") - ("lsaquo" "\\guilsinglleft{}" nil "‹" "<" "<" "‹") - ("rsaquo" "\\guilsinglright{}" nil "›" ">" ">" "›") - ("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€") - ("EUR" "\\EUR{}" nil "€" "EUR" "EUR" "€") - ("EURdig" "\\EURdig{}" nil "€" "EUR" "EUR" "€") - ("EURhv" "\\EURhv{}" nil "€" "EUR" "EUR" "€") - ("EURcr" "\\EURcr{}" nil "€" "EUR" "EUR" "€") - ("EURtm" "\\EURtm{}" nil "€" "EUR" "EUR" "€") + + "** Arrows" + ("larr" "\\leftarrow" t "←" "<-" "<-" "â†") + ("leftarrow" "\\leftarrow" t "←" "<-" "<-" "â†") + ("gets" "\\gets" t "←" "<-" "<-" "â†") + ("lArr" "\\Leftarrow" t "⇐" "<=" "<=" "â‡") + ("Leftarrow" "\\Leftarrow" t "⇐" "<=" "<=" "â‡") + ("uarr" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") + ("uparrow" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") + ("uArr" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") + ("Uparrow" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") + ("rarr" "\\rightarrow" t "→" "->" "->" "→") + ("to" "\\to" t "→" "->" "->" "→") + ("rightarrow" "\\rightarrow" t "→" "->" "->" "→") + ("rArr" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") + ("Rightarrow" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") + ("darr" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") + ("downarrow" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") + ("dArr" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") + ("Downarrow" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") + ("harr" "\\leftrightarrow" t "↔" "<->" "<->" "↔") + ("leftrightarrow" "\\leftrightarrow" t "↔" "<->" "<->" "↔") + ("hArr" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") + ("Leftrightarrow" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") + ("crarr" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") + ("hookleftarrow" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") + + "** Function names" ("arccos" "\\arccos" t "arccos" "arccos" "arccos" "arccos") ("arcsin" "\\arcsin" t "arcsin" "arcsin" "arcsin" "arcsin") ("arctan" "\\arctan" t "arctan" "arctan" "arctan" "arctan") @@ -412,15 +419,49 @@ loaded, add these packages to `org-export-latex-packages-alist'." ("sup" "\\sup" t "⊃" "sup" "sup" "sup") ("tan" "\\tan" t "tan" "tan" "tan" "tan") ("tanh" "\\tanh" t "tanh" "tanh" "tanh" "tanh") - ("frac12" "\\textonehalf{}" nil "½" "1/2" "½" "½") - ("frac14" "\\textonequarter{}" nil "¼" "1/4" "ÂĽ" "ÂĽ") - ("frac34" "\\textthreequarters{}" nil "¾" "3/4" "Âľ" "Âľ") - ("div" "\\textdiv{}" nil "÷" "/" "Ă·" "Ă·") - ("acute" "\\textasciiacute{}" nil "´" "'" "´" "´") - ("nsup" "\\not\\supset" t "⊅" "[not a superset of]" "[not a superset of]" "⊅") + + "** Signs & Symbols" + ("bull" "\\textbullet{}" nil "•" "*" "*" "•") + ("bullet" "\\textbullet{}" nil "•" "*" "*" "•") + ("star" "\\star" t "*" "*" "*" "⋆") + ("lowast" "\\ast" t "∗" "*" "*" "â—") + ("ast" "\\ast" t "∗" "*" "*" "*") + ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "Ę") + ("oplus" "\\oplus" t "⊕" "[circled plus]" "[circled plus]" "⊕") + ("otimes" "\\otimes" t "⊗" "[circled times]" "[circled times]" "⊗") + ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "âś“") + + "** Miscellaneous (seldom used)" + ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶") + ("ordf" "\\textordfeminine{}" nil "ª" "_a_" "ÂŞ" "ÂŞ") + ("ordm" "\\textordmasculine{}" nil "º" "_o_" "Âş" "Âş") + ("cedil" "\\c{}" nil "¸" "[cedilla]" "¸" "¸") + ("oline" "\\overline{~}" t "‾" "[overline]" "ÂŻ" "‾") + ("uml" "\\textasciidieresis{}" nil "¨" "[diaeresis]" "¨" "¨") + ("zwnj" "\\/{}" nil "‌" "" "" "‌") + ("zwj" "" nil "‍" "" "" "‍") + ("lrm" "" nil "‎" "" "" "‎") + ("rlm" "" nil "‏" "" "" "‏") + + "** Smilies" + ("smile" "\\smile" t "☺" ":-)" ":-)" "⌣") ("smiley" "\\smiley{}" nil "☺" ":-)" ":-)" "âş") + ("blacksmile" "\\blacksmiley{}" nil "☻" ":-)" ":-)" "â»") + ("sad" "\\frownie{}" nil "☹" ":-(" ":-(" "âą") + + "** Suits" + ("clubs" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") + ("clubsuit" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") + ("spades" "\\spadesuit" t "♠" "[spades]" "[spades]" "â™ ") + ("spadesuit" "\\spadesuit" t "♠" "[spades]" "[spades]" "â™ ") + ("hearts" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") + ("heartsuit" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") + ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") + ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") + ("Diamond" "\\diamond" t "⋄" "[diamond]" "[diamond]" "â‹„") + ("loz" "\\diamond" t "◊" "[lozenge]" "[lozenge]" "â—Š") ) - "Default entities used in Org-mode to preduce special characters. + "Default entities used in Org-mode to produce special characters. For details see `org-entities-user'.") (defsubst org-entity-get (name) @@ -457,31 +498,66 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." e latex mathp html latin utf8 name ascii) (insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n") (while ll - (setq e (pop ll)) - (setq name (car e) - latex (nth 1 e) - mathp (nth 2 e) - html (nth 3 e) - ascii (nth 4 e) - latin (nth 5 e) - utf8 (nth 6 e)) - (if (equal ascii "|") (setq ascii "\\vert")) - (if (equal latin "|") (setq latin "\\vert")) - (if (equal utf8 "|") (setq utf8 "\\vert")) - (if (equal ascii "=>") (setq ascii "= >")) - (if (equal latin "=>") (setq latin "= >")) - (insert "|" name - "|" (format "=%s=" latex) - "|" (format (if mathp "$%s$" "$\\mbox{%s}$") - latex) - "|" (format "=%s=" html) "|" html - "|" ascii "|" latin "|" utf8 - "|\n")) + (when (listp e) + (setq e (pop ll)) + (setq name (car e) + latex (nth 1 e) + mathp (nth 2 e) + html (nth 3 e) + ascii (nth 4 e) + latin (nth 5 e) + utf8 (nth 6 e)) + (if (equal ascii "|") (setq ascii "\\vert")) + (if (equal latin "|") (setq latin "\\vert")) + (if (equal utf8 "|") (setq utf8 "\\vert")) + (if (equal ascii "=>") (setq ascii "= >")) + (if (equal latin "=>") (setq latin "= >")) + (insert "|" name + "|" (format "=%s=" latex) + "|" (format (if mathp "$%s$" "$\\mbox{%s}$") + latex) + "|" (format "=%s=" html) "|" html + "|" ascii "|" latin "|" utf8 + "|\n"))) (goto-char pos) (org-table-align))) +(defun org-entities-help () + "Create a Help buffer with all available entities." + (interactive) + (with-output-to-temp-buffer "*Org Entity Help*" + (princ "Org-mode entities\n=================\n\n") + (let ((ll (append '("* User-defined additions (variable org-entities-user)") + org-entities-user + org-entities)) + e latex mathp html latin utf8 name ascii + (lastwasstring t) + (head (concat + "\n" + " Symbol Org entity LaTeX code HTML code\n" + " -----------------------------------------------------------\n"))) + (while ll + (setq e (pop ll)) + (if (stringp e) + (progn + (princ e) + (princ "\n") + (setq lastwasstring t)) + (if lastwasstring (princ head)) + (setq lastwasstring nil) + (setq name (car e) + latex (nth 1 e) + html (nth 3 e) + utf8 (nth 6 e)) + (princ (format " %-8s \\%-16s %-22s %-13s\n" + utf8 name latex html)))))) + (with-current-buffer "*Org Entity Help*" + (org-mode)) + (select-window (get-buffer-window "*Org Entity Help*"))) + + (defun replace-amp () - "Postprocess HTML file to unescape the ampersant." + "Postprocess HTML file to unescape the ampersand." (interactive) (while (re-search-forward "<td>&\\([^<;]+;\\)" nil t) (replace-match (concat "<td>&" (match-string 1)) t t))) @@ -493,4 +569,5 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." ;; End: ;; arch-tag: e6bd163f-7419-4009-9c93-a74623016424 + ;;; org-entities.el ends here diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el index 90cb610c538..4676f5b1aaf 100644 --- a/lisp/org/org-exp-blocks.el +++ b/lisp/org/org-exp-blocks.el @@ -4,7 +4,7 @@ ;; Free Software Foundation, Inc. ;; Author: Eric Schulte -;; Version: 6.35i +;; Version: 7.01 ;; This file is part of GNU Emacs. ;; @@ -68,6 +68,8 @@ ;; `org-export-blocks-add-block' to add your block type to ;; `org-export-blocks'. +;;; Code: + (eval-when-compile (require 'cl)) (require 'org) @@ -93,10 +95,10 @@ '((comment org-export-blocks-format-comment t) (ditaa org-export-blocks-format-ditaa nil) (dot org-export-blocks-format-dot nil)) - "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 argumets..." + "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 @@ -106,14 +108,14 @@ Each block export function should accept three argumets..." :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... + "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) @@ -122,25 +124,28 @@ blocks is as follows... (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 argumets..." + "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." + "List of block types (see `org-export-blocks') which should not be exported." :group 'org-export-general :type 'list) -(defvar org-export-blocks-postblock-hooks nil "") +(defcustom org-export-blocks-postblock-hook nil + "Run after blocks have been processed with `org-export-blocks-preprocess'." + :group 'org-export-general + :type 'hook) (defun org-export-blocks-html-quote (body &optional open close) - "Protext BODY from org html export. The optional OPEN and -CLOSE tags will be inserted around BODY." + "Protect BODY from org html export. +The optional OPEN and CLOSE tags will be inserted around BODY." + (concat "\n#+BEGIN_HTML\n" (or open "") @@ -149,8 +154,8 @@ CLOSE tags will be inserted around BODY." "#+END_HTML\n")) (defun org-export-blocks-latex-quote (body &optional open close) - "Protext BODY from org latex export. The optional OPEN and -CLOSE tags will be inserted around BODY." + "Protect BODY from org latex export. +The optional OPEN and CLOSE tags will be inserted around BODY." (concat "\n#+BEGIN_LaTeX\n" (or open "") @@ -159,10 +164,9 @@ CLOSE tags will be inserted around BODY." "#+END_LaTeX\n")) (defun org-export-blocks-preprocess () - "Export all blocks according to the `org-export-blocks' block -exportation alist. Does not export block types specified in -specified in BLOCKS which default to the value of -`org-export-blocks-witheld'." + "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) @@ -174,7 +178,7 @@ specified in BLOCKS which default to the value of (goto-char (point-min)) (setq start (point)) (while (re-search-forward - "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)[\r\n][ \t]*#\\+end_\\S-+.*" nil t) + "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)[\r\n][ \t]*#\\+end_\\S-+.*[\r\n]?" nil t) (setq indentation (length (match-string 1))) (setq type (intern (downcase (match-string 2)))) (setq headers (save-match-data (org-split-string (match-string 3) "[ \t]+"))) @@ -194,7 +198,8 @@ specified in BLOCKS which default to the value of (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))))) (setq start (match-end 0))) - (interblock start (point-max)))))) + (interblock start (point-max)) + (run-hooks 'org-export-blocks-postblock-hook))))) (add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess) @@ -212,7 +217,7 @@ specified in BLOCKS which default to the value of (expand-file-name "../contrib" (file-name-directory (or load-file-name buffer-file-name))))))) - "Path to the ditaa jar executable") + "Path to the ditaa jar executable.") (defun org-export-blocks-format-ditaa (body &rest headers) "Pass block BODY to the ditaa utility creating an image. @@ -222,13 +227,15 @@ passed to the ditaa utility as command line arguments." (message "ditaa-formatting...") (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) (data-file (make-temp-file "org-ditaa")) - (hash (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)))) + (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) @@ -282,13 +289,15 @@ digraph data_relationships { (message "dot-formatting...") (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) (data-file (make-temp-file "org-ditaa")) - (hash (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)))) + (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)))) (cond ((or htmlp latexp docbookp) (unless (file-exists-p out-file) diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el index 87ebfd20062..c3f27cf0e15 100644 --- a/lisp/org/org-exp.el +++ b/lisp/org/org-exp.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -26,11 +26,15 @@ ;; ;;; 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)) @@ -42,6 +46,8 @@ (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)) (autoload 'org-export-generic "org-export-generic" "Export using the generic exporter" t) (defgroup org-export nil "Options for exporting org-listings." @@ -93,9 +99,10 @@ 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. - +\\<org-mode-map> If this option is nil, you can still get background export by calling -`org-export' with a double prefix arg: `C-u C-u C-c C-e'. +`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." @@ -231,7 +238,7 @@ This option can also be set with the +OPTIONS line, e.g. \"num:t\"." "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 \"a\". + 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. @@ -446,35 +453,6 @@ This option can also be set with the +OPTIONS line, e.g. \"f:nil\"." :group 'org-export-translation :type 'boolean) -(defcustom org-export-with-sub-superscripts t - "Non-nil means interpret \"_\" and \"^\" for export. -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 -needed. For example, the following things will be parsed as single -sub- or superscripts. - - 10^24 or 10^tau several digits will be considered 1 item. - 10^-12 or 10^-tau a leading sign with digits or a word - x^2-y^3 will be read as x^2 - y^3, because items are - 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\"." - :group 'org-export-translation - :type '(choice - (const :tag "Always interpret" t) - (const :tag "Only with braces" {}) - (const :tag "Never interpret" nil))) - (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 Å. @@ -518,12 +496,6 @@ This option can also be set with the +OPTIONS line, e.g. \"::nil\"." :group 'org-export-translation :type 'boolean) -(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) - (defgroup org-export-tables nil "Options for exporting tables in Org-mode." :tag "Org Export Tables" @@ -702,7 +674,7 @@ modified) list.") "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE" "LATEX_HEADER" "LATEX_CLASS" "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS" - "KEYWORDS" "DESCRIPTION" "MACRO" "BIND") + "KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT") (mapcar 'car org-export-inbuffer-options-extra)))) p key val text options a pr style latex-header latex-class macros letbind @@ -738,6 +710,8 @@ modified) list.") (setq options (concat val " " options))) ((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") @@ -873,7 +847,8 @@ 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 `C-u C-u', that means to inverse the +ARG is a double universal prefix \\[universal-argument] \\[universal-argument], \ +that means to inverse the value of `org-export-run-in-background'." (interactive "P") (let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background)) @@ -883,7 +858,7 @@ value of `org-export-run-in-background'." \[1] only export the current subtree \[SPC] publish enclosing subtree (with LaTeX_CLASS or EXPORT_FILE_NAME prop) -\[a/n/u] export as ASCII/Latin-1/UFT-8 [A/N/U] to temporary buffer +\[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 @@ -893,6 +868,8 @@ value of `org-export-run-in-background'." \[D] export as DocBook [V] export as DocBook, process to PDF, 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 @@ -919,6 +896,8 @@ value of `org-export-run-in-background'." (?g org-export-generic t) (?D org-export-as-docbook t) (?V org-export-as-docbook-pdf-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) @@ -1003,7 +982,7 @@ value of `org-export-run-in-background'." (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") + "Alist of code references and line numbers.") (defun org-export-preprocess-string (string &rest parameters) "Cleanup STRING so that that the true exported has a more consistent source. @@ -1059,7 +1038,7 @@ on this string to produce the exported version." (untabify (point-min) (point-max)) ;; Handle include files, and call a hook - (org-export-handle-include-files) + (org-export-handle-include-files-recurse) (run-hooks 'org-export-preprocess-after-include-files-hook) ;; Get rid of archived trees @@ -1187,6 +1166,9 @@ on this string to produce the exported version." ;; Remove or replace comments (org-export-handle-comments (plist-get parameters :comments)) + ;; Remove #+TBLFM and #+TBLNAME lines + (org-export-handle-table-metalines) + ;; Run the final hook (run-hooks 'org-export-preprocess-final-hook) @@ -1205,43 +1187,48 @@ on this string to produce the exported version." (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." +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]+\\)")) + "\\|" + "^[ \t]*:\\(ID\\|CUSTOM_ID\\):[ \t]*\\([^ \t\r\n]+\\)")) level target last-section-target a id) (while (re-search-forward re nil t) - (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" (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))))) + (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)))))) target-alist) (defun org-export-handle-invisible-targets (target-alist) @@ -1338,9 +1325,9 @@ the current file." (defvar org-export-format-drawer-function nil "Function to be called to format the contents of a drawer. The function must accept three parameters: - BACKEND one of the symbols html, docbook, latex, ascii, xoxo NAME the drawer name, like \"PROPERTIES\" CONTENT the content of the drawer. + BACKEND one of the symbols html, docbook, latex, ascii, xoxo 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.") @@ -1547,15 +1534,25 @@ from the buffer." (while formatters (setq fmt (pop formatters)) - (when (eq (car fmt) backend) - ;; This is selected code, put it into the file for real - (goto-char (point-min)) - (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" (cadr fmt) - ":[ \t]*\\(.*\\)") nil t) + ;; Handle #+Backend: stuff + (goto-char (point-min)) + (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" (cadr fmt) + ":[ \t]*\\(.*\\)") nil t) + (if (not (eq (car fmt) backend)) + (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) (replace-match "\\1\\2" t) (add-text-properties (point-at-bol) (min (1+ (point-at-eol)) (point-max)) '(org-protected 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_" (cadr fmt) + ":[ \t]*\\(.*\\)") nil t) + (when (not (eq (car fmt) 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]*#\\+" (caddr fmt) "\\>.*\n?") nil t) @@ -1589,8 +1586,8 @@ These special cookies will later be interpreted by the backend." (setq beg (match-beginning 0) beg1 (1+ (match-end 0))) (when (re-search-forward (concat "^[ \t]*#\\+end_" type "\\>.*") nil t) - (setq end (1+ (point-at-eol)) - end1 (1- (match-beginning 0))) + (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" @@ -1615,15 +1612,24 @@ table line. If it is a link, add it to the line containing the link." "^[ \t]*\\(|[^-]\\)" "\\|" "^[ \t]*\\[\\[.*\\]\\][ \t]*$")) - cap attr label end) + cap shortn attr label end) (while (re-search-forward re nil t) (cond ((match-end 1) - (setq cap (concat cap (if cap " " "") (org-trim (match-string 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))))) ((match-end 2) - (setq attr (concat attr (if attr " " "") (org-trim (match-string 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))))) ((match-end 3) - (setq label (org-trim (match-string 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))) @@ -1631,6 +1637,7 @@ table line. If it is a link, add it to the line containing the link." (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)) @@ -1659,21 +1666,36 @@ table line. If it is a link, add it to the line containing the link." "Remove comments, or convert to backend-specific format. COMMENTSP can be a format string for publishing comments. When it is nil, all comments will be removed." - (let ((re "^\\(#\\|[ \t]*#\\+\\)\\(.*\n?\\)") + (let ((re "^\\(#\\|[ \t]*#\\+ \\)\\(.*\n?\\)") + 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 pos 'org-protected) + (goto-char (1+ pos)) + (if (and commentsp + (not (equal (char-before (match-end 1)) ?+))) + (progn (add-text-properties + (match-beginning 0) (match-end 0) '(org-protected t)) + (replace-match (format commentsp (match-string 2)) t t)) + (goto-char (1+ pos)) + (replace-match "") + (goto-char (max (point-min) (1- pos)))))))) + +(defun org-export-handle-table-metalines () + "Remove table specific metalines #+TBLNAME: and #+TBLFM:." + (let ((re "^[ \t]*#\\+TBL\\(NAME\\|FM\\):\\(.*\n?\\)") pos) (goto-char (point-min)) (while (or (looking-at re) (re-search-forward re nil t)) (setq pos (match-beginning 0)) - (if (and commentsp - (not (equal (char-before (match-end 1)) ?+))) - (progn (add-text-properties - (match-beginning 0) (match-end 0) '(org-protected t)) - (replace-match (format commentsp (match-string 2)) t t)) + (if (get-text-property (point) 'org-protected) + (goto-char (1+ pos)) (goto-char (1+ pos)) - (org-if-unprotected - (replace-match "") - (goto-char (max (point-min) (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." @@ -1694,22 +1716,23 @@ When it is nil, all comments will be removed." "Remove tables lines that are used for internal purposes." (goto-char (point-min)) (while (re-search-forward "^[ \t]*|" nil t) - (beginning-of-line 1) - (if (or (looking-at "[ \t]*| *[!_^] *|") - (not - (memq - nil - (mapcar - (lambda (f) - (or (= (length f) 0) - (string-match - "\\`<\\([0-9]\\|[rl]\\|[rl][0-9]+\\)>\\'" f))) - (org-split-string ;; FIXME, can't we do this 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)))) + (org-if-unprotected-at (1- (point)) + (beginning-of-line 1) + (if (or (looking-at "[ \t]*| *[!_^] *|") + (not + (memq + nil + (mapcar + (lambda (f) + (or (= (length f) 0) + (string-match + "\\`<\\([0-9]\\|[rl]\\|[rl][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 @@ -1990,7 +2013,7 @@ TYPE must be a string, any of: (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) + params file markup lang start end prefix prefix1 switches all) (goto-char (point-min)) (while (re-search-forward "^#\\+INCLUDE:?[ \t]+\\(.*\\)" nil t) (setq params (read (concat "(" (match-string 1) ")")) @@ -2007,6 +2030,7 @@ TYPE must be a string, any of: (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" @@ -2019,7 +2043,20 @@ TYPE must be a string, any of: (insert (org-get-file-contents (expand-file-name file) prefix prefix1 markup)) (or (bolp) (newline)) - (insert (or end "")))))) + (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) "Get the contents of FILE and return them as a string. @@ -2034,7 +2071,7 @@ take care of the block they are in." (goto-char (point-min)) (while (not (eobp)) (insert (or prefix1 prefix)) - (setq prefix1 nil) + (setq prefix1 "") (beginning-of-line 2))) (buffer-string) (when (member markup '("src" "example")) @@ -2075,19 +2112,29 @@ in the list) and remove property and value from the list in LISTVAR." 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?\\)" + "\\(^\\([ \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) - ;; src segments - (setq lang (match-string 3) - opts (match-string 4) - code (match-string 5) - indent (length (match-string 2)) - caption (get-text-property 0 'org-caption (match-string 0))) + (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 8) - code (match-string 9) - indent (length (match-string 7)) + 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 @@ -2153,12 +2200,14 @@ INDENT was the original indentation of the block." (org-add-props (concat "<programlisting><![CDATA[" rtn "]]></programlisting>\n") - '(org-protected t)) + '(org-protected t org-example t)) "#+END_DOCBOOK\n")) ((eq backend 'html) ;; We are exporting to HTML (when lang - (require 'htmlize nil t) + (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) @@ -2221,7 +2270,7 @@ INDENT was the original indentation of the block." cont rpllbl fmt))) (if (string-match "\\(\\`<[^>]*>\\)\n" rtn) (setq rtn (replace-match "\\1" t nil rtn))) - (concat "\n#+BEGIN_HTML\n" (org-add-props rtn '(org-protected t)) "\n#+END_HTML\n\n")) + (concat "\n#+BEGIN_HTML\n" (org-add-props rtn '(org-protected t org-example t)) "\n#+END_HTML\n\n")) ((eq backend 'latex) (setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt)) (concat "#+BEGIN_LaTeX\n" @@ -2245,7 +2294,7 @@ INDENT was the original indentation of the block." rtn "\\end{lstlisting}\n") (concat (car org-export-latex-verbatim-wrap) rtn (cdr org-export-latex-verbatim-wrap))) - '(org-protected t)) + '(org-protected t org-example t)) "#+END_LaTeX\n")) ((eq backend 'ascii) ;; This is not HTML or LaTeX, so just make it an example. @@ -2259,7 +2308,7 @@ INDENT was the original indentation of the block." (org-split-string rtn "\n") "\n") "\n") - '(org-protected t)) + '(org-protected t org-example t)) "#+END_ASCII\n")))) (org-add-props rtn nil 'original-indentation indent)))) @@ -2362,8 +2411,8 @@ INDENT was the original indentation of the block." (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 select the export command in -the `C-c C-e' export dispatcher. +TYPE is the final key (as a string) that also selects the export command in +the \\<org-mode-map>\\[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 @@ -2490,7 +2539,8 @@ directory." filename))) (backup-inhibited t) (buffer (find-file-noselect filename)) - (region (buffer-string))) + (region (buffer-string)) + str-ret) (save-excursion (switch-to-buffer buffer) (erase-buffer) @@ -2536,7 +2586,11 @@ directory." (write-file (concat filename ".html"))) (kill-buffer newbuf))) (set-buffer-modified-p nil) - (kill-buffer (current-buffer))))) + (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 () @@ -2558,6 +2612,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." #+EXPORT_EXCLUDE_TAGS: %s #+LINK_UP: %s #+LINK_HOME: %s +#+XSLT: #+CATEGORY: %s #+SEQ_TODO: %s #+TYP_TODO: %s @@ -2650,13 +2705,16 @@ If yes remove the column and the special lines." "^[ \t]*| *\\([\#!$*_^ /]\\) *|") x))) lines)) + ;; No special marking column (progn (setq org-table-clean-did-remove-column nil) (delq nil (mapcar (lambda (x) (cond - ((string-match "^[ \t]*| */ *|" x) + ((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) @@ -2665,14 +2723,20 @@ If yes remove the column and the special lines." (t nil))) (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 - ((string-match "^[ \t]*| */ *|" x) + ((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) @@ -2681,8 +2745,12 @@ If yes remove the column and the special lines." (t nil))) (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) - nil) ; ignore this line + ;; ignore this line + nil) ((or (string-match "^\\([ \t]*\\)|-+\\+" x) (string-match "^\\([ \t]*\\)|[^|]*|" x)) ;; remove the first column @@ -2704,41 +2772,6 @@ If yes remove the column and the special lines." (setq s (replace-match "" t t s))) s) -(defun org-create-multibrace-regexp (left right n) - "Create a regular expression which will match a balanced sexp. -Opening delimiter is LEFT, and closing delimiter is RIGHT, both given -as single character strings. -The regexp returned will match the entire expression including the -delimiters. It will also define a single group which contains the -match except for the outermost delimiters. The maximum depth of -stacked delimiters is N. Escaping delimiters is not possible." - (let* ((nothing (concat "[^" left right "]*?")) - (or "\\|") - (re nothing) - (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) - (while (> n 1) - (setq n (1- n) - re (concat re or next) - next (concat "\\(?:" nothing left next right "\\)+" nothing))) - (concat left "\\(" re "\\)" right))) - -(defvar org-match-substring-regexp - (concat - "\\([^\\]\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\|" - "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" - "\\|" - "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") - "The regular expression matching a sub- or superscript.") - -(defvar org-match-substring-with-braces-regexp - (concat - "\\([^\\]\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\)") - "The regular expression matching a sub- or superscript, forcing braces.") - (defun org-get-text-property-any (pos prop &optional object) (or (get-text-property pos prop object) diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index f86d1b31cb9..740f2629f2b 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -458,7 +458,7 @@ changes." (:foreground "green")) (((class color) (min-colors 8) (background dark)) (:foreground "yellow")))) - "Face for fixed-with text like code snippets." + "Face for fixed-width text like code snippets." :group 'org-faces :version "22.1") @@ -600,7 +600,7 @@ belong to the weekend." (defface org-agenda-dimmed-todo-face '((((background light)) (:foreground "grey50")) (((background dark)) (:foreground "grey50"))) - "Face used to dimm blocked tasks in the agenda." + "Face used to dim blocked tasks in the agenda." :group 'org-faces) (defface org-scheduled-previously diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index c06c7331cca..9d14daea9df 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -45,7 +45,7 @@ ;; With this setup, the command `M-x org-feed-update-all' will ;; collect new entries in the feed at the given URL and create ;; entries as subheadings under the "ReQall Entries" heading in the -;; file "~/org-feeds.org". Each feed should normally have its own +;; file "~/org/feeds.org". Each feed should normally have its own ;; heading - however see the `:drawer' parameter. ;; ;; Besides these standard elements that need to be specified for each @@ -83,8 +83,8 @@ ;; ;; #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS ;; -;; Acknowledgements -;; ---------------- +;; Acknowledgments +;; --------------- ;; ;; org-feed.el is based on ideas by Brad Bozarth who implemented a ;; similar mechanism using shell and awk scripts. @@ -99,6 +99,7 @@ (declare-function xml-get-children "xml" (node child-name)) (declare-function xml-get-attribute "xml" (node attribute)) (declare-function xml-get-attribute-or-nil "xml" (node attribute)) +(defvar xml-entity-alist) (defgroup org-feed nil "Options concerning RSS feeds as inputs for Org files." @@ -165,10 +166,11 @@ Here are the keyword-value pair allows in `org-feed-alist'. When the handler is called, point will be at the feed headline. :parse-feed function - This function gets passed a buffer, and should return a list of entries, - each being a property list containing the `:guid' and `:item-full-text' - keys. The default is `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' - is an alternative. + This function gets passed a buffer, and should return a list + of entries, each being a property list containing the + `:guid' and `:item-full-text' keys. The default is + `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' is an + alternative. :parse-entry function This function gets passed an entry as returned by the parse-feed @@ -199,12 +201,12 @@ Here are the keyword-value pair allows in `org-feed-alist'. (list :inline t :tag "Changed items" (const :changed-handler) (symbol :tag "Handler Function")) - (list :inline t :tag "Parse Feed" - (const :parse-feed) - (symbol :tag "Parse Feed Function")) - (list :inline t :tag "Parse Entry" - (const :parse-entry) - (symbol :tag "Parse Entry Function")) + (list :inline t :tag "Parse Feed" + (const :parse-feed) + (symbol :tag "Parse Feed Function")) + (list :inline t :tag "Parse Entry" + (const :parse-entry) + (symbol :tag "Parse Entry Function")) ))))) (defcustom org-feed-drawer "FEEDSTATUS" @@ -267,6 +269,17 @@ have been saved." (defvar org-feed-buffer "*Org feed*" "The buffer used to retrieve a feed.") +(defun org-feed-unescape (s) + "Unescape protected entities in S." + (require 'xml) + (let ((re (concat "&\\(" + (mapconcat 'car xml-entity-alist "\\|") + "\\);"))) + (while (string-match re s) + (setq s (replace-match + (cdr (assoc (match-string 1 s) xml-entity-alist)) nil nil s))) + s)) + ;;;###autoload (defun org-feed-update-all () "Get inbox items from all feeds in `org-feed-alist'." @@ -302,10 +315,10 @@ it can be a list structured like an entry in `org-feed-alist'." org-feed-default-template)) (drawer (or (nth 1 (memq :drawer feed)) org-feed-drawer)) - (parse-feed (or (nth 1 (memq :parse-feed feed)) - 'org-feed-parse-rss-feed)) - (parse-entry (or (nth 1 (memq :parse-entry feed)) - 'org-feed-parse-rss-entry)) + (parse-feed (or (nth 1 (memq :parse-feed feed)) + 'org-feed-parse-rss-feed)) + (parse-entry (or (nth 1 (memq :parse-entry feed)) + 'org-feed-parse-rss-entry)) feed-buffer inbox-pos new-formatted entries old-status status new changed guid-alist e guid olds) (setq feed-buffer (org-feed-get-feed url)) @@ -321,10 +334,11 @@ it can be a list structured like an entry in `org-feed-alist'." (setq old-status (org-feed-read-previous-status inbox-pos drawer)) ;; Add the "handled" status to the appropriate entries (setq entries (mapcar (lambda (e) - (setq e (plist-put e :handled - (nth 1 (assoc - (plist-get e :guid) - old-status))))) + (setq e + (plist-put e :handled + (nth 1 (assoc + (plist-get e :guid) + old-status))))) entries)) ;; Find out which entries are new and which are changed (dolist (e entries) @@ -579,11 +593,12 @@ Assumes headers are indeed present!" "Parse BUFFER for RSS feed entries. Returns a list of entries, with each entry a property list, containing the properties `:guid' and `:item-full-text'." - (let (entries beg end item guid entry) + (let ((case-fold-search t) + entries beg end item guid entry) (with-current-buffer buffer (widen) (goto-char (point-min)) - (while (re-search-forward "<item>" nil t) + (while (re-search-forward "<item\\>.*?>" nil t) (setq beg (point) end (and (re-search-forward "</item>" nil t) (match-beginning 0))) @@ -605,7 +620,7 @@ containing the properties `:guid' and `:item-full-text'." nil t) (setq entry (plist-put entry (intern (concat ":" (match-string 1))) - (match-string 2)))) + (org-feed-unescape (match-string 2))))) (goto-char (point-min)) (unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t) (setq entry (plist-put entry :guid-permalink t)))) @@ -618,14 +633,15 @@ containing the properties `:guid' and `:item-full-text'. The `:item-full-text' property actually contains the sexp formatted as a string, not the original XML data." + (require 'xml) (with-current-buffer buffer (widen) (let ((feed (car (xml-parse-region (point-min) (point-max))))) (mapcar (lambda (entry) - (list - :guid (car (xml-node-children (car (xml-get-children entry 'id)))) - :item-full-text (prin1-to-string entry))) + (list + :guid (car (xml-node-children (car (xml-get-children entry 'id)))) + :item-full-text (prin1-to-string entry))) (xml-get-children feed 'entry))))) (defun org-feed-parse-atom-entry (entry) @@ -633,28 +649,36 @@ formatted as a string, not the original XML data." (let ((xml (car (read-from-string (plist-get entry :item-full-text))))) ;; Get first <link href='foo'/>. (setq entry (plist-put entry :link - (xml-get-attribute - (car (xml-get-children xml 'link)) - 'href))) + (xml-get-attribute + (car (xml-get-children xml 'link)) + 'href))) ;; Add <title/> as :title. (setq entry (plist-put entry :title - (car (xml-node-children - (car (xml-get-children xml 'title)))))) + (org-feed-unescape + (car (xml-node-children + (car (xml-get-children xml 'title))))))) (let* ((content (car (xml-get-children xml 'content))) - (type (xml-get-attribute-or-nil content 'type))) + (type (xml-get-attribute-or-nil content 'type))) (when content - (cond - ((string= type "text") - ;; We like plain text. - (setq entry (plist-put entry :description (car (xml-node-children content))))) - ((string= type "html") - ;; TODO: convert HTML to Org markup. - (setq entry (plist-put entry :description (car (xml-node-children content))))) - ((string= type "xhtml") - ;; TODO: convert XHTML to Org markup. - (setq entry (plist-put entry :description (prin1-to-string (xml-node-children content))))) - (t - (setq entry (plist-put entry :description (format "Unknown '%s' content." type))))))) + (cond + ((string= type "text") + ;; We like plain text. + (setq entry (plist-put entry :description + (org-feed-unescape + (car (xml-node-children content)))))) + ((string= type "html") + ;; TODO: convert HTML to Org markup. + (setq entry (plist-put entry :description + (org-feed-unescape + (car (xml-node-children content)))))) + ((string= type "xhtml") + ;; TODO: convert XHTML to Org markup. + (setq entry (plist-put entry :description + (prin1-to-string + (xml-node-children content))))) + (t + (setq entry (plist-put entry :description + (format "Unknown '%s' content." type))))))) entry)) (provide 'org-feed) diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index 5964ef4ce2c..2a2c4c0f426 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -65,6 +65,11 @@ (org-re "^\\(\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]\\)") "Regular expression matching the definition of a footnote.") +(defgroup org-footnote nil + "Footnotes in Org-mode." + :tag "Org Footnote" + :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 @@ -75,7 +80,7 @@ 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." - :group 'org-footnotes + :group 'org-footnote :type '(choice (string :tag "Collect footnotes under heading") (const :tag "Define footnotes locally" nil))) @@ -87,7 +92,7 @@ as in Org-mode. Outside Org-mode, new footnotes are always placed at the end of the file. When you normalize the notes, any line containing only this tag will be removed, a new one will be inserted at the end of the file, followed by the collected and normalized footnotes." - :group 'org-footnotes + :group 'org-footnote :type 'string) (defcustom org-footnote-define-inline nil @@ -182,25 +187,25 @@ with start and label of the footnote if there is a definition at point." (org-show-context 'link-search) (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))) -(defun org-footnote-goto-next-reference (label) - "Find the next reference of the footnote with label LABEL." +(defun org-footnote-goto-previous-reference (label) + "Find the next previous of the footnote with label LABEL." (interactive "sLabel: ") (org-mark-ring-push) (setq label (org-footnote-normalize-label label)) (let ((re (format ".\\[%s[]:]" label)) (p0 (point)) pos) (save-excursion - (setq pos (or (re-search-forward re nil t) - (and (goto-char (point-min)) - (re-search-forward re nil t)) + (setq pos (or (re-search-backward re nil t) + (and (goto-char (point-max)) + (re-search-backward re nil t)) (and (progn (widen) t) (goto-char p0) - (re-search-forward re nil t)) - (and (goto-char (point-min)) + (re-search-backward re nil t)) + (and (goto-char (point-max)) (re-search-forward re nil t))))) (if pos (progn - (goto-char pos) + (goto-char (match-end 0)) (org-show-context 'link-search)) (error "Cannot find reference of footnote %s" label)))) @@ -339,7 +344,7 @@ With prefix arg SPECIAL, offer additional commands in a menu." (org-footnote-goto-definition (nth 1 tmp)) (goto-char (match-beginning 4)))) ((setq tmp (org-footnote-at-definition-p)) - (org-footnote-goto-next-reference (nth 1 tmp))) + (org-footnote-goto-previous-reference (nth 1 tmp))) (t (org-footnote-new))))) ;;;###autoload diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index b431cad20fa..f2fca8c29f4 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -7,7 +7,7 @@ ;; Tassilo Horn <tassilo at member dot fsf dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -48,7 +48,7 @@ (defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)) (defcustom org-gnus-prefer-web-links nil - "Non-nil means `org-store-link' will create web links to Google groups. + "If non-nil, `org-store-link' creates web links to Google groups or Gmane. When nil, Gnus will be used for such links. Using a prefix arg to the command \\[org-store-link] (`org-store-link') negates this setting for the duration of the command." @@ -120,22 +120,26 @@ If `org-store-link' was called with a prefix arg the meaning of ((memq major-mode '(gnus-summary-mode gnus-article-mode)) (let* ((group gnus-newsgroup-name) - (header (with-current-buffer gnus-summary-buffer + (header (with-current-buffer gnus-summary-buffer (gnus-summary-article-header))) (from (mail-header-from header)) (message-id (org-remove-angle-brackets (mail-header-id header))) (date (mail-header-date header)) - (subject (mail-header-subject header)) - (to (cdr (assq 'To (mail-header-extra header)))) - newsgroups x-no-archive desc link) + (subject (copy-sequence (mail-header-subject header))) + (to (cdr (assq 'To (mail-header-extra header)))) + newsgroups x-no-archive desc link) + ;; Remove text properties of subject string to avoid Emacs bug + ;; #3506 + (set-text-properties 0 (length subject) nil subject) + ;; Fetching an article is an expensive operation; newsgroup and ;; x-no-archive are only needed for web links. (when (org-xor current-prefix-arg org-gnus-prefer-web-links) - ;; Make sure the original article buffer is up-to-date - (save-window-excursion (gnus-summary-select-article)) - (setq to (or to (gnus-fetch-original-field "To")) - newsgroups (gnus-fetch-original-field "Newsgroups") - x-no-archive (gnus-fetch-original-field "x-no-archive"))) + ;; Make sure the original article buffer is up-to-date + (save-window-excursion (gnus-summary-select-article)) + (setq to (or to (gnus-fetch-original-field "To")) + newsgroups (gnus-fetch-original-field "Newsgroups") + x-no-archive (gnus-fetch-original-field "x-no-archive"))) (org-store-link-props :type "gnus" :from from :subject subject :message-id message-id :group group :to to) (setq desc (org-email-link-description) diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index 93be08ca37b..71e0a9583f1 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -5,7 +5,7 @@ ;; Author: John Wiegley <johnw at gnu dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -27,11 +27,13 @@ ;; This file contains the habit tracking code for Org-mode +;;; Code: + (require 'org) (require 'org-agenda) + (eval-when-compile - (require 'cl) - (require 'calendar)) + (require 'cl)) (defgroup org-habit nil "Options concerning habit tracking in Org-mode." @@ -179,8 +181,10 @@ This list represents a \"habit\" for the rest of this module." (defsubst org-habit-deadline (habit) (let ((deadline (nth 2 habit))) (or deadline - (+ (org-habit-scheduled habit) - (1- (org-habit-scheduled-repeat habit)))))) + (if (nth 3 habit) + (+ (org-habit-scheduled habit) + (1- (org-habit-scheduled-repeat habit))) + (org-habit-scheduled habit))))) (defsubst org-habit-deadline-repeat (habit) (or (nth 3 habit) (org-habit-scheduled-repeat habit))) @@ -281,9 +285,16 @@ current time." donep))) markedp face) (if donep - (progn + (let ((done-time (time-add + starting + (days-to-time + (- start (time-to-days starting)))))) + (aset graph index ?*) (setq markedp t) + (put-text-property + index (1+ index) 'help-echo + (format-time-string (org-time-stamp-format) done-time) graph) (while (and done-dates (= start (car done-dates))) (setq last-done-date (car done-dates) diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el index f891e5a85a5..e20b92147fc 100644 --- a/lisp/org/org-html.el +++ b/lisp/org/org-html.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -26,7 +26,10 @@ ;; ;;; Commentary: +;;; Code: + (require 'org-exp) + (eval-when-compile (require 'cl)) (declare-function org-id-find-id-file "org-id" (id)) @@ -57,7 +60,7 @@ by the footnotes themselves." :type 'string) (defcustom org-export-html-coding-system nil - "Coding system for HTML export, defaults to buffer-file-coding-system." + "Coding system for HTML export, defaults to `buffer-file-coding-system'." :group 'org-export-html :type 'coding-system) @@ -81,7 +84,7 @@ and corresponding declarations." (string :tag "Declaration"))))) (defcustom org-export-html-style-include-scripts t - "Non-nil means include the javascript snippets in exported HTML files. + "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 @@ -110,7 +113,7 @@ not be modified." } /*]]>*///--> </script>" -"Basic javascript that is needed by HTML files produced by Org-mode.") +"Basic JavaScript that is needed by HTML files produced by Org-mode.") (defconst org-export-html-style-default "<style type=\"text/css\"> @@ -207,20 +210,20 @@ settings with <style>...</style> tags." (put 'org-export-html-style-extra 'safe-local-variable 'stringp) (defcustom org-export-html-tag-class-prefix "" - "Prefix to clas names for TODO keywords. + "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 prefic can be very useful." +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 clas names for TODO keywords. + "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 prefic can be very useful." +CSS classes, then this prefix can be very useful." :group 'org-export-html :type 'string) @@ -235,10 +238,11 @@ CSS classes, then this prefic can be very useful." | <a accesskey=\"H\" href=\"%s\"> HOME </a> </div>" - "Snippet used to insert the HOME and UP links. This is a format, -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." + "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) @@ -340,7 +344,7 @@ When nil, also column one will use data tags." :type 'boolean) (defcustom org-export-html-validation-link nil - "Non-nil means add validationlink to postamble of HTML exported files." + "Non-nil means add validation link to postamble of HTML exported files." :group 'org-export-html :type '(choice (const :tag "Nothing" nil) @@ -349,9 +353,10 @@ When nil, also column one will use data tags." (defcustom org-export-html-with-timestamp nil - "If non-nil, write `org-export-html-html-helper-timestamp' -into the exported HTML text. Otherwise, the buffer will just be saved -to a file." + "If non-nil, write timestamp into the exported HTML text. +If non-nil Write `org-export-html-html-helper-timestamp' into the +exported HTML text. Otherwise, the buffer will just be saved to +a file." :group 'org-export-html :type 'boolean) @@ -405,10 +410,10 @@ with a link to this URL." ;;; Variables, constants, and parameter plists (defvar org-export-html-preamble nil - "Preamble, to be inserted just before <body>. Set by publishing functions. + "Preamble, to be inserted just after <body>. Set by publishing functions. This may also be a function, building and inserting the preamble.") (defvar org-export-html-postamble nil - "Preamble, to be inserted just after </body>. Set by publishing functions. + "Preamble, to be inserted just before </body>. Set by publishing functions. This may also be a function, building and inserting the postamble.") (defvar org-export-html-auto-preamble t "Should default preamble be inserted? Set by publishing functions.") @@ -426,14 +431,15 @@ This may also be a function, building and inserting the postamble.") ;;; HTML export (defun org-export-html-preprocess (parameters) - ;; Convert LaTeX fragments to images + "Convert LaTeX fragments to images." (when (and org-current-export-file (plist-get parameters :LaTeX-fragments)) (org-format-latex (concat "ltxpng/" (file-name-sans-extension (file-name-nondirectory org-current-export-file))) - org-current-export-dir nil "Creating LaTeX image %s")) + org-current-export-dir nil "Creating LaTeX image %s" + nil nil (eq (plist-get parameters :LaTeX-fragments) 'verbatim))) (goto-char (point-min)) (let (label l1) (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t) @@ -455,11 +461,12 @@ headlines. The default is 3. Lower levels will become bulleted lists." (org-export-as-html arg 'hidden) (org-open-file buffer-file-name) (when org-export-kill-product-buffer-when-displayed - (kill-buffer))) + (kill-buffer (current-buffer)))) ;;;###autoload (defun org-export-as-html-batch () - "Call `org-export-as-html', may be used in batch processing as + "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)\" @@ -533,6 +540,131 @@ in a window. A non-interactive call will only return the buffer." (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 + "http" + (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)) + (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#locationx) +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) + (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")) + (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 (string= "file" type)) + (org-string-match-p "^//" str)) + (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 + "<a href=\"" thefile "\"" attr ">" + (org-export-html-format-desc desc) + "</a>"))))) + +;;; org-export-as-html ;;;###autoload (defun org-export-as-html (arg &optional hidden ext-plist to-buffer body-only pub-dir) @@ -710,7 +842,7 @@ PUB-DIR is set, use this as the publishing directory." table-buffer table-orig-buffer ind item-type starter didclose rpl path attr desc descp desc1 desc2 link - snumber fnc item-tag + snumber fnc item-tag initial-number footnotes footref-seen id-file href ) @@ -789,7 +921,7 @@ lang=\"%s\" xml:lang=\"%s\"> "") (or charset "iso-8859-1")) language language - (org-html-expand title) + title (or charset "iso-8859-1") date author description keywords style @@ -871,7 +1003,9 @@ lang=\"%s\" xml:lang=\"%s\"> t t line))) (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) (setq txt (replace-match "" t t txt))) - (setq href (format "sec-%s" snumber)) + (setq href + (replace-regexp-in-string + "\\." "_" (format "sec-%s" snumber))) (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href)) (push (format @@ -959,10 +1093,12 @@ lang=\"%s\" xml:lang=\"%s\"> (when (equal "ORG-VERSE-START" line) (org-close-par-maybe) (insert "\n<p class=\"verse\">\n") + (setq org-par-open t) (setq inverse t) (throw 'nextline nil)) (when (equal "ORG-VERSE-END" line) (insert "</p>\n") + (setq org-par-open nil) (org-open-par) (setq inverse nil) (throw 'nextline nil)) @@ -1042,70 +1178,79 @@ lang=\"%s\" xml:lang=\"%s\"> 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 + ;; 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 + 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 "<img src=\"" desc "\"/>") '(org-protected t)))) - ;; FIXME: do we need to unescape here somewhere? (cond ((equal type "internal") - (setq rpl - (concat - "<a href=\"" - (if (= (string-to-char path) ?#) "" "#") - (org-solidify-link-text - (save-match-data (org-link-unescape path)) nil) - "\"" attr ">" - (org-export-html-format-desc desc) - "</a>"))) + (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 id-file (concat (file-name-sans-extension id-file) - "." html-extension)) - (setq rpl (concat "<a href=\"" id-file "#" - (if (org-uuidgen-p path) "ID-") - path "\"" - attr ">" - (org-export-html-format-desc desc) - "</a>")))) + 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, just check if we need to inline an image - (if (and (or (eq t org-export-html-inline-images) - (and org-export-html-inline-images (not descp))) - (org-file-image-p - path org-export-html-inline-image-extensions)) - (setq rpl (org-export-html-format-image - (concat type ":" path) org-par-open)) - (setq link (concat type ":" path)) - (setq rpl (concat "<a href=\"" - (org-export-html-format-href link) - "\"" attr ">" - (org-export-html-format-desc desc) - "</a>")))) + ;; 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 - (setq link (concat type ":" path)) - (setq rpl (concat "<a href=\"" - (org-export-html-format-href link) - "\"" attr ">" - (org-export-html-format-desc desc) - "</a>"))) + ;; standard URL, can't inline as image + (setq rpl + (org-html-make-link opt-plist + type path nil + desc + attr + nil))) ((string= type "coderef") - (setq rpl (format "<a href=\"#coderef-%s\" class=\"coderef\" onmouseover=\"CodeHighlightOn(this, 'coderef-%s');\" onmouseout=\"CodeHighlightOff(this, 'coderef-%s');\">%s</a>" - path path path - (format (org-export-get-coderef-format path (and descp desc)) - (cdr (assoc path org-export-code-refs)))))) + (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 @@ -1114,52 +1259,55 @@ lang=\"%s\" xml:lang=\"%s\"> (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) + ;; FILE link (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-html-inline-image-extensions)) - (setq thefile (if abs-p (expand-file-name filename) filename)) - (when (and org-export-html-link-org-files-as-html - (string-match "\\.org$" thefile)) - (setq thefile (concat (substring thefile 0 - (match-beginning 0)) - "." html-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 - (if (= (string-to-char search) ?#) "" "#") - (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-html-inline-images) - (and org-export-html-inline-images - (not descp)))) - (progn - (message "image %s %s" thefile org-par-open) - (org-export-html-format-image thefile org-par-open)) - (concat "<a href=\"" thefile "\"" attr ">" - (org-export-html-format-desc desc) - "</a>"))) - (if (not valid) (setq rpl desc)))) + (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 @@ -1280,7 +1428,11 @@ lang=\"%s\" xml:lang=\"%s\"> starter (if (match-beginning 2) (substring (match-string 2 line) 0 -1)) line (substring line (match-beginning 5)) + initial-number nil item-tag nil) + (if (string-match "\\`\\[@start:\\([0-9]+\\)\\][ \t]?" line) + (setq initial-number (match-string 1 line) + line (replace-match "" t t line))) (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) (setq item-type "d" item-tag (match-string 1 line) @@ -1305,11 +1457,15 @@ lang=\"%s\" xml:lang=\"%s\"> ((and starter (or (not in-local-list) (> ind (car local-list-indent)))) + ;; check for a specified start number ;; Start new (level of) list (org-close-par-maybe) (insert (cond ((equal item-type "u") "<ul>\n<li>\n") - ((equal item-type "o") "<ol>\n<li>\n") + ((equal item-type "o") + (if initial-number + (format "<ol start=%s>\n<li>\n" initial-number) + "<ol>\n<li>\n")) ((equal item-type "d") (format "<dl>\n<dt>%s</dt><dd>\n" item-tag)))) (push item-type local-list-type) @@ -1621,7 +1777,7 @@ lang=\"%s\" xml:lang=\"%s\"> (lambda (x) (string-match "^[ \t]*|-" x)) (cdr lines))))) - (nline 0) fnum i + (nline 0) fnum nfields i tbopen line fields html gr colgropen rowstart rowend) (setq caption (and caption (org-html-do-expand caption))) (if splice (setq head nil)) @@ -1639,7 +1795,8 @@ lang=\"%s\" xml:lang=\"%s\"> (throw 'next-line t))) ;; Break the line into fields (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (unless fnum (setq fnum (make-vector (length fields) 0))) + (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))) @@ -1647,7 +1804,7 @@ lang=\"%s\" xml:lang=\"%s\"> (mapconcat (lambda (x) (setq i (1+ i)) - (if (and (< i nline) + (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 @@ -1867,7 +2024,7 @@ that uses these same face definitions." (goto-char (point-min))) (defun org-html-protect (s) - ;; convert & to &, < to < and > to > + "convert & to &, < to < and > to >" (let ((start 0)) (while (string-match "&" s start) (setq s (replace-match "&" t t s) @@ -1882,7 +2039,7 @@ that uses these same face definitions." s) (defun org-html-expand (string) - "Prepare STRING for HTML export. Applies all active conversions. + "Prepare STRING for HTML export. Apply 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]*$"))) @@ -1996,10 +2153,18 @@ If there are links in the string, don't modify these." (defvar local-list-indent) (defvar local-list-type) (defun org-export-html-close-lists-maybe (line) - (let ((ind (or (get-text-property 0 'original-indentation line))) -; (and (string-match "\\S-" line) -; (org-get-indentation line)))) - didclose) + "Close local lists based on the original indentation of the line." + (let* ((rawhtml (and in-local-list + (get-text-property 0 'org-protected line) + (not (get-text-property 0 'org-example line)))) + ;; rawhtml means: This was between #+begin_html..#+end_html + ;; originally, thus it excludes stuff that was a source code example + ;; Actually, this code seems wrong, I don't know why it works, but + ;; it seems to work.... So keep it like this for now. + (ind (if rawhtml + (org-get-indentation line) + (get-text-property 0 'original-indentation line))) + didclose) (when ind (while (and in-local-list (<= ind (car local-list-indent))) @@ -2023,7 +2188,7 @@ When TITLE is nil, just close all open levels." (cdr (assoc target org-export-preferred-target-alist)))) (remove (or preferred target)) (l org-level-max) - snumber href suffix) + snumber snu href suffix) (setq extra-targets (remove remove extra-targets)) (setq extra-targets (mapconcat (lambda (x) @@ -2072,7 +2237,8 @@ When TITLE is nil, just close all open levels." extra-targets title "<br/>\n") (insert "<ul>\n<li>" title "<br/>\n")))) (aset org-levels-open (1- level) t) - (setq snumber (org-section-number level)) + (setq snumber (org-section-number level) + snu (replace-regexp-in-string "\\." "_" snumber)) (setq level (+ level org-export-html-toplevel-hlevel -1)) (if (and org-export-with-section-numbers (not body-only)) (setq title (concat @@ -2080,9 +2246,9 @@ When TITLE is nil, just close all open levels." level snumber) " " title))) (unless (= head-count 1) (insert "\n</div>\n")) - (setq href (cdr (assoc (concat "sec-" snumber) org-export-preferred-target-alist))) - (setq suffix (or href snumber)) - (setq href (or href (concat "sec-" snumber))) + (setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist))) + (setq suffix (or href snu)) + (setq href (or href (concat "sec-" snu))) (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d%s\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n" suffix level (if extra-class (concat " " extra-class) "") level href diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el index 144f261e42d..1c4d7d6ac5b 100644 --- a/lisp/org/org-icalendar.el +++ b/lisp/org/org-icalendar.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -26,8 +26,13 @@ ;; ;;; 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 @@ -47,6 +52,11 @@ The file name should be absolute, the file will be overwritten without warning." :group 'org-export-icalendar :type 'string) +(defcustom org-icalendar-combined-description nil + "Calendar description for the combined iCalendar representing all agenda files." + :group 'org-export-icalendar + :type 'string) + (defcustom org-icalendar-use-plain-timestamp t "Non-nil means make an event from every plain time stamp." :group 'org-export-icalendar @@ -157,7 +167,7 @@ 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, -superceding the previous form of it. This is essential for +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, @@ -185,7 +195,7 @@ file, but with extension `.ics'." ;;;###autoload (defun org-export-icalendar-all-agenda-files () - "Export all files in `org-agenda-files' to iCalendar .ics 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) @@ -511,11 +521,12 @@ whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH characters." (if (not s) nil - (when is-body + (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))))) + (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) @@ -563,14 +574,16 @@ not used right now." (name (or name "unknown")) (timezone (if (> (length org-icalendar-timezone) 0) org-icalendar-timezone - (cadr (current-time-zone))))) + (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 -CALSCALE:GREGORIAN\n" name user timezone)))) +X-WR-CALDESC:%s +CALSCALE:GREGORIAN\n" name user timezone description)))) (defun org-finish-icalendar-file () "Finish an iCalendar file by inserting the END statement." @@ -581,22 +594,24 @@ CALSCALE:GREGORIAN\n" name user timezone)))) 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)) + (let ((t1 (ignore-errors (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 (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) - (concat keyword (format-time-string fmt 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 ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) + (concat keyword (format-time-string fmt time))))) (provide 'org-icalendar) diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index d0bb53456e9..d16e5d81c8e 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -37,8 +37,9 @@ ;; time of the ID, with microsecond accuracy. This virtually ;; guarantees globally unique identifiers, even if several people are ;; creating IDs at the same time in files that will eventually be used -;; together. As an external method `uuidgen' is supported, if installed -;; on the system. +;; together. +;; +;; By default Org uses UUIDs as global unique identifiers. ;; ;; This file defines the following API: ;; @@ -68,6 +69,8 @@ ;; Find the location of an entry with specific id. ;; +;;; Code: + (require 'org) (declare-function message-make-fqdn "message" ()) @@ -84,18 +87,9 @@ :group 'org-id :type 'string) -(defcustom org-id-method - (condition-case nil - (if (string-match "\\`[-0-9a-fA-F]\\{36\\}\\'" - (org-trim (shell-command-to-string - org-id-uuid-program))) - 'uuidgen - 'org) - (error 'org)) +(defcustom org-id-method 'uuid "The method that should be used to create new IDs. -If `uuidgen' is available on the system, it will be used as the default method. -if not, the method `org' is used. An ID will consist of the optional prefix specified in `org-id-prefix', and a unique part created by the method this variable specifies. @@ -105,11 +99,13 @@ org Org's own internal method, using an encoding of the current time to microsecond accuracy, and optionally the current domain of the computer. See the variable `org-id-include-domain'. -uuidgen Call the external command uuidgen." +uuid Create random (version 4) UUIDs. If the program defined in + `org-id-uuid-program' is available it is used to create the ID. + Otherwise an internal functions is used." :group 'org-id :type '(choice (const :tag "Org's internal method" org) - (const :tag "external: uuidgen" uuidgen))) + (const :tag "external: uuidgen" uuid))) (defcustom org-id-prefix nil "The prefix for IDs. @@ -306,8 +302,10 @@ So a typical ID could look like \"Org:4nd91V40HI\"." unique) (if (equal prefix ":") (setq prefix "")) (cond - ((eq org-id-method 'uuidgen) - (setq unique (org-trim (shell-command-to-string org-id-uuid-program)))) + ((memq org-id-method '(uuidgen uuid)) + (setq unique (org-trim (shell-command-to-string org-id-uuid-program))) + (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))) (postfix (if org-id-include-domain @@ -318,6 +316,30 @@ So a typical ID could look like \"Org:4nd91V40HI\"." (t (error "Invalid `org-id-method'"))) (concat prefix unique))) +(defun org-id-uuid () + "Return string with random (version 4) UUID." + (let ((rnd (md5 (format "%s%s%s%s%s%s%s" + (random t) + (current-time) + (user-uid) + (emacs-pid) + (user-full-name) + user-mail-address + (recent-keys))))) + (format "%s-%s-4%s-%s%s-%s" + (substring rnd 0 8) + (substring rnd 8 12) + (substring rnd 13 16) + (format "%x" + (logior + #b10000000 + (logand + #b10111111 + (string-to-number + (substring rnd 16 18) 16)))) + (substring rnd 18 20) + (substring rnd 20 32)))) + (defun org-id-reverse-string (s) (mapconcat 'char-to-string (nreverse (string-to-list s)) "")) diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index 7fb4e421dcc..d88688d19ba 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -4,7 +4,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -29,22 +29,24 @@ ;; by adding text properties to a buffer to make sure lines are ;; indented according to outline structure. +;;; Code: + (require 'org-macs) (require 'org-compat) (require 'org) + (eval-when-compile (require 'cl)) - (defgroup org-indent nil "Options concerning dynamic virtual outline indentation." :tag "Org Indent" :group 'org) (defconst org-indent-max 40 - "Maximum indentation in characters") + "Maximum indentation in characters.") (defconst org-indent-max-levels 40 - "Maximum indentation in characters") + "Maximum indentation in characters.") (defvar org-indent-strings nil "Vector with all indentation strings. @@ -53,7 +55,7 @@ It will be set in `org-indent-initialize'.") "Vector with all indentation star strings. It will be set in `org-indent-initialize'.") (defvar org-hide-leading-stars-before-indent-mode nil - "Used locally") + "Used locally.") (defcustom org-indent-boundary-char ?\ ; comment to protect space char "The end of the virtual indentation strings, a single-character string. @@ -67,13 +69,15 @@ it may be prettier to customize the org-indent face." :type 'character) (defcustom org-indent-mode-turns-off-org-adapt-indentation t - "Non-nil means turning on `org-indent-mode' turns off indentation adaptation. + "Non-nil means setting the variable `org-indent-mode' will \ +turn off indentation adaptation. For details see the variable `org-adapt-indentation'." :group 'org-indent :type 'boolean) (defcustom org-indent-mode-turns-on-hiding-stars t - "Non-nil means turning on `org-indent-mode' turns on `org-hide-leading-stars'." + "Non-nil means setting the variable `org-indent-mode' will \ +turn on `org-hide-leading-stars'." :group 'org-indent :type 'boolean) @@ -127,44 +131,57 @@ Internally this works by adding `line-prefix' properties to all non-headlines. These properties are updated locally in idle time. FIXME: How to update when broken?" nil " Ind" nil - (if (org-bound-and-true-p org-inhibit-startup) - (setq org-indent-mode nil) - (if org-indent-mode - (progn - (or org-indent-strings (org-indent-initialize)) - (when org-indent-mode-turns-off-org-adapt-indentation - (org-set-local 'org-adapt-indentation nil)) - (when org-indent-mode-turns-on-hiding-stars - (org-set-local 'org-hide-leading-stars-before-indent-mode - org-hide-leading-stars) - (org-set-local 'org-hide-leading-stars t)) - (make-local-variable 'buffer-substring-filters) - (add-to-list 'buffer-substring-filters - 'org-indent-remove-properties-from-string) - (org-add-hook 'org-after-demote-entry-hook - 'org-indent-refresh-section nil 'local) - (org-add-hook 'org-after-promote-entry-hook - 'org-indent-refresh-section nil 'local) - (org-add-hook 'org-font-lock-hook - 'org-indent-refresh-to nil 'local) - (and font-lock-mode (org-restart-font-lock)) - ) - (save-excursion - (save-restriction - (org-indent-remove-properties (point-min) (point-max)) - (kill-local-variable 'org-adapt-indentation) - (when (boundp 'org-hide-leading-stars-before-indent-mode) - (org-set-local 'org-hide-leading-stars - org-hide-leading-stars-before-indent-mode)) - (setq buffer-substring-filters - (delq 'org-indent-remove-properties-from-string - buffer-substring-filters)) - (remove-hook 'org-after-promote-entry-hook - 'org-indent-refresh-section 'local) - (remove-hook 'org-after-demote-entry-hook - 'org-indent-refresh-section 'local) - (and font-lock-mode (org-restart-font-lock)) - (redraw-display)))))) + (cond + ((org-bound-and-true-p org-inhibit-startup) + (setq org-indent-mode nil)) + ((and org-indent-mode (featurep 'xemacs)) + (message "org-indent-mode does not work in XEmacs - refused to turn it on") + (setq org-indent-mode nil)) + ((and org-indent-mode + (not (org-version-check "23.1.50" "Org Indent mode" :predicate))) + (message "org-indent-mode is can crash Emacs 23.1 - refused to turn it on!") + (ding) + (sit-for 1) + (setq org-indent-mode nil)) + (org-indent-mode + ;; mode was turned on. + (org-set-local 'indent-tabs-mode nil) + (or org-indent-strings (org-indent-initialize)) + (when org-indent-mode-turns-off-org-adapt-indentation + (org-set-local 'org-adapt-indentation nil)) + (when org-indent-mode-turns-on-hiding-stars + (org-set-local 'org-hide-leading-stars-before-indent-mode + org-hide-leading-stars) + (org-set-local 'org-hide-leading-stars t)) + (make-local-variable 'buffer-substring-filters) + (add-to-list 'buffer-substring-filters + 'org-indent-remove-properties-from-string) + (org-add-hook 'org-after-demote-entry-hook + 'org-indent-refresh-section nil 'local) + (org-add-hook 'org-after-promote-entry-hook + 'org-indent-refresh-section nil 'local) + (org-add-hook 'org-font-lock-hook + 'org-indent-refresh-to nil 'local) + (and font-lock-mode (org-restart-font-lock)) + ) + (t + ;; mode was turned off (or we refused to turn it on) + (save-excursion + (save-restriction + (org-indent-remove-properties (point-min) (point-max)) + (kill-local-variable 'org-adapt-indentation) + (when (boundp 'org-hide-leading-stars-before-indent-mode) + (org-set-local 'org-hide-leading-stars + org-hide-leading-stars-before-indent-mode)) + (setq buffer-substring-filters + (delq 'org-indent-remove-properties-from-string + buffer-substring-filters)) + (remove-hook 'org-after-promote-entry-hook + 'org-indent-refresh-section 'local) + (remove-hook 'org-after-demote-entry-hook + 'org-indent-refresh-section 'local) + (and font-lock-mode (org-restart-font-lock)) + (redraw-display)))))) (defface org-indent diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index e33adf43ee0..3c6bf7d2ca4 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 5232f2c264b..43d59b0b558 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; This file is part of GNU Emacs. @@ -33,7 +33,7 @@ ;; and properties. However, these nodes are treated specially by the ;; visibility cycling and export commands. ;; -;; Visibility cycling exempts these nodes from cycling. So whenever their +;; 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 @@ -74,8 +74,7 @@ ;; ;; C-c C-x t Insert a new inline task with END line - -;;; Code +;;; Code: (require 'org) @@ -105,12 +104,28 @@ When nil, they will not be exported." (defvar org-complex-heading-regexp) (defvar org-property-end-re) -(defun org-inlinetask-insert-task () - "Insert an inline task." - (interactive) +(defcustom org-inlinetask-defaut-state nil + "Non-nil means make inline tasks have a TODO keyword initially. +This should be the state `org-inlinetask-insert-task' should use by +default, or nil of no state should be assigned." + :group 'org-inlinetask + :type '(choice + (const :tag "No state" nil) + (string :tag "Specific state"))) + +(defun org-inlinetask-insert-task (&optional no-state) + "Insert an inline task. +If prefix arg NO-STATE is set, ignore `org-inlinetask-defaut-state'." + (interactive "P") (or (bolp) (newline)) - (insert (make-string org-inlinetask-min-level ?*) " \n" - (make-string org-inlinetask-min-level ?*) " END\n") + (let ((indent org-inlinetask-min-level)) + (if org-odd-levels-only + (setq indent (- (* 2 indent) 1))) + (insert (make-string indent ?*) + (if (or no-state (not org-inlinetask-defaut-state)) + " \n" + (concat " " org-inlinetask-defaut-state " \n")) + (make-string indent ?*) " END\n")) (end-of-line -1)) (define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task) diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index 2639e303e85..3e3631ae979 100644 --- a/lisp/org/org-irc.el +++ b/lisp/org/org-irc.el @@ -4,7 +4,7 @@ ;; ;; Author: Philip Jackson <emacs@shellarchive.co.uk> ;; Keywords: erc, irc, link, org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el index 61d225e8276..de0f46d5293 100644 --- a/lisp/org/org-jsinfo.el +++ b/lisp/org/org-jsinfo.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -26,12 +26,12 @@ ;; ;;; Commentary: -;; This file implements the support for Sebastian Rose's Javascript +;; 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 +;; 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! @@ -87,7 +87,7 @@ line in the buffer. See also the variable `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. + "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 diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el index 4241fd20f7f..55444c08bbe 100644 --- a/lisp/org/org-latex.el +++ b/lisp/org/org-latex.el @@ -4,7 +4,7 @@ ;; ;; Emacs Lisp Archive Entry ;; Filename: org-latex.el -;; Version: 6.35i +;; Version: 7.01 ;; Author: Bastien Guerry <bzg AT altern DOT org> ;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Keywords: org, wp, tex @@ -144,10 +144,11 @@ 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 + [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 @@ -384,7 +385,7 @@ for example using customize, or with something like (shell-script "bash") (gnuplot "Gnuplot") (ocaml "Caml") (caml "Caml") - (sql "SQL")) + (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 @@ -399,7 +400,7 @@ hurt if it is present." (defcustom org-export-latex-remove-from-headlines '(:todo nil :priority nil :tags nil) - "A plist of keywords to remove from headlines. OBSOLETE. + "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. @@ -415,6 +416,11 @@ and `org-export-with-tags' instead." :group 'org-export-latex :type 'string) +(defcustom org-export-latex-tabular-environment "tabular" + "Default environment used to build tables." + :group 'org-export-latex + :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. @@ -426,7 +432,7 @@ allowed. The default we use here encompasses both." :type '(repeat (string :tag "Extension"))) (defcustom org-export-latex-coding-system nil - "Coding system for the exported LaTex file." + "Coding system for the exported LaTeX file." :group 'org-export-latex :type 'coding-system) @@ -580,10 +586,11 @@ 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 LaTeX as a string. 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. +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. @@ -649,7 +656,7 @@ when PUB-DIR is set, use this as the publishing directory." (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."))))) + (error "Don't know which export file to use"))))) ".tex"))) (filename (and filename @@ -792,7 +799,9 @@ when PUB-DIR is set, use this as the publishing directory." (replace-match "\n"))) (run-hooks 'org-export-latex-final-hook) - (or to-buffer (save-buffer)) + (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)) @@ -827,7 +836,7 @@ when PUB-DIR is set, use this as the publishing directory." (with-current-buffer outbuf (erase-buffer)) (message "Processing LaTeX file...") (if (and cmds (symbolp cmds)) - (funcall cmds file) + (funcall cmds (shell-quote-argument file)) (while cmds (setq cmd (pop cmds)) (while (string-match "%b" cmd) @@ -1085,7 +1094,7 @@ LEVEL indicates the default depth for export." (save-restriction (widen) (goto-char (point-min)) - (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([a-zA-Z]+\\)" nil t) + (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) @@ -1127,7 +1136,7 @@ LEVEL indicates the default depth for export." (defvar org-export-latex-format-toc-function 'org-export-latex-format-toc-default - "The function formatting returning the string to createthe table of contents. + "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) @@ -1144,7 +1153,7 @@ OPT-PLIST is the options plist for current buffer." (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 + org-export-latex-packages-alist nil (org-export-apply-macros-in-string (plist-get opt-plist :latex-header-extra))) ;; append another special variable @@ -1212,9 +1221,16 @@ If END is non-nil, it is the end of the region." :timestamps (plist-get opt-plist :timestamps) :footnotes (plist-get opt-plist :footnotes))) (org-unmodified - (let ((inhibit-read-only t)) - (add-text-properties pt (max pt (1- end)) - '(:org-license-to-kill t)))))))) + (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) + (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.") @@ -1286,7 +1302,8 @@ links, keywords, lists, tables, fixed-width" (cdr todo-markup) (car todo-markup))) (t (cdr (or (assoc (match-string 1) todo-markup) (car todo-markup)))))) - (replace-match (format fmt (match-string 1)) t t))) + (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) @@ -1323,7 +1340,7 @@ links, keywords, lists, tables, fixed-width" (unless (or ;; check for comment line (save-excursion (goto-char (match-beginning 0)) - (equal (char-after (point-at-bol)) ?#)) + (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) @@ -1469,7 +1486,9 @@ Convert CHAR depending on STRING-BEFORE and STRING-AFTER." ((and (> (length string-after) 1) (or (eq subsup t) (and (equal subsup '{}) (eq (string-to-char string-after) ?\{))) - (string-match "[({]?\\([^)}]+\\)[)}]?" 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))) @@ -1531,20 +1550,20 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "When OPT is non-nil convert fixed-width sections to LaTeX." (goto-char (point-min)) (while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t) - (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\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)))))) - + (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\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 @@ -1570,7 +1589,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (org-table-last-column-widths (copy-sequence org-table-last-column-widths)) fnum fields line lines olines gr colgropen line-fmt align - caption label attr floatp longtblp) + caption shortn label attr floatp longtblp) (if org-export-latex-tables-verbatim (let* ((tbl (concat "\\begin{verbatim}\n" raw-table "\\end{verbatim}\n"))) @@ -1579,6 +1598,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (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 @@ -1586,7 +1607,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." longtblp (and attr (stringp attr) (string-match "\\<longtable\\>" attr)) align (and attr (stringp attr) - (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr) + (string-match "\\<align=\\([^ \t\n\r]+\\)" attr) (match-string 1 attr)) floatp (or caption label)) (setq caption (and caption (org-export-latex-fontify-headline caption))) @@ -1646,13 +1667,15 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (if floatp "\\begin{table}[htb]\n")) (if floatp (format - "\\caption{%s%s}" - (if label (concat "\\\label{" label "}") "") + "\\caption%s{%s}" + (if shortn (concat "[" shortn "]") "") (or caption ""))) (if (and longtblp caption) "\\\\\n" "\n") (if (and org-export-latex-tables-centered (not longtblp)) "\\begin{center}\n") - (if (not longtblp) (concat "\\begin{tabular}{" align "}\n")) + (if (not longtblp) + (format "\\begin{%s}{%s}\n" + org-export-latex-tabular-environment align)) (orgtbl-to-latex lines `(:tstart nil :tend nil @@ -1664,7 +1687,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." \\endfoot \\endlastfoot" (length org-table-last-alignment)) nil))) - (if (not longtblp) (concat "\n\\end{tabular}")) + (if (not longtblp) + (format "\n\\end{%s}" + org-export-latex-tabular-environment)) (if longtblp "\n" (if org-export-latex-tables-centered "\n\\end{center}\n" "\n")) (if longtblp @@ -1674,10 +1699,11 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (defun org-export-latex-convert-table.el-table () "Replace table.el table at point with LaTeX code." - (let (tbl caption label line floatp attr align rmlines) + (let (tbl caption shortn label line floatp attr align rmlines) (setq line (buffer-substring (point-at-bol) (point-at-eol)) label (org-get-text-property-any 0 'org-label line) caption (org-get-text-property-any 0 'org-caption line) + shortn (org-get-text-property-any 0 'org-caption-shortn line) attr (org-get-text-property-any 0 'org-attributes line) align (and attr (stringp attr) (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr) @@ -1715,7 +1741,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (setq tbl (concat "\\begin{center}\n" tbl "\\end{center}"))) (when floatp (setq tbl (concat "\\begin{table}\n" - (format "\\caption{%s%s}\n" + (format "\\caption%s{%s%s}\n" + (if shortn (format "[%s]" shortn) "") (if label (format "\\label{%s}" label) "") (or caption "")) tbl @@ -1738,6 +1765,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (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 @@ -1814,10 +1843,11 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "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 + imgp radiop fnc ;; define the path of the link (path (cond ((member type '("coderef")) @@ -1851,7 +1881,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (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))) + (org-export-latex-format-image raw-path caption label attr shortn))) (coderefp (insert (format (org-export-get-coderef-format path desc) @@ -1871,19 +1901,28 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (setq path (org-export-latex-protect-amp path) desc (org-export-latex-protect-amp desc))) (insert (format org-export-latex-hyperref-format path desc))) + + ((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)))) + (t (insert "\\texttt{" desc "}"))))))) -(defun org-export-latex-format-image (path caption label attr) +(defun org-export-latex-format-image (path caption label attr &optional shortn) "Format the image element, depending on user settings." - (let (ind floatp wrapp placement figenv) + (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]*\\<wrap\\>" attr) (setq wrapp t floatp nil attr (replace-match "" t t attr))) (if (string-match "[ \t]*\\<float\\>" attr) - (setq wrapp nil floatp t attr (replace-match "" t t attr)))) + (setq wrapp nil floatp t attr (replace-match "" t t attr))) + (if (string-match "[ \t]*\\<multicolumn\\>" attr) + (setq multicolumnp t attr (replace-match "" t t attr)))) (setq placement (cond @@ -1905,8 +1944,13 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (wrapp "\\begin{wrapfigure}%placement \\centering \\includegraphics[%attr]{%path} -\\caption{%labelcmd%caption} +\\caption%shortn{%labelcmd%caption} \\end{wrapfigure}") + (multicolumnp "\\begin{figure*}%placement +\\centering +\\includegraphics[%attr]{%path} +\\caption{%labelcmd%caption} +\\end{figure*}") (floatp "\\begin{figure}%placement \\centering \\includegraphics[%attr]{%path} @@ -1931,6 +1975,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (expand-file-name path) path)) (cons "attr" attr) + (cons "shortn" (if shortn (format "[%s]" shortn) "")) (cons "labelcmd" (if label (format "\\label{%s}" label)"")) (cons "caption" (or caption "")) @@ -1949,7 +1994,6 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." s)) (defvar org-latex-entities) ; defined below (defvar org-latex-entities-regexp) ; defined below -(defvar org-latex-entities-exceptions) ; defined below (defun org-export-latex-preprocess (parameters) "Clean stuff in the LaTeX export." @@ -1962,7 +2006,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." ;; Preserve latex environments (goto-char (point-min)) (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\*?\\)}" nil t) - (let* ((start (progn (beginning-of-line) (point))) + (org-if-unprotected + (let* ((start (progn (beginning-of-line) (point))) (end (and (re-search-forward (concat "^[ \t]*\\\\end{" (regexp-quote (match-string 1)) @@ -1970,7 +2015,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (point-at-eol)))) (if end (add-text-properties start end '(org-protected t)) - (goto-char (point-at-eol))))) + (goto-char (point-at-eol)))))) ;; Preserve math snippets @@ -2052,25 +2097,28 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "\\(?:<[^<>\n]*>\\)*" "\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}"))) (while (re-search-forward re nil t) - (unless (or + (unless (or ;; check for comment line (save-excursion (goto-char (match-beginning 0)) - (equal (char-after (point-at-bol)) ?#)) + (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))))) + ;; 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)) - (let (a) - (while (re-search-forward org-latex-entities-regexp nil t) - (if (setq a (assoc (match-string 0) org-latex-entities-exceptions)) - (replace-match (org-add-props (nth 1 a) nil 'org-protected t) - t t) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))))) + (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)) @@ -2142,7 +2190,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (replace-match ""))))) (defun org-export-latex-fix-inputenc () - "Set the codingsystem in inputenc to what the buffer is." + "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"))) @@ -2163,13 +2211,22 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (defun org-export-latex-lists () "Convert plain text lists in current buffer into LaTeX lists." - (goto-char (point-min)) - (while (re-search-forward org-list-beginning-re nil t) - (org-if-unprotected - (beginning-of-line) - (insert (org-list-to-latex (org-list-parse-list t) - org-export-latex-list-parameters)) - "\n"))) + (let (res) + (goto-char (point-min)) + (while (org-re-search-forward-unprotected org-list-beginning-re nil t) + (beginning-of-line) + (setq res (org-list-to-latex (org-list-parse-list t) + org-export-latex-list-parameters)) + (while (string-match "^\\(\\\\item[ \t]+\\)\\[@start:\\([0-9]+\\)\\]" + res) + (setq res (replace-match + (concat (format "\\setcounter{enumi}{%d}" + (1- (string-to-number + (match-string 2 res)))) + "\n" + (match-string 1 res)) + t t res))) + (insert res "\n")))) (defconst org-latex-entities '("\\!" @@ -2276,7 +2333,6 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "\\medskip" "\\multicolumn" "\\multiput" - ("\\nbsp" "~") "\\newcommand" "\\newcounter" "\\newenvironment" @@ -2348,14 +2404,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "\\vspace") "A list of LaTeX commands to be protected when performing conversion.") -(defvar org-latex-entities-exceptions nil) - (defconst org-latex-entities-regexp (let (names rest) (dolist (x org-latex-entities) - (when (consp x) - (add-to-list 'org-latex-entities-exceptions x) - (setq x (car x))) (if (string-match "[a-zA-Z]$" x) (push x names) (push x rest))) diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 84eb78c1303..f1d6520fe51 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -7,7 +7,7 @@ ;; Bastien Guerry <bzg AT altern DOT org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -31,6 +31,8 @@ ;;; Code: +(eval-when-compile + (require 'cl)) (require 'org-macs) (require 'org-compat) @@ -84,7 +86,29 @@ heading will be exposed in a children' view." (defcustom org-list-demote-modify-bullet nil "Default bullet type installed when demoting an item. This is an association list, for each bullet type, this alist will point -to the bulled that should be used when this item is demoted." +to the bullet that should be used when this item is demoted. +For example, + + (setq org-list-demote-modify-bullet + '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\"))) + +will make + + + Movies + + Silence of the Lambs + + My Cousin Vinny + + Books + + The Hunt for Red October + + The Road to Omaha + +into + + + Movies + - Silence of the Lambs + - My Cousin Vinny + + Books + - The Hunt for Red October + - The Road to Omaha" :group 'org-plain-lists :type '(repeat (cons @@ -119,7 +143,7 @@ When a string, it will be used as a regular expression. When the bullet type of a list is changed, the new bullet type will be matched against this regexp. If it matches, there will be two spaces instead of one after the bullet in each item of he list." - :group 'org-plain-list + :group 'org-plain-lists :type '(choice (const :tag "never" nil) (regexp))) @@ -171,19 +195,19 @@ When the indentation would be larger than this, it will become % END RECEIVE ORGLST %n \\begin{comment} #+ORGLST: SEND %n org-list-to-latex -| | | +- \\end{comment}\n") (texinfo-mode "@c BEGIN RECEIVE ORGLST %n @c END RECEIVE ORGLST %n @ignore #+ORGLST: SEND %n org-list-to-texinfo -| | | +- @end ignore\n") (html-mode "<!-- BEGIN RECEIVE ORGLST %n --> <!-- END RECEIVE ORGLST %n --> <!-- #+ORGLST: SEND %n org-list-to-html -| | | +- -->\n")) "Templates for radio lists in different major modes. All occurrences of %n in a template will be replaced with the name of the @@ -197,17 +221,25 @@ list, obtained by prompting the user." ;;; Plain list items +(defun org-item-re (&optional general) + "Return the correct regular expression for plain lists. +If GENERAL is non-nil, return the general regexp independent of the value +of `org-plain-list-ordered-item-terminator'." + (cond + ((or general (eq org-plain-list-ordered-item-terminator t)) + "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + ((= org-plain-list-ordered-item-terminator ?.) + "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + ((= org-plain-list-ordered-item-terminator ?\)) + "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))) + (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" - (let ((llt org-plain-list-ordered-item-terminator)) - (save-excursion - (goto-char (point-at-bol)) - (looking-at - (cond - ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) + + (save-excursion + (goto-char (point-at-bol)) + (looking-at (org-item-re)))) (defun org-at-item-bullet-p () "Is point at the bullet of a plain list item?" @@ -216,7 +248,7 @@ list, obtained by prompting the user." (< (point) (match-end 0)))) (defun org-in-item-p () - "It the cursor inside a plain list item. + "Is the cursor inside a plain list item. Does not have to be the first line." (save-excursion (condition-case nil @@ -590,6 +622,17 @@ If the cursor is not in an item, throw an error." (goto-char pos) (error "Not in an item")))) +(defun org-end-of-item-text-before-children () + "Move to the end of the item text, stops before the first child if any. +Assumes that the cursor is in the first line of an item." + (goto-char + (min (save-excursion (org-end-of-item) (point)) + (save-excursion + (goto-char (point-at-eol)) + (if (re-search-forward (concat "^" (org-item-re t)) nil 'move) + (match-beginning 0) + (point-max)))))) + (defun org-next-item () "Move to the beginning of the next item in the current plain list. Error if not at a plain list, or if this is the last item in the list." @@ -823,6 +866,10 @@ with something like \"1.\" or \"2)\"." (setq bobp (bobp)) (looking-at "[ \t]*[0-9]+\\([.)]\\)") (setq fmt (concat "%d" (or (match-string 1) "."))) + (save-excursion + (goto-char (match-end 0)) + (if (looking-at "[ \t]*\\[@start:\\([0-9]+\\)") + (setq n (1- (string-to-number (match-string 1)))))) (beginning-of-line 0) ;; walk forward and replace these numbers (catch 'exit @@ -961,12 +1008,24 @@ I.e. to the text after the last item." (defvar org-last-indent-end-marker (make-marker)) (defun org-outdent-item (arg) - "Outdent a local list item." + "Outdent a local list item, but not its children." (interactive "p") - (org-indent-item (- arg))) + (org-indent-item-tree (- arg) 'no-subtree)) (defun org-indent-item (arg) - "Indent a local list item." + "Indent a local list item, but not its children." + (interactive "p") + (org-indent-item-tree arg 'no-subtree)) + +(defun org-outdent-item-tree (arg &optional no-subtree) + "Outdent a local list item including its children. +If NO-SUBTREE is set, only outdent the item itself, not its children." + (interactive "p") + (org-indent-item-tree (- arg) no-subtree)) + +(defun org-indent-item-tree (arg &optional no-subtree) + "Indent a local list item including its children. +If NO-SUBTREE is set, only indent the item itself, not its children." (interactive "p") (and (org-region-active-p) (org-cursor-to-region-beginning)) (unless (org-at-item-p) @@ -975,12 +1034,15 @@ I.e. to the text after the last item." (setq firstp (org-first-list-item-p)) (save-excursion (setq end (and (org-region-active-p) (region-end))) - (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) (setq beg org-last-indent-begin-marker end org-last-indent-end-marker) (org-beginning-of-item) (setq beg (move-marker org-last-indent-begin-marker (point))) - (org-end-of-item) + (if no-subtree + (org-end-of-item-text-before-children) + (org-end-of-item)) (setq end (move-marker org-last-indent-end-marker (or end (point))))) (goto-char beg) (setq ind-bul (org-item-indent-positions) @@ -1108,7 +1170,7 @@ sublevels as a list of strings." (match-beginning 0)) end)))) (item (buffer-substring (point) - (or (and (re-search-forward + (or (and (org-re-search-forward-unprotected org-list-beginning-re end t) (goto-char (match-beginning 0))) (goto-char end)))) @@ -1215,36 +1277,34 @@ this list." (save-excursion (org-list-goto-true-beginning) (beginning-of-line 0) - (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") + (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") (if maybe (throw 'exit nil) (error "Don't know how to transform this list")))) (let* ((name (match-string 1)) (transform (intern (match-string 2))) (item-beginning (org-list-item-beginning)) - (txt (buffer-substring-no-properties - (car item-beginning) - (org-list-end (cdr item-beginning)))) - (list (org-list-parse-list)) - beg) + (list (save-excursion (org-list-goto-true-beginning) + (org-list-parse-list))) + txt beg) (unless (fboundp transform) (error "No such transformation function %s" transform)) - (setq txt (funcall transform list)) - ;; Find the insertion place - (save-excursion - (goto-char (point-min)) - (unless (re-search-forward - (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t) - (error "Don't know where to insert translated list")) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (setq beg (point)) - (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) - (error "Cannot find end of insertion region")) - (beginning-of-line 1) - (delete-region beg (point)) - (goto-char beg) - (insert txt "\n")) + (let ((txt (funcall transform list))) + ;; Find the insertion place + (save-excursion + (goto-char (point-min)) + (unless (re-search-forward + (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t) + (error "Don't know where to insert translated list")) + (goto-char (match-beginning 0)) + (beginning-of-line 2) + (setq beg (point)) + (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) + (error "Cannot find end of insertion region")) + (beginning-of-line 1) + (delete-region beg (point)) + (goto-char beg) + (insert txt "\n"))) (message "List converted and installed at receiver location")))) (defun org-list-to-generic (list params) @@ -1326,7 +1386,7 @@ Valid parameters PARAMS are (defun org-list-to-latex (list &optional params) "Convert LIST into a LaTeX list. -LIST is as returnd by `org-list-parse-list'. PARAMS is a property 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 @@ -1343,7 +1403,7 @@ with overruling parameters for `org-list-to-generic'." (defun org-list-to-html (list &optional params) "Convert LIST into a HTML list. -LIST is as returnd by `org-list-parse-list'. PARAMS is a property 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 @@ -1360,7 +1420,7 @@ with overruling parameters for `org-list-to-generic'." (defun org-list-to-texinfo (list &optional params) "Convert LIST into a Texinfo list. -LIST is as returnd by `org-list-parse-list'. PARAMS is a property 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 diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el index b5b380e4072..06591703da9 100644 --- a/lisp/org/org-mac-message.el +++ b/lisp/org/org-mac-message.el @@ -5,7 +5,7 @@ ;; Author: John Wiegley <johnw@gnu.org> ;; Christopher Suckling <suckling at gmail dot com> -;; Version: 6.35i +;; Version: 7.01 ;; Keywords: outlines, hypermedia, calendar, wp ;; This file is part of GNU Emacs. @@ -39,7 +39,7 @@ ;; messages selected in Mail.app. ;; (org-mac-message-insert-flagged) searches within an org-mode buffer -;; for a specific heading, creating it if it doesn't exist. Any +;; for a specific heading, creating it if it doesn't exist. Any ;; message:// links within the first level of the heading are deleted ;; and replaced with links to flagged messages. @@ -53,7 +53,7 @@ :group 'org-link) (defcustom org-mac-mail-account "customize" - "The Mail.app account in which to search for flagged messages" + "The Mail.app account in which to search for flagged messages." :group 'org-mac-flagged-mail :type 'string) @@ -81,7 +81,7 @@ This will use the command `open' with the message URL." "open" (concat "message://<" (substring message-id 2) ">"))) (defun as-get-selected-mail () - "AppleScript to create links to selected messages in Mail.app" + "AppleScript to create links to selected messages in Mail.app." (do-applescript (concat "tell application \"Mail\"\n" @@ -97,7 +97,7 @@ This will use the command `open' with the message URL." "end tell"))) (defun as-get-flagged-mail () - "AppleScript to create links to flagged messages in Mail.app" + "AppleScript to create links to flagged messages in Mail.app." (do-applescript (concat ;; Is Growl installed? @@ -179,7 +179,7 @@ The Org-syntax text will be pushed to the kill ring, and also returned." (defun org-mac-message-insert-selected () "Insert a link to the messages currently selected in Mail.app. -This will use applescript to get the message-id and the subject of the +This will use AppleScript to get the message-id and the subject of the active mail in Mail.app and make a link out of it." (interactive) (insert (org-mac-message-get-links "s"))) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 562715fc680..abcdcdc94eb 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -43,6 +43,11 @@ "Return the value of symbol VAR if it is bound, else nil." `(and (boundp (quote ,var)) ,var)) +(defun org-not-nil (v) + "If V not nil, and also not the string \"nil\", then return V. +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." @@ -87,7 +92,7 @@ Also, do not record undo information." (defmacro org-maybe-intangible (props) "Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22. -In emacs 21, invisible text is not avoided by the command loop, so the +In Emacs 21, invisible text is not avoided by the command loop, so the intangible property is needed to make sure point skips this text. In Emacs 22, this is not necessary. The intangible text property has led to problems with flyspell. These problems are fixed in flyspell.el, @@ -162,7 +167,8 @@ We use a macro so that the test can happen at compilation time." `(let ((inhibit-read-only t)) ,@body)) (defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t - rear-nonsticky t mouse-map t fontified t) + rear-nonsticky t mouse-map t fontified t + org-emphasis t) "Properties to remove when a string without properties is wanted.") (defsubst org-match-string-no-properties (num &optional string) @@ -270,7 +276,6 @@ This is in contrast to merely setting it to 0." (setq plist (cddr plist))) p)) - (defun org-replace-match-keep-properties (newtext &optional fixedcase literal string) "Like `replace-match', but add the text properties found original text." @@ -287,7 +292,7 @@ This is in contrast to merely setting it to 0." (defvar org-inlinetask-min-level) ; defined in org-inlinetask.el (defun org-get-limited-outline-regexp () "Return outline-regexp with limited number of levels. -The number of levels is controlled by " +The number of levels is controlled by `org-inlinetask-min-level'" (if (or (not (org-mode-p)) (not (featurep 'org-inlinetask))) outline-regexp diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el index 7e9ce1e31f3..92ac2342dae 100644 --- a/lisp/org/org-mew.el +++ b/lisp/org/org-mew.el @@ -5,7 +5,7 @@ ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; This file is part of GNU Emacs. diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index dd6519475ad..91551cd828f 100644 --- a/lisp/org/org-mhe.el +++ b/lisp/org/org-mhe.el @@ -6,7 +6,7 @@ ;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-mks.el b/lisp/org/org-mks.el new file mode 100644 index 00000000000..4a567614af3 --- /dev/null +++ b/lisp/org/org-mks.el @@ -0,0 +1,137 @@ +;;; org-mks.el --- Multi-key-selection for Org-mode + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 7.01 +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;; Commentary: +;; + +;;; 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) + +;; arch-tag: 4ea90d0e-c6e4-4684-bd61-baf878712f9f + +;;; org-mks.el ends here diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index 8492280c07c..e9c1ad2bf3f 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -4,7 +4,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -33,6 +33,8 @@ (require 'org) (require 'org-agenda) +;;; Code: + (eval-when-compile (require 'cl)) (defgroup org-mobile nil @@ -66,18 +68,19 @@ org-agenda-text-search-extra-files :type 'directory) (defcustom org-mobile-use-encryption nil - "Non-nil means keep only encrypted files on the webdav server. + "Non-nil means keep only encrypted files on the WebDAV server. Encryption uses AES-256, with a password given in `org-mobile-encryption-password'. When nil, plain files are kept on the server. Turning on encryption requires to set the same password in the MobileOrg -application." +application. Before turning this on, check of MobileOrg does already +support it - at the time of this writing it did not yet." :group 'org-mobile :type 'boolean) (defcustom org-mobile-encryption-tempfile "~/orgtmpcrypt" "File that is being used as a temporary file for encryption. -This must be local file on your local machine (not on the webdav server). +This must be local file on your local machine (not on the WebDAV server). You might want to put this file into a directory where only you have access." :group 'org-mobile :type 'directory) @@ -87,7 +90,7 @@ You might want to put this file into a directory where only you have access." This is a single password which is used for AES-256 encryption. The same password must also be set in the MobileOrg application. All Org files, including mobileorg.org will be encrypted using this password. -Note that, whe Org runs the encryption commands, the password could +Note that, when Org runs the encryption commands, the password could be visible on your system with the `ps' command. So this method is only intended to keep the files secure on the server, not on your own machine." :group 'org-mobile @@ -349,15 +352,18 @@ agenda view showing the flagged items." (file-name-directory org-mobile-inbox-for-pull))) (error "Variable `org-mobile-inbox-for-pull' must point to a file in an existing directory")) + (unless (and org-mobile-checksum-binary + (string-match "\\S-" org-mobile-checksum-binary)) + (error "No executable found to compute checksums")) (when org-mobile-use-encryption (unless (string-match "\\S-" org-mobile-encryption-password) (error "To use encryption, you must set `org-mobile-encryption-password'")) (unless (file-writable-p org-mobile-encryption-tempfile) - (error "Cannot write to entryption tempfile %s" + (error "Cannot write to encryption tempfile %s" org-mobile-encryption-tempfile)) (unless (executable-find "openssl") - (error "openssl is needed to encrypt files.")))) + (error "openssl is needed to encrypt files")))) (defun org-mobile-create-index-file () "Write the index file in the WebDAV directory." @@ -898,42 +904,6 @@ FIXME: Hmmm, not sure if we can make his work against the auto-correction feature. Needs a bit more thinking. So this function is currently a noop.") - -(defun org-find-olp (path) - "Return a marker pointing to the entry at outline path OLP. -If anything goes wrong, the return value will instead an error message, -as a string." - (let* ((file (pop path)) - (buffer (find-file-noselect file)) - (level 1) - (lmin 1) - (lmax 1) - limit re end found pos heading cnt) - (unless buffer (error "File not found :%s" file)) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (setq limit (point-max)) - (goto-char (point-min)) - (while (setq heading (pop path)) - (setq re (format org-complex-heading-regexp-format - (regexp-quote heading))) - (setq cnt 0 pos (point)) - (while (re-search-forward re end t) - (setq level (- (match-end 1) (match-beginning 1))) - (if (and (>= level lmin) (<= level lmax)) - (setq found (match-beginning 0) cnt (1+ cnt)))) - (when (= cnt 0) (error "Heading not found on level %d: %s" - lmax heading)) - (when (> cnt 1) (error "Heading not unique on level %d: %s" - lmax heading)) - (goto-char found) - (setq lmin (1+ level) lmax (+ lmin (if org-odd-levels-only 1 0))) - (setq end (save-excursion (org-end-of-subtree t t)))) - (when (org-on-heading-p) - (move-marker (make-marker) (point)))))))) - (defun org-mobile-locate-entry (link) (if (string-match "\\`id:\\(.*\\)$" link) (org-id-find (match-string 1 link) 'marker) @@ -1033,7 +1003,6 @@ be returned that indicates what went wrong." t) (t (error "Body was changed in MobileOrg and on the computer"))))))) - (defun org-mobile-tags-same-p (list1 list2) "Are the two tag lists the same?" (not (or (org-delete-all list1 list2) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index d3a7dd155c8..12a7dcb85af 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -4,7 +4,7 @@ ;; ;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> ;; Maintainer: Carsten Dominik <carsten at orgmode dot org> -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -137,6 +137,8 @@ ;; ;; Versions 0.01 -- 0.07: (I don't remember) +;;; Code: + (eval-when-compile (require 'cl)) (require 'org) @@ -225,7 +227,7 @@ this function is called. Otherwise, the current major mode menu is used." (mouse-save-then-kill event))) (defun org-mouse-line-position () - "Returns `:beginning' or `:middle' or `:end', depending on the point position. + "Return `:beginning' or `:middle' or `:end', depending on the point position. If the point is at the end of the line, return `:end'. If the point is separated from the beginning of the line only by white @@ -290,7 +292,7 @@ ITEMFORMAT governs formatting of the elements of KEYWORDS. If it is a function, it is invoked with the keyword as the only argument. If it is a string, it is interpreted as the format string to (format ITEMFORMAT keyword). If it is neither a string -nor a function, elements of KEYWORDS are used directly. " +nor a function, elements of KEYWORDS are used directly." (mapcar `(lambda (keyword) (vector (cond @@ -342,8 +344,7 @@ ITEMFORMAT governs formatting of the elements of KEYWORDS. If it is a function, it is invoked with the keyword as the only argument. If it is a string, it is interpreted as the format string to (format ITEMFORMAT keyword). If it is neither a string -nor a function, elements of KEYWORDS are used directly. -" +nor a function, elements of KEYWORDS are used directly." (setq group (or group 0)) (let ((replace (org-mouse-match-closure (if nosurround 'replace-match @@ -432,7 +433,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (lambda (kwd) (equal state kwd)))))) (defun org-mouse-tag-menu () ;todo - "Create the tags menu" + "Create the tags menu." (append (let ((tags (org-get-tags))) (org-mouse-keyword-menu @@ -585,7 +586,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (org-next-item))))) (defun org-mouse-bolp () - "Returns true if there only spaces, tabs, and '*', between the beginning of line and the point" + "Return true if there only spaces, tabs, and '*' before point. +This means, between the beginning of line and the point." (save-excursion (skip-chars-backward " \t*") (bolp))) @@ -909,18 +911,18 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (setq org-mouse-context-menu-function 'org-mouse-context-menu) (when (memq 'context-menu org-mouse-features) - (define-key org-mouse-map (if (featurep 'xemacs) [button3] [mouse-3]) nil) - (define-key org-mode-map [mouse-3] 'org-mouse-show-context-menu)) - (define-key org-mode-map [down-mouse-1] 'org-mouse-down-mouse) + (org-defkey org-mouse-map [mouse-3] nil) + (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu)) + (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse) (when (memq 'context-menu org-mouse-features) - (define-key org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) - (define-key org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)) + (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) + (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)) (when (memq 'yank-link org-mouse-features) - (define-key org-mode-map [S-mouse-2] 'org-mouse-yank-link) - (define-key org-mode-map [drag-mouse-3] 'org-mouse-yank-link)) + (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link) + (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link)) (when (memq 'move-tree org-mouse-features) - (define-key org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) - (define-key org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)) + (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) + (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)) (when (memq 'activate-stars org-mouse-features) (font-lock-add-keywords @@ -1131,13 +1133,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (add-hook 'org-agenda-mode-hook '(lambda () (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) - (define-key org-agenda-mode-map - (if (featurep 'xemacs) [button3] [mouse-3]) - 'org-mouse-show-context-menu) - (define-key org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) - (define-key org-agenda-mode-map (if (featurep 'xemacs) [(control mouse-4)] [C-mouse-4]) 'org-agenda-earlier) - (define-key org-agenda-mode-map (if (featurep 'xemacs) [(control mouse-5)] [C-mouse-5]) 'org-agenda-later) - (define-key org-agenda-mode-map [drag-mouse-3] + (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) + (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) + (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) + (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) + (org-defkey org-agenda-mode-map [drag-mouse-3] '(lambda (event) (interactive "e") (case (org-mouse-get-gesture event) (:left (org-agenda-earlier 1)) @@ -1147,4 +1147,4 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ;; arch-tag: ff1ae557-3529-41a3-95c6-baaebdcc280f -;;; org-mouse.el ends-here +;;; org-mouse.el ends here diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index a0a24dcfecd..c6953f11d37 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte <schulte dot eric at gmail dot com> ;; Keywords: tables, plotting ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -44,7 +44,7 @@ '((:plot-type . 2d) (:with . lines) (:ind . 0)) - "Default options to gnuplot used by `org-plot/gnuplot'") + "Default options to gnuplot used by `org-plot/gnuplot'.") (defvar org-plot-timestamp-fmt nil) @@ -272,7 +272,7 @@ manner suitable for prepending to a user-specified script." ;; facade functions ;;;###autoload (defun org-plot/gnuplot (&optional params) - "Plot table using gnuplot. Gnuplot options can be specified with PARAMS. + "Plot table using gnuplot. Gnuplot options can be specified with PARAMS. If not given options will be taken from the +PLOT line directly before or after the table." (interactive) diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 1b32f515f79..2c6345ab817 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -9,7 +9,7 @@ ;; Author: Ross Patterson <me AT rpatterson DOT net> ;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de> ;; Keywords: org, emacsclient, wp -;; Version: 6.35i +;; Version: 7.01 ;; This file is part of GNU Emacs. ;; @@ -31,8 +31,8 @@ ;; ;; Intercept calls from emacsclient to trigger custom actions. ;; -;; This is done by advising `server-visit-files' to scann the list of filenames -;; for `org-protocol-the-protocol' and sub-procols defined in +;; This is done by advising `server-visit-files' to scan the list of filenames +;; for `org-protocol-the-protocol' and sub-protocols defined in ;; `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'. ;; ;; Any application that supports calling external programs with an URL @@ -58,7 +58,7 @@ ;; (setq org-protocol-protocol-alist ;; '(("my-protocol" ;; :protocol "my-protocol" -;; :function my-protocol-handler-fuction))) +;; :function my-protocol-handler-function))) ;; ;; A "sub-protocol" will be found in URLs like this: ;; @@ -84,15 +84,20 @@ ;; URLs to local filenames defined in `org-protocol-project-alist'. ;; ;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and -;; pushes the browsers URL to the `kill-ring' for yanking. This handler is +;; pushes the browsers URL to the `kill-ring' for yanking. This handler is ;; triggered through the sub-protocol \"store-link\". ;; -;; * Call `org-protocol-remember' by using the sub-protocol \"remember\". If -;; Org-mode is loaded, emacs will pop-up a remember buffer and fill the -;; template with the data provided. I.e. the browser's URL is inserted as an -;; Org-link of which the page title will be the description part. If text +;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If +;; Org-mode is loaded, Emacs will pop-up a capture buffer and fill the +;; template with the data provided. I.e. the browser's URL is inserted as an +;; Org-link of which the page title will be the description part. If text ;; was select in the browser, that text will be the body of the entry. ;; +;; * 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: ;; @@ -101,7 +106,7 @@ ;; encodeURIComponent(document.title)+'/'+ ;; encodeURIComponent(window.getSelection()) ;; -;; The handler for the sub-protocol \"remember\" detects an optional template +;; The handler for the sub-protocol \"capture\" detects an optional template ;; char that, if present, triggers the use of a special template. ;; Example: ;; @@ -121,8 +126,6 @@ (eval-when-compile (require 'cl)) -(declare-function org-publish-initialize-files-alist "org-publish" - (&optional refresh)) (declare-function org-publish-get-project-from-filename "org-publish" (filename &optional up)) (declare-function server-edit "server" (&optional arg)) @@ -143,6 +146,7 @@ for `org-protocol-the-protocol' and sub-procols defined in (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-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. @@ -151,18 +155,19 @@ See `org-protocol-protocol-alist' for a description of this variable.") (defconst org-protocol-the-protocol "org-protocol" "This is the protocol to detect if org-protocol.el is loaded. -`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold the -sub-protocols that trigger the required action. You will have to define just one -protocol handler OS-wide (MS-Windows) or per application (Linux). That protocol -handler should call emacsclient.") +`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold +the sub-protocols that trigger the required action. You will have to define +just one protocol handler OS-wide (MS-Windows) or per application (Linux). +That protocol handler should call emacsclient.") ;;; User variables: (defcustom org-protocol-reverse-list-of-files t - "* The filenames passed on the commandline are passed to the emacs-server in -reversed order. Set to `t' (default) to re-reverse the list, i.e. use the -sequence on the command line. If nil, the sequence of the filenames is + "* Non-nil means re-reverse the list of filenames passed on the command line. +The filenames passed on the command line are passed to the emacs-server in +reverse order. Set to t (default) to re-reverse the list, i.e. use the +sequence on the command line. If nil, the sequence of the filenames is unchanged." :group 'org-protocol :type 'boolean) @@ -225,7 +230,7 @@ protocol - protocol to detect in a filename without trailing colon and slashes. If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol' will search filenames for \"org-protocol:/my-protocol:/\" and trigger your action for every match. `org-protocol' is defined in - `org-protocol-the-protocol'. Double and tripple slashes are compressed + `org-protocol-the-protocol'. Double and triple slashes are compressed to one by emacsclient. function - function that handles requests with protocol and takes exactly one @@ -239,7 +244,7 @@ function - function that handles requests with protocol and takes exactly one kill-client - If t, kill the client immediately, once the sub-protocol is detected. This is necessary for actions that can be interrupted by - `C-g' to avoid dangeling emacsclients. Note, that all other command + `C-g' to avoid dangling emacsclients. Note, that all other command line arguments but the this one will be discarded, greedy handlers still receive the whole list of arguments though. @@ -248,10 +253,10 @@ Here is an example: (setq org-protocol-protocol-alist '((\"my-protocol\" :protocol \"my-protocol\" - :function my-protocol-handler-fuction) + :function my-protocol-handler-function) (\"your-protocol\" :protocol \"your-protocol\" - :function your-protocol-handler-fuction)))" + :function your-protocol-handler-function)))" :group 'org-protocol :type '(alist)) @@ -260,11 +265,10 @@ Here is an example: :group 'org-protocol :type 'string) - ;;; Helper functions: (defun org-protocol-sanitize-uri (uri) - "emacsclient compresses double and tripple slashes. + "emacsclient compresses double and triple slashes. Slashes are sanitized to double slashes here." (when (string-match "^\\([a-z]+\\):/" uri) (let* ((splitparts (split-string uri "/+"))) @@ -273,12 +277,13 @@ Slashes are sanitized to double slashes here." (defun org-protocol-split-data(data &optional unhexify separator) - "Split, what a org-protocol handler function gets as only argument. -data is that one argument. Data is splitted at each occurrence of separator - (regexp). If no separator is specified or separator is nil, assume \"/+\". -The results of that splitting are return as a list. If unhexify is non-nil, -hex-decode each split part. If unhexify is a function, use that function to -decode each split part." + "Split, what an org-protocol handler function gets as only argument. +DATA is that one argument. DATA is split at each occurrence of +SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is +nil, assume \"/+\". The results of that splitting are returned +as a list. If UNHEXIFY is non-nil, hex-decode each split part. If +UNHEXIFY is a function, use that function to decode each split +part." (let* ((sep (or separator "/+")) (split-parts (split-string data sep))) (if unhexify @@ -316,7 +321,7 @@ encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ĂĽ'." (defun org-protocol-unhex-compound (hex) - "Unhexify unicode hex-chars. E.g. `%C3%B6' is the german Umlaut `ĂĽ'." + "Unhexify unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ĂĽ'." (let* ((bytes (remove "" (split-string hex "%"))) (ret "") (eat 0) @@ -412,9 +417,9 @@ This function transforms it into a flat list." ;;; Standard protocol handlers: (defun org-protocol-store-link (fname) - "Process an org-protocol://store-link:// style url -and store a browser URL as an org link. Also pushes the links URL to the -`kill-ring'. + "Process an org-protocol://store-link:// style url. +Additionally store a browser URL as an org link. Also pushes the +link's URL to the `kill-ring'. The location for a browser's bookmark has to look like this: @@ -443,51 +448,75 @@ The sub-protocol used to reach this function is set in (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) + (or (fboundp 'org-capture)) + (org-protocol-do-capture info 'org-remember)) + (message "Org-mode not loaded.")) + 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: - javascript:location.href='org-protocol://remember://'+ \\ + javascript:location.href='org-protocol://capture://'+ \\ encodeURIComponent(location.href)+'/' \\ encodeURIComponent(document.title)+'/'+ \\ encodeURIComponent(window.getSelection()) By default, it uses the character `org-protocol-default-template-key', -which should be associated with a template in `org-remember-templates'. +which should be associated with a template in `org-capture-templates'. But you may prepend the encoded URL with a character and a slash like so: - javascript:location.href='org-protocol://org-store-link://b/'+ ... + javascript:location.href='org-protocol://capture://b/'+ ... Now template ?b will be used." - (if (and (boundp 'org-stored-links) - (fboundp 'org-remember)) - (let* ((parts (org-protocol-split-data info t)) - (template (or (and (= 1 (length (car parts))) (pop parts)) - org-protocol-default-template-key)) - (url (org-protocol-sanitize-uri (car parts))) - (type (if (string-match "^\\([a-z]+\\):" url) - (match-string 1 url))) - (title (or (cadr parts) "")) - (region (or (caddr parts) "")) - (orglink (org-make-link-string - url (if (string-match "[^[:space:]]" title) title url))) - remember-annotation-functions) - (setq org-stored-links - (cons (list url title) org-stored-links)) - (kill-new orglink) - (org-store-link-props :type type - :link url - :description title - :initial region) - (raise-frame) - (org-remember nil (string-to-char template))) - - (message "Org-mode not loaded.")) + (or (fboundp 'org-capture)) + (org-protocol-do-capture info 'org-capture)) + (message "Org-mode not loaded.")) 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'." + (let* ((parts (org-protocol-split-data info t)) + (template (or (and (= 1 (length (car parts))) (pop parts)) + org-protocol-default-template-key)) + (url (org-protocol-sanitize-uri (car parts))) + (type (if (string-match "^\\([a-z]+\\):" url) + (match-string 1 url))) + (title(or (cadr parts) "")) + (region (or (caddr parts) "")) + (orglink (org-make-link-string + url (if (string-match "[^[:space:]]" title) title url))) + (org-capture-link-is-already-stored t) ;; avoid call to org-store-link + remember-annotation-functions) + (setq org-stored-links + (cons (list url title) org-stored-links)) + (kill-new orglink) + (org-store-link-props :type type + :link url + :description title + :annotation orglink + :initial region) + (raise-frame) + (funcall capture-func nil template))) + + (defun org-protocol-open-source (fname) "Process an org-protocol://open-source:// style url. @@ -561,7 +590,7 @@ This is, how the matching is done: protocol and sub-protocol are regexp-quoted. -If a matching protcol is found, the protcol is stripped from fname and the +If a matching protocol is found, the protocol is stripped from fname and the result is passed to the protocols function as the only parameter. If the function returns nil, the filename is removed from the list of filenames passed from emacsclient to the server. @@ -614,11 +643,10 @@ 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 functions calls `org-protocol-create' to do +`org-publish-project-alist'. This function calls `org-protocol-create' to do most of the work." (interactive) (require 'org-publish) - (org-publish-initialize-files-alist) (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) (if all (org-protocol-create (cdr all)) (message "Not in an org-project. Did mean %s?" diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el index 79655235505..943bbca6b7b 100644 --- a/lisp/org/org-publish.el +++ b/lisp/org/org-publish.el @@ -5,7 +5,7 @@ ;; Author: David O'Toole <dto@gnu.org> ;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com> ;; Keywords: hypermedia, outlines, wp -;; Version: 6.35i +;; Version: 7.01 ;; This file is part of GNU Emacs. ;; @@ -174,12 +174,26 @@ sitemap of files or summary page for a given project. of the titles of the files involved) or `tree' (the directory structure of the source files is reflected in the sitemap). Defaults to - `tree'." + `tree'. + + 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-alphabetically The site map is normally sorted alphabetically. + Set this explicitly to nil to turn off sorting. + :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." :group 'org-publish :type 'alist) (defcustom org-publish-use-timestamps-flag t - "When non-nil, use timestamp checking to publish only changed files. + "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) @@ -208,6 +222,34 @@ Any changes made by this hook will be saved." :group 'org-publish :type 'hook) +(defcustom org-publish-sitemap-sort-alphabetically t + "Should sitemaps be sorted alphabetically by default? + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-alphabetically'." + :group 'org-publish + :type 'boolean) + +(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 + :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 + :type 'boolean) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Timestamp-related functions @@ -215,29 +257,19 @@ Any changes made by this hook will be saved." "Return path to timestamp file for filename FILENAME." (setq filename (concat filename "::" (or pub-dir "") "::" (format "%s" (or pub-func "")))) - (concat (file-name-as-directory org-publish-timestamp-directory) - "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) + (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) (defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir) - "Return `t' if FILENAME should be published in PUB-DIR using PUB-FUNC. -TRUE-PUB-DIR is there the file will truely end up. Currently we are not using + "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 ow 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 - (if (file-exists-p org-publish-timestamp-directory) - ;; first handle possible wrong timestamp directory - (if (not (file-directory-p org-publish-timestamp-directory)) - (error "Org publish timestamp: %s is not a directory" - org-publish-timestamp-directory) - ;; there is a timestamp, check if FILENAME is newer - (file-newer-than-file-p - filename (org-publish-timestamp-filename - filename pub-dir pub-func))) - (make-directory org-publish-timestamp-directory) - t) + (org-publish-cache-file-needs-publishing + filename pub-dir pub-func) ;; don't use timestamps, always return t t))) (if rtn @@ -249,55 +281,33 @@ function can still decide about that independently." (defun org-publish-update-timestamp (filename &optional pub-dir pub-func) "Update publishing timestamp for file FILENAME. If there is no timestamp, create one." - (let ((timestamp-file (org-publish-timestamp-filename - filename pub-dir pub-func)) - newly-created-timestamp) - (if (not (file-exists-p timestamp-file)) - ;; create timestamp file if needed - (with-temp-buffer - (make-directory (file-name-directory timestamp-file) t) - (write-file timestamp-file) - (setq newly-created-timestamp t))) - ;; Emacs 21 doesn't have `set-file-times' - (if (and (fboundp 'set-file-times) - (not newly-created-timestamp)) - (set-file-times timestamp-file) - (call-process "touch" nil 0 nil (expand-file-name timestamp-file))))) + (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 timstamp directory." + "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 "[^.]\\'"))))) + (mapc 'delete-file (directory-files dir 'full "[^.]\\'")) + (org-publish-reset-cache)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Mapping files to project names - -(defvar org-publish-files-alist nil - "Alist of files and their parent projects. -Each element of this alist is of the form: - - (file-name . project-name)") +;;; (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.") -(defun org-publish-initialize-files-alist (&optional refresh) - "Set `org-publish-files-alist' if it is not set. -Also set it if the optional argument REFRESH is non-nil." - (interactive "P") - (when (or refresh (not org-publish-files-alist)) - (setq org-publish-files-alist - (org-publish-get-files org-publish-project-alist)))) +;; 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.") -(defun org-publish-validate-link (link &optional directory) - "Check if LINK points to a file in the current project." - (assoc (expand-file-name link directory) org-publish-files-alist)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Compatibility aliases @@ -325,23 +335,6 @@ This is a compatibility function for Emacsen without `delete-dups'." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Getting project information out of org-publish-project-alist -(defun org-publish-get-files (projects-alist &optional no-exclusion) - "Return the list of all publishable files for PROJECTS-ALIST. -If NO-EXCLUSION is non-nil, don't exclude files." - (let (all-files) - ;; add all projects - (mapc - (lambda(p) - (let* ((exclude (plist-get (cdr p) :exclude)) - (files (and p (org-publish-get-base-files p exclude)))) - ;; add all files from this project - (mapc (lambda(f) - (add-to-list 'all-files - (cons (expand-file-name f) (car p)))) - files))) - (org-publish-expand-projects projects-alist)) - all-files)) - (defun org-publish-expand-projects (projects-alist) "Expand projects in PROJECTS-ALIST. This splices all the components into the list." @@ -355,6 +348,42 @@ This splices all the components into the list." (push p rtn))) (nreverse (org-publish-delete-dups (delq nil rtn))))) + +(defvar sitemap-alphabetically) +(defvar sitemap-sort-folders) +(defvar sitemap-ignore-case) +(defvar sitemap-requested) +(defun org-publish-compare-directory-files (a b) + "Predicate for `sort', that sorts folders-first/last and alphabetically." + (let ((retval t)) + (when (or sitemap-alphabetically sitemap-sort-folders) + ;; First we sort alphabetically: + (when sitemap-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 sitemap-ignore-case + (not (string-lessp (upcase B) (upcase A))) + (not (string-lessp B A)))))) + + ;; Directory-wise wins: + (when sitemap-sort-folders + ;; a is directory, b not: + (cond + ((and (file-directory-p a) (not (file-directory-p b))) + (setq retval (equal 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 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 @@ -373,8 +402,12 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR." (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))))) - (directory-files base-dir t (unless recurse match)))) + (if 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. @@ -386,9 +419,29 @@ matching filenames." (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: + (sitemap-requested + (plist-get project-plist :auto-sitemap)) + (sitemap-sort-folders + (if (plist-member project-plist :sitemap-sort-folders) + (plist-get project-plist :sitemap-sort-folders) + org-publish-sitemap-sort-folders)) + (sitemap-alphabetically + (if (plist-member project-plist :sitemap-alphabetically) + (plist-get project-plist :sitemap-alphabetically) + org-publish-sitemap-sort-alphabetically)) + (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 sitemap-sort-folders' has an accepted value + (unless (memq sitemap-sort-folders '(first last)) + (setq sitemap-sort-folders nil)) + (setq org-publish-temp-files nil) (org-publish-get-base-files-1 base-dir recurse match ;; FIXME distinguish exclude regexp @@ -402,9 +455,27 @@ matching filenames." org-publish-temp-files)) (defun org-publish-get-project-from-filename (filename &optional up) - "Return the project FILENAME belongs." - (let* ((project-name (cdr (assoc (expand-file-name filename) - org-publish-files-alist)))) + "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 (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 (string-match i filename)) + (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)) @@ -502,20 +573,17 @@ See `org-publish-org-to' to the list of arguments." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Publishing files, sets of files, and indices -(defun org-publish-file (filename &optional project) - "Publish file FILENAME from PROJECT." +(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) - (if (y-or-n-p - (format "%s is not in a project. Re-read the list of projects files? " - (abbreviate-file-name filename))) - ;; If requested, re-initialize the list of projects files - (progn (org-publish-initialize-files-alist t) - (or (org-publish-get-project-from-filename filename) - (error "File %s not part of any known project" - (abbreviate-file-name filename)))) - (error "Can't publish file outside of a project"))))) + (error "File %s not part of any known project" + (abbreviate-file-name filename))))) (project-plist (cdr project)) (ftname (file-truename filename)) (publishing-function @@ -526,6 +594,10 @@ See `org-publish-org-to' to the list of arguments." (pub-dir (file-name-as-directory (file-truename (plist-get project-plist :publishing-directory)))) tmp-pub-dir) + + (unless no-cache + (org-publish-initialize-cache (car project))) + (setq tmp-pub-dir (file-name-directory (concat pub-dir @@ -542,7 +614,8 @@ See `org-publish-org-to' to the list of arguments." tmp-pub-dir) (funcall publishing-function project-plist filename tmp-pub-dir) (org-publish-update-timestamp - filename pub-dir publishing-function))))) + filename pub-dir publishing-function))) + (unless no-cache (org-publish-write-cache-file)))) (defun org-publish-projects (projects) "Publish all files belonging to the PROJECTS alist. @@ -550,6 +623,8 @@ 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 it's own cache file: + (org-publish-initialize-cache (car project)) (let* ((project-plist (cdr project)) (exclude-regexp (plist-get project-plist :exclude)) @@ -564,19 +639,20 @@ If :makeindex is set, also produce a file theindex.org." (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)) + (org-publish-file file project t)) (when (plist-get project-plist :makeindex) (org-publish-index-generate-theindex.inc (plist-get project-plist :base-directory)) (org-publish-file (expand-file-name "theindex.org" (plist-get project-plist :base-directory)) - project)) - (when completion-function (run-hooks 'completion-function)))) + 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 an sitemap of pages in set defined by PROJECT. + "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)) @@ -639,8 +715,10 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (or visiting (kill-buffer sitemap-buffer)))) (defun org-publish-find-title (file) - "Find the title of file in project." - (let* ((visiting (find-buffer-visiting file)) + "Find the title of FILE in project." + (or + (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 @@ -654,7 +732,8 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (file-name-nondirectory (file-name-sans-extension file)))))) (unless visiting (kill-buffer buffer)) - title)) + (org-publish-cache-set-file-property file :title title) + title))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Interactive publishing functions @@ -676,7 +755,12 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (save-window-excursion (let* ((org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects (list project))))) + (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) @@ -686,7 +770,7 @@ directory and force publishing all files." (interactive "P") (when force (org-publish-remove-all-timestamps)) - (org-publish-initialize-files-alist force) + ;; (org-publish-initialize-files-alist force) (save-window-excursion (let ((org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag))) @@ -698,7 +782,6 @@ directory and force publishing all files." "Publish the current file. With prefix argument, force publish the file." (interactive "P") - (org-publish-initialize-files-alist force) (save-window-excursion (let ((org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag))) @@ -710,13 +793,13 @@ With prefix argument, force publish the file." With a prefix argument, force publishing of all files in the project." (interactive "P") - (org-publish-initialize-files-alist force) (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)))) @@ -736,11 +819,11 @@ the project." (when (eq backend 'latex) (replace-match (format "\\index{%s}" entry) t t)) (save-excursion - (org-back-to-heading t) + (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)) + target "")) (push (cons entry target) index))) (with-temp-file (concat (file-name-sans-extension org-current-export-file) ".orgx") @@ -760,7 +843,7 @@ the project." full-files)) (default-directory directory) index origfile buf target entry ibuffer - main last-main letter last-letter file sub link) + main last-main letter last-letter file sub link tgext) ;; `files' contains the list of relative file names (dolist (file files) (setq origfile (substring file 0 -1)) @@ -781,6 +864,9 @@ the project." (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") @@ -792,7 +878,7 @@ the project." (when (and main (not (equal main last-main))) (insert " - " main "\n") (setq last-main main)) - (setq link (concat "[[file:" file "::#" target "]" + (setq link (concat "[[file:" file tgext "]" "[" (or sub entry) "]]")) (if (and main sub) (insert " - " link "\n") @@ -809,8 +895,143 @@ the project." (save-buffer)) (kill-buffer ibuffer))))) -(provide 'org-publish) +;; Caching functions: + +(defun org-publish-write-cache-file (&optional free-cache) + "Write `org-publish-cache' to file. +If FREE-CACHE, empty the cache." + (unless org-publish-cache + (error "%s" "`org-publish-write-cache-file' called, but no cache present")) + + (let ((cache-file (org-publish-cache-get ":cache-file:"))) + (unless cache-file + (error + "%s" "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." + + (unless project-name + (error "%s%s" "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) + "Check the timestamp of the last publishing of FILENAME. +Return `t', if the file needs publishing" + (unless org-publish-cache + (error "%s" "`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))) + (if (null pstamp) + t + (let ((ctime (org-publish-cache-ctime-of-src filename))) + (< pstamp 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." + (unless org-publish-cache + (error "%s" "`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." + (unless org-publish-cache + (error "%s" "`org-publish-cache-set' called, but no cache present")) + (puthash key value org-publish-cache)) + +(defun org-publish-cache-ctime-of-src (filename) + "Get the files ctime as integer." + (let ((src-attr (file-attributes filename))) + (+ + (lsh (car (nth 5 src-attr)) 16) + (cadr (nth 5 src-attr))))) + + + +(provide 'org-publish) ;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el index a20539dd85a..d8252b65c3d 100644 --- a/lisp/org/org-remember.el +++ b/lisp/org/org-remember.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -54,14 +54,15 @@ :group 'org) (defcustom org-remember-store-without-prompt t - "Non-nil means `C-c C-c' stores remember note without further prompts. + "Non-nil means \\<org-remember-mode-map>\\[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 -`C-u C-c C-c' to file the note. +\\[universal-argument] \\[org-remember-finalize] to file the note. -When this variable is nil, `C-c C-c' gives you the prompts, and -`C-u C-c C-c' triggers the fasttrack." +When this variable is nil, \\[org-remember-finalize] gives you the prompts, and +\\[universal-argument] \\[org-remember-finalize] triggers the fasttrack." :group 'org-remember :type 'boolean) @@ -94,10 +95,10 @@ You can set this on a per-template basis with the variable (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 5-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. +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 @@ -114,41 +115,44 @@ 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 be always be added +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 ca be specified like this: + %^{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 + You may define a prompt like %^{Please specify birthday}t %n user name (taken from `user-full-name') - %a annotation, normally the link created with org-store-link - %i initial content, copied from the active region. If %i is - indented, the entire inserted text will be indented as well. %c current kill ring head %x content of the X clipboard - %^C Interactive selection of which kill or clip to use - %^L Like %^C, but insert as link - %k title of currently clocked task - %K link to currently clocked task - %^g prompt for tags, with completion on tags in target file - %^G prompt for tags, with completion all tags in all agenda files - %^{prop}p Prompt the user for a value for property `prop' %:keyword specific information for certain link types, see below - %[pathname] insert the contents of the file given by `pathname' - %(sexp) evaluate elisp `(sexp)' and replace with the result - %! Store this note immediately after filling the template - %& Visit note immediately after storing it - - %? After completing the template, position cursor here. + %^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\ + \\<org-remember-mode-map> + (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 @@ -211,7 +215,7 @@ The remember buffer is still current when this hook runs." :type 'hook) (defvar org-remember-mode-map (make-sparse-keymap) - "Keymap for org-remember-mode, a minor mode. + "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 @@ -229,7 +233,7 @@ for a 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. " +user each time a remember buffer with a running clock is filed away." :group 'org-remember :type '(choice (const :tag "Never" nil) @@ -265,7 +269,7 @@ 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 +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) @@ -388,12 +392,6 @@ RET at beg-of-buf -> Append to file as level 2 headline char0)))))) (cddr (assoc char templates))))) -(defun org-get-x-clipboard (value) - "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21." - (if (eq window-system 'x) - (let ((x (org-get-x-clipboard-compat value))) - (if x (org-no-properties x))))) - ;;;###autoload (defun org-remember-apply-template (&optional use-char skip-interactive) "Initialize *remember* buffer with template, invoke `org-mode'. @@ -727,9 +725,11 @@ from that hook." If there is an active region, make sure remember uses it as initial content of the remember buffer. -When called interactively with a `C-u' prefix argument GOTO, don't remember +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 arg `C-u C-u', go to the last +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 @@ -801,21 +801,24 @@ The user is queried for the template." 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'. - +\\<org-remember-mode-map> If no defaults have been defined, or if the current prefix argument -is 1 (so you must use `C-1 C-c C-c' to exit remember), an interactive +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 C-c C-c'), +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 C-c C-c'), +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 `C-u' 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). +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 diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el index 28e991f0214..4ddfadaafa5 100644 --- a/lisp/org/org-rmail.el +++ b/lisp/org/org-rmail.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 395c592e696..453f3b0b534 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -8,7 +8,7 @@ ;; Dan Davison <davison at stats dot ox dot ac dot uk> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -63,7 +63,7 @@ there are kept outside the narrowed region." "The default coderef format. This format string will be used to search for coderef labels in literal examples (EXAMPLE and SRC blocks). The format can be overwritten in -an individual literal example with the -f option, like +an individual literal example with the -l option, like #+BEGIN_SRC pascal +n -r -l \"((%s))\" ... @@ -87,10 +87,11 @@ These are the regions where each line starts with a colon." (function :tag "Other (specify)"))) (defcustom org-src-preserve-indentation nil - "If non-nil, leading whitespace characters in source code -blocks are preserved on export, and when switching between the -org buffer and the language mode edit buffer. If this variable -is nil then, after editing with \\[org-edit-src-code], the + "If non-nil preserve leading whitespace characters on export. +If non-nil leading whitespace characters in source code blocks +are preserved on export, and when switching between the org +buffer and the language mode edit buffer. If this variable is nil +then, after editing with \\[org-edit-src-code], the minimum (across-lines) number of leading whitespace characters are removed from all lines, and the code block is uniformly indented according to the value of `org-edit-src-content-indentation'." @@ -101,7 +102,7 @@ indented according to the value of `org-edit-src-content-indentation'." "Indentation for the content of a source code block. This should be the number of spaces added to the indentation of the #+begin line in order to compute the indentation of the block content after -editing it with \\[org-edit-src-code]. Has no effect if +editing it with \\[org-edit-src-code]. Has no effect if `org-src-preserve-indentation' is non-nil." :group 'org-edit-structure :type 'integer) @@ -146,7 +147,7 @@ but which mess up the display of a snippet in Org exported files.") (defcustom org-src-lang-modes '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) - ("asymptote" . asy) ("dot" . fundamental)) + ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)) "Alist mapping languages to their major mode. The key is the language name, the value is the string that should be inserted as the name of the major mode. For many languages this is @@ -166,6 +167,7 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) (defvar org-edit-src-force-single-line nil) (defvar org-edit-src-from-org-mode nil) +(defvar org-edit-src-allow-write-back-p t) (defvar org-edit-src-picture nil) (defvar org-edit-src-beg-marker nil) (defvar org-edit-src-end-marker nil) @@ -187,7 +189,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'") -(defun org-edit-src-code (&optional context) +(defun org-edit-src-code (&optional context code edit-buffer-name) "Edit the source code example at point. The example is copied to a separate buffer, and that buffer is switched to the correct language mode. When done, exit with \\[org-edit-src-exit]. @@ -200,19 +202,22 @@ the edited version. Optional argument CONTEXT is used by (let ((line (org-current-line)) (col (current-column)) (case-fold-search t) - (msg (substitute-command-keys - "Edit, then exit with C-c ' (C-c and single quote)")) (info (org-edit-src-find-region-and-lang)) (org-mode-p (eq major-mode 'org-mode)) (beg (make-marker)) (end (make-marker)) (preserve-indentation org-src-preserve-indentation) - block-nindent total-nindent ovl lang lang-f single lfmt code begline buffer) + (allow-write-back-p (null code)) + block-nindent total-nindent ovl lang lang-f single lfmt begline buffer msg) (if (not info) nil (setq beg (move-marker beg (nth 0 info)) end (move-marker end (nth 1 info)) - code (buffer-substring-no-properties beg end) + 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)") + code (or code (buffer-substring-no-properties beg end)) lang (or (cdr (assoc (nth 2 info) org-src-lang-modes)) (nth 2 info)) lang (if (symbolp lang) (symbol-name lang) lang) @@ -238,20 +243,21 @@ the edited version. Optional argument CONTEXT is used by (when buffer (with-current-buffer buffer (if (boundp 'org-edit-src-overlay) - (org-delete-overlay org-edit-src-overlay))) + (delete-overlay org-edit-src-overlay))) (kill-buffer buffer)) (setq buffer (generate-new-buffer - (org-src-construct-edit-buffer-name (buffer-name) lang))) - (setq ovl (org-make-overlay beg end)) - (org-overlay-put ovl 'edit-buffer buffer) - (org-overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") - (org-overlay-put ovl 'face 'secondary-selection) - (org-overlay-put ovl - 'keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'org-edit-src-continue) - map)) - (org-overlay-put ovl :read-only "Leave me alone") + (or edit-buffer-name + (org-src-construct-edit-buffer-name (buffer-name) lang)))) + (setq ovl (make-overlay beg end)) + (overlay-put ovl 'edit-buffer buffer) + (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") + (overlay-put ovl 'face 'secondary-selection) + (overlay-put ovl + 'keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'org-edit-src-continue) + map)) + (overlay-put ovl :read-only "Leave me alone") (org-src-switch-to-buffer buffer 'edit) (if (eq single 'macro-definition) (setq code (replace-regexp-in-string "\\\\n" "\n" code t t))) @@ -264,6 +270,7 @@ the edited version. Optional argument CONTEXT is used by (funcall lang-f)) (set (make-local-variable 'org-edit-src-force-single-line) single) (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) + (set (make-local-variable 'org-edit-src-allow-write-back-p) allow-write-back-p) (set (make-local-variable 'org-src-preserve-indentation) preserve-indentation) (when lfmt (set (make-local-variable 'org-coderef-label-format) lfmt)) @@ -320,7 +327,7 @@ the edited version. Optional argument CONTEXT is used by (switch-to-buffer buffer)))) (defun org-src-construct-edit-buffer-name (org-buffer-name lang) - "Construct the buffer name for a source editing buffer" + "Construct the buffer name for a source editing buffer." (concat "*Org Src " org-buffer-name "[ " lang " ]*")) (defun org-edit-src-find-buffer (beg end) @@ -381,22 +388,22 @@ the fragment in the Org-mode buffer." (when buffer (with-current-buffer buffer (if (boundp 'org-edit-src-overlay) - (org-delete-overlay org-edit-src-overlay))) + (delete-overlay org-edit-src-overlay))) (kill-buffer buffer)) (setq buffer (generate-new-buffer (org-src-construct-edit-buffer-name (buffer-name) "Fixed Width"))) - (setq ovl (org-make-overlay beg end)) - (org-overlay-put ovl 'face 'secondary-selection) - (org-overlay-put ovl 'edit-buffer buffer) - (org-overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") - (org-overlay-put ovl 'face 'secondary-selection) - (org-overlay-put ovl + (setq ovl (make-overlay beg end)) + (overlay-put ovl 'face 'secondary-selection) + (overlay-put ovl 'edit-buffer buffer) + (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") + (overlay-put ovl 'face 'secondary-selection) + (overlay-put ovl 'keymap (let ((map (make-sparse-keymap))) (define-key map [mouse-1] 'org-edit-src-continue) map)) - (org-overlay-put ovl :read-only "Leave me alone") + (overlay-put ovl :read-only "Leave me alone") (switch-to-buffer buffer) (insert code) (remove-text-properties (point-min) (point-max) @@ -406,7 +413,7 @@ the fragment in the Org-mode buffer." ((eq org-edit-fixed-width-region-mode 'artist-mode) (fundamental-mode) (artist-mode 1)) - (t (funcall org-edit-fixed-width-region-mode))) + (t (funcall org-edit-fixed-width-region-mode))) (set (make-local-variable 'org-edit-src-force-single-line) nil) (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) (set (make-local-variable 'org-edit-src-picture) t) @@ -459,15 +466,6 @@ the language, a switch telling if the content should be in a single line." (pos (point)) re1 re2 single beg end lang lfmt match-re1 ind entry) (catch 'exit - (when (org-at-table.el-p) - (re-search-backward "^[\t]*[^ \t|\\+]" nil t) - (setq beg (1+ (point-at-eol))) - (goto-char beg) - (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t) - (progn (goto-char (point-max)) (newline))) - (setq end (point-at-bol)) - (setq ind (org-edit-src-get-indentation beg)) - (throw 'exit (list beg end 'table.el nil nil ind))) (while (setq entry (pop re-list)) (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry) single (nth 3 entry)) @@ -498,7 +496,16 @@ the language, a switch telling if the content should be in a single line." (throw 'exit (list (match-end 0) end (org-edit-src-get-lang lang) - single lfmt ind)))))))))))) + single lfmt ind))))))))) + (when (org-at-table.el-p) + (re-search-backward "^[\t]*[^ \t|\\+]" nil t) + (setq beg (1+ (point-at-eol))) + (goto-char beg) + (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t) + (progn (goto-char (point-max)) (newline))) + (setq end (point-at-bol)) + (setq ind (org-edit-src-get-indentation beg)) + (throw 'exit (list beg end 'table.el nil nil ind)))))) (defun org-edit-src-get-lang (lang) "Extract the src language." @@ -521,7 +528,7 @@ the language, a switch telling if the content should be in a single line." (match-string 1 s)))) (defun org-edit-src-get-indentation (pos) - "Count leading whitespace characters on line" + "Count leading whitespace characters on line." (save-match-data (goto-char pos) (org-get-indentation))) @@ -529,8 +536,8 @@ the language, a switch telling if the content should be in a single line." (defun org-edit-src-exit (&optional context) "Exit special edit and protect problematic lines." (interactive) - (unless org-edit-src-from-org-mode - (error "This is not a sub-editing buffer, something is wrong...")) + (unless (org-bound-and-true-p org-edit-src-from-org-mode) + (error "This is not a sub-editing buffer, something is wrong")) (widen) (let* ((beg org-edit-src-beg-marker) (end org-edit-src-end-marker) @@ -541,61 +548,65 @@ the language, a switch telling if the content should be in a single line." (total-nindent (+ (or org-edit-src-block-indentation 0) org-edit-src-content-indentation)) (preserve-indentation org-src-preserve-indentation) + (allow-write-back-p (org-bound-and-true-p org-edit-src-allow-write-back-p)) (delta 0) code line col indent) - (unless preserve-indentation (untabify (point-min) (point-max))) - (save-excursion - (goto-char (point-min)) - (if (looking-at "[ \t\n]*\n") (replace-match "")) - (unless macro - (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")))) + (when allow-write-back-p + (unless preserve-indentation (untabify (point-min) (point-max))) + (save-excursion + (goto-char (point-min)) + (if (looking-at "[ \t\n]*\n") (replace-match "")) + (unless macro + (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))))) (setq line (if (org-bound-and-true-p org-edit-src-force-single-line) 1 (org-current-line)) col (current-column)) - (when single - (goto-char (point-min)) - (if (re-search-forward "\\s-+\\'" nil t) (replace-match "")) - (goto-char (point-min)) - (let ((cnt 0)) - (while (re-search-forward "\n" nil t) - (setq cnt (1+ cnt)) - (replace-match (if macro "\\n" " ") t t)) - (when (and macro (> cnt 0)) - (goto-char (point-max)) (insert "\\n"))) - (goto-char (point-min)) - (if (looking-at "\\s-*") (replace-match " "))) - (when (org-bound-and-true-p org-edit-src-from-org-mode) - (goto-char (point-min)) - (while (re-search-forward - (if (org-mode-p) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t) - (if (eq (org-current-line) line) (setq delta (1+ delta))) - (replace-match ",\\1"))) - (when (org-bound-and-true-p org-edit-src-picture) - (setq preserve-indentation nil) - (untabify (point-min) (point-max)) - (goto-char (point-min)) - (while (re-search-forward "^" nil t) - (replace-match ": "))) - (unless (or single preserve-indentation (= total-nindent 0)) - (setq indent (make-string total-nindent ?\ )) - (goto-char (point-min)) - (while (re-search-forward "^" nil t) - (replace-match indent))) - (if (org-bound-and-true-p org-edit-src-picture) - (setq total-nindent (+ total-nindent 2))) - (setq code (buffer-string)) - (set-buffer-modified-p nil) + (when allow-write-back-p + (when single + (goto-char (point-min)) + (if (re-search-forward "\\s-+\\'" nil t) (replace-match "")) + (goto-char (point-min)) + (let ((cnt 0)) + (while (re-search-forward "\n" nil t) + (setq cnt (1+ cnt)) + (replace-match (if macro "\\n" " ") t t)) + (when (and macro (> cnt 0)) + (goto-char (point-max)) (insert "\\n"))) + (goto-char (point-min)) + (if (looking-at "\\s-*") (replace-match " "))) + (when (org-bound-and-true-p org-edit-src-from-org-mode) + (goto-char (point-min)) + (while (re-search-forward + (if (org-mode-p) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t) + (if (eq (org-current-line) line) (setq delta (1+ delta))) + (replace-match ",\\1"))) + (when (org-bound-and-true-p org-edit-src-picture) + (setq preserve-indentation nil) + (untabify (point-min) (point-max)) + (goto-char (point-min)) + (while (re-search-forward "^" nil t) + (replace-match ": "))) + (unless (or single preserve-indentation (= total-nindent 0)) + (setq indent (make-string total-nindent ?\ )) + (goto-char (point-min)) + (while (re-search-forward "^" nil t) + (replace-match indent))) + (if (org-bound-and-true-p org-edit-src-picture) + (setq total-nindent (+ total-nindent 2))) + (setq code (buffer-string)) + (set-buffer-modified-p nil)) (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit)) (kill-buffer buffer) (goto-char beg) - (delete-region beg end) - (insert code) - (goto-char beg) - (if single (just-one-space)) + (when allow-write-back-p + (delete-region beg end) + (insert code) + (goto-char beg) + (if single (just-one-space))) (if (memq t (mapcar (lambda (overlay) - (eq (org-overlay-get overlay 'invisible) + (eq (overlay-get overlay 'invisible) 'org-hide-block)) - (org-overlays-at (point)))) + (overlays-at (point)))) ;; Block is hidden; put point at start of block (beginning-of-line 0) ;; Block is visible, put point where it was in the code buffer @@ -625,15 +636,21 @@ the language, a switch telling if the content should be in a single line." (message (or msg "")))) (defun org-src-mode-configure-edit-buffer () - (when org-edit-src-from-org-mode - (setq buffer-offer-save t) - (setq buffer-file-name - (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker)) - "[" (buffer-name) "]")) - (set (if (featurep 'xemacs) 'write-contents-hooks 'write-contents-functions) - '(org-edit-src-save)) + (when (org-bound-and-true-p org-edit-src-from-org-mode) (org-add-hook 'kill-buffer-hook - '(lambda () (org-delete-overlay org-edit-src-overlay)) nil 'local))) + '(lambda () (delete-overlay org-edit-src-overlay)) nil 'local) + (if (org-bound-and-true-p org-edit-src-allow-write-back-p) + (progn + (setq buffer-offer-save t) + (setq buffer-file-name + (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker)) + "[" (buffer-name) "]")) + (if (featurep 'xemacs) + (progn + (make-variable-buffer-local 'write-contents-hooks) ; needed only for 21.4 + (setq write-contents-hooks '(org-edit-src-save))) + (setq write-contents-functions '(org-edit-src-save)))) + (setq buffer-read-only t)))) (org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index bbf9f10bc25..6a7120e0e55 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -196,7 +196,7 @@ t: accept as input and present for editing" calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm)) calc-display-working-message t ) - "List with Calc mode settings for use in calc-eval for table formulas. + "List with Calc mode settings for use in `calc-eval' for table formulas. The list must contain alternating symbols (Calc modes variables and values). Don't remove any of the default settings, just change the values. Org-mode relies on the variables to be present in the list." @@ -276,10 +276,11 @@ portability of tables." :group 'org-table) (defcustom org-table-export-default-format "orgtbl-to-tsv" - "Default export parameters for org-table-export. These can be -overridden on for a specific table by setting the TABLE_EXPORT_FORMAT -property. See the manual section on orgtbl radio tables for the different -export transformations and available parameters." + "Default export parameters for `org-table-export'. +These can be overridden for a specific table by setting the +TABLE_EXPORT_FORMAT property. See the manual section on orgtbl +radio tables for the different export transformations and +available parameters." :group 'org-table-import-export :type 'string) @@ -290,8 +291,7 @@ export transformations and available parameters." (defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)" "Detects a table line marked for automatic recalculation.") (defconst org-table-border-regexp "^[ \t]*[^| \t]" - "Searching from within a table (any type) this finds the first line -outside the table.") + "Searching from within a table (any type) this finds the first line outside the table.") (defvar org-table-last-highlighted-reference nil) (defvar org-table-formula-history nil) @@ -305,11 +305,11 @@ outside the table.") "Alist with locations of named fields.") (defvar org-table-current-line-types nil - "Table row types, non-nil only for the duration of a comand.") + "Table row types, non-nil only for the duration of a command.") (defvar org-table-current-begin-line nil - "Table begin line, non-nil only for the duration of a comand.") + "Table begin line, non-nil only for the duration of a command.") (defvar org-table-current-begin-pos nil - "Table begin position, non-nil only for the duration of a comand.") + "Table begin position, non-nil only for the duration of a command.") (defvar org-table-dlines nil "Vector of data line line numbers in the current table.") (defvar org-table-hlines nil @@ -327,6 +327,33 @@ outside the table.") "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)") "Match a range for reference display.") +(defun org-table-colgroup-line-p (line) + "Is this a table line colgroup information?" + (save-match-data + (and (string-match "[<>]\\|&[lg]t;" line) + (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'" + line) + (not (delq + nil + (mapcar + (lambda (s) + (not (member s '("" "<" ">" "<>" "<" ">" "<>")))) + (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) + +(defun org-table-cookie-line-p (line) + "Is this a table line with only alignment/width cookies?" + + (save-match-data + (and (string-match "[<>]\\|&[lg]t;" line) + (or (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'" line) + (string-match "\\(\\`[ \t<>lr0-9|gt&;]+\\'\\)" line)) + (not (delq nil (mapcar + (lambda (s) + (not (or (equal s "") + (string-match "\\`<\\([lr]?[0-9]+\\|[lr]\\)>\\'" s) + (string-match "\\`<\\([lr]?[0-9]+\\|[lr]\\)>\\'" s)))) + (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) + (defconst org-table-translate-regexp (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") "Match a reference that needs translation, for reference display.") @@ -470,7 +497,7 @@ FILE can be the output file name. If not given, it will be taken from a TABLE_EXPORT_FILE property in the current entry or higher up in the hierarchy, or the user will be prompted for a file name. FORMAT can be an export format, of the same kind as it used when -orgtbl-mode sends a table in a different format. The default format can +`orgtbl-mode' sends a table in a different format. The default format can be found in the variable `org-table-export-default-format', but the function first checks if there is an export format specified in a TABLE_EXPORT_FORMAT property, locally or anywhere up in the hierarchy." @@ -602,7 +629,8 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) (hfmt1 (concat (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) - emptystrings links dates emph narrow falign falign1 fmax f1 len c e) + emptystrings links dates emph raise narrow + falign falign1 fmax f1 len c e space) (untabify beg end) (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) ;; Check if we have links or dates @@ -612,6 +640,9 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (setq emph (and org-hide-emphasis-markers (re-search-forward org-emph-re end t))) (goto-char beg) + (setq raise (and org-use-sub-superscripts + (re-search-forward org-match-substring-regexp end t))) + (goto-char beg) (setq dates (and org-display-custom-times (re-search-forward org-ts-regexp-both end t))) ;; Make sure the link properties are right @@ -619,6 +650,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; Make sure the date properties are right (when dates (goto-char beg) (while (org-activate-dates end))) (when emph (goto-char beg) (while (org-do-emphasis-faces end))) + (when raise (goto-char beg) (while (org-raise-scripts end))) ;; Check if we are narrowing any columns (goto-char beg) @@ -709,16 +741,22 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; With invisible characters, `format' does not get the field width right ;; So we need to make these fields wide by hand. - (when (or links emph) + (when (or links emph raise) (loop for i from 0 upto (1- maxfields) do (setq len (nth i lengths)) (loop for j from 0 upto (1- (length fields)) do (setq c (nthcdr i (car (nthcdr j fields)))) (if (and (stringp (car c)) - (text-property-any 0 (length (car c)) 'invisible 'org-link (car c)) -; (string-match org-bracket-link-regexp (car c)) + (or (text-property-any 0 (length (car c)) + 'invisible 'org-link (car c)) + (text-property-any 0 (length (car c)) + 'org-dwidth t (car c))) (< (org-string-width (car c)) len)) - (setcar c (concat (car c) (make-string (- len (org-string-width (car c))) ?\ ))))))) + (progn + (setq space (make-string (- len (org-string-width (car c))) ?\ )) + (setcar c (if (nth i typenums) + (concat space (car c)) + (concat (car c) space)))))))) ;; Compute the formats needed for output of the table (setq rfmt (concat indent "|") hfmt (concat indent "|")) @@ -764,14 +802,6 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (setq org-table-may-need-update nil) )) - - - - - - - - (defun org-table-begin (&optional table-type) "Find the beginning of the table and return its position. With argument TABLE-TYPE, go to the beginning of a table.el-type table." @@ -830,6 +860,7 @@ Optional argument NEW may specify text to replace the current field content." (if (<= (length new) l) ;; FIXME: length -> str-width? (setq n (format f new)) (setq n (concat new "|") org-table-may-need-update t))) + (if (equal (string-to-char n) ?-) (setq n (concat " " n))) (or (equal n o) (let (org-table-may-need-update) (replace-match n t t)))) @@ -1021,7 +1052,7 @@ If column is nil, use the current column." (defun org-table-put (line column value &optional align) "Put VALUE into line LINE, column COLUMN. -When ALIGN is set, als realign the table." +When ALIGN is set, also realign the table." (setq column (or column (org-table-current-column))) (prog1 (save-excursion (and (or (not line) (org-table-goto-line line)) @@ -1128,7 +1159,7 @@ is always the old value." (defun org-table-current-dline () "Find out what table data line we are in. -Only datalines count for this." +Only data lines count for this." (interactive) (if (interactive-p) (org-table-check-inside-data-field)) (save-excursion @@ -1189,7 +1220,7 @@ However, when FORCE is non-nil, create new columns if necessary." (org-table-fix-formulas "$LR" nil (1- col) 1))) (defun org-table-find-dataline () - "Find a dataline in the current table, which is needed for column commands." + "Find a data line in the current table, which is needed for column commands." (if (and (org-at-table-p) (not (org-at-table-hline-p))) t @@ -1729,23 +1760,6 @@ the table and kill the editing buffer." (org-table-align) (message "New field value inserted"))) - - - - - - - - - - - - - - - - - (defvar org-timecnt) ; dynamically scoped parameter (defun org-table-sum (&optional beg end nlast) @@ -1830,7 +1844,7 @@ If NLAST is a number, only the NLAST fields will actually be summed." "Return the formula active for the current field. Assumes that specials are in place. If KEY is given, return the key to this formula. -Otherwise return the formula preceeded with \"=\" or \":=\"." +Otherwise return the formula preceded with \"=\" or \":=\"." (let* ((name (car (rassoc (list (org-current-line) (org-table-current-column)) org-table-named-field-locations))) @@ -2372,7 +2386,7 @@ $1-> %s\n" orig formula form0 form)) (org-fit-window-to-buffer bw) (unless (and (interactive-p) (not ndown)) (unless (let (inhibit-redisplay) - (y-or-n-p "Debugging Formula. Continue to next? ")) + (y-or-n-p "Debugging Formula. Continue to next? ")) (org-table-align) (error "Abort")) (delete-window bw) @@ -2469,7 +2483,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)) + (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))) @@ -2483,7 +2497,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) + (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))) @@ -2554,7 +2568,8 @@ LISPP means to return something appropriate for a Lisp list." (defun org-table-recalculate (&optional all noalign) "Recalculate the current table line by applying all stored formulas. With prefix arg ALL, do this for all lines in the table. -With the prefix argument ALL is `(16)' (a double `C-c C-u' prefix), or if +With the prefix argument ALL is `(16)' \ +\(a double \\[universal-prefix] \\[universal-prefix] prefix), or if it is the symbol `iterate', recompute the table until it no longer changes. If NOALIGN is not nil, do not re-align the table after the computations are done. This is typically used internally to save time, if it is @@ -2682,6 +2697,36 @@ known that the table will be realigned a little later anyway." (throw 'exit t))) (error "No convergence after %d iterations" i)))) +(defun org-table-recalculate-buffer-tables () + "Recalculate all tables in the current buffer." + (interactive) + (save-excursion + (save-restriction + (widen) + (org-table-map-tables (lambda () (org-table-recalculate t)) t)))) + +(defun org-table-iterate-buffer-tables () + "Iterate all tables in the buffer, to converge inter-table dependencies." + (interactive) + (let* ((imax 10) + (checksum (md5 (buffer-string))) + + c1 + (i imax)) + (save-excursion + (save-restriction + (widen) + (catch 'exit + (while (> i 0) + (setq i (1- i)) + (org-table-map-tables (lambda () (org-table-recalculate t)) t) + (if (equal checksum (setq c1 (md5 (buffer-string)))) + (progn + (message "Convergence after %d iterations" (- imax i)) + (throw 'exit t)) + (setq checksum c1))) + (error "No convergence after %d iterations" imax)))))) + (defun org-table-formula-substitute-names (f) "Replace $const with values in string F." (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?'))) @@ -2720,6 +2765,7 @@ Parameters get priority." (org-defkey map "\C-x\C-s" 'org-table-fedit-finish) (org-defkey map "\C-c\C-s" 'org-table-fedit-finish) (org-defkey map "\C-c\C-c" 'org-table-fedit-finish) + (org-defkey map "\C-c'" 'org-table-fedit-finish) (org-defkey map "\C-c\C-q" 'org-table-fedit-abort) (org-defkey map "\C-c?" 'org-table-show-reference) (org-defkey map [(meta shift up)] 'org-table-fedit-line-up) @@ -2816,7 +2862,7 @@ Parameters get priority." (if (eq org-table-use-standard-references t) (org-table-fedit-toggle-ref-type)) (org-goto-line startline) - (message "Edit formulas and finish with `C-c C-c'. See menu for more commands."))) + (message "Edit formulas, finish with `C-c C-c' or `C-c ' '. See menu for more commands."))) (defun org-table-fedit-post-command () (when (not (memq this-command '(lisp-complete-symbol))) @@ -2964,7 +3010,7 @@ For example: 28 -> AB." (org-rematch-and-replace 5 (eq dir 'left)))))) (defun org-rematch-and-replace (n &optional decr hline) - "Re-match the group N, and replace it with the shifted refrence." + "Re-match the group N, and replace it with the shifted reference." (or (match-end n) (error "Cannot shift reference in this direction")) (goto-char (match-beginning n)) (and (looking-at (regexp-quote (match-string n))) @@ -2972,7 +3018,7 @@ For example: 28 -> AB." t t))) (defun org-table-shift-refpart (ref &optional decr hline) - "Shift a refrence part REF. + "Shift a reference part REF. If DECR is set, decrease the references row/column, else increase. If HLINE is set, this may be a hline reference, it certainly is not a translation reference." @@ -3040,7 +3086,7 @@ With prefix ARG, apply the new formulas to the table." (select-window sel-win) (goto-char pos) (unless (org-at-table-p) - (error "Lost table position - cannot install formulae")) + (error "Lost table position - cannot install formulas")) (org-table-store-formulas eql) (move-marker pos nil) (kill-buffer "*Edit Formulas*") @@ -3282,8 +3328,8 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (defun org-table-add-rectangle-overlay (beg end &optional face) "Add a new overlay." - (let ((ov (org-make-overlay beg end))) - (org-overlay-put ov 'face (or face 'secondary-selection)) + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face (or face 'secondary-selection)) (push ov org-table-rectangle-overlays))) (defun org-table-highlight-rectangle (&optional beg end face) @@ -3318,7 +3364,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." "Remove the rectangle overlays." (unless org-inhibit-highlight-removal (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight) - (mapc 'org-delete-overlay org-table-rectangle-overlays) + (mapc 'delete-overlay org-table-rectangle-overlays) (setq org-table-rectangle-overlays nil))) (defvar org-table-coordinate-overlays nil @@ -3328,14 +3374,14 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (defun org-table-overlay-coordinates () "Add overlays to the table at point, to show row/column coordinates." (interactive) - (mapc 'org-delete-overlay org-table-coordinate-overlays) + (mapc 'delete-overlay org-table-coordinate-overlays) (setq org-table-coordinate-overlays nil) (save-excursion (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg) (goto-char (org-table-begin)) (while (org-at-table-p) (setq eol (point-at-eol)) - (setq ov (org-make-overlay (point-at-bol) (1+ (point-at-bol)))) + (setq ov (make-overlay (point-at-bol) (1+ (point-at-bol)))) (push ov org-table-coordinate-overlays) (setq hline (looking-at org-table-hline-regexp)) (setq str (if hline (format "I*%-2d" (setq ih (1+ ih))) @@ -3349,7 +3395,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." s1 (concat "$" (int-to-string ic)) s2 (org-number-to-letters ic) str (if (eq org-table-use-standard-references t) s2 s1)) - (setq ov (org-make-overlay beg (+ beg (length str)))) + (setq ov (make-overlay beg (+ beg (length str)))) (push ov org-table-coordinate-overlays) (org-overlay-display ov str 'org-special-keyword 'evaporate))) (beginning-of-line 2))))) @@ -3363,7 +3409,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (if (and (org-at-table-p) org-table-overlay-coordinates) (org-table-align)) (unless org-table-overlay-coordinates - (mapc 'org-delete-overlay org-table-coordinate-overlays) + (mapc 'delete-overlay org-table-coordinate-overlays) (setq org-table-coordinate-overlays nil))) (defun org-table-toggle-formula-debugger () @@ -3401,6 +3447,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." ;; active, this binding is ignored inside tables and replaced with a ;; modified self-insert. + (defvar orgtbl-mode-map (make-keymap) "Keymap for `orgtbl-mode'.") @@ -3410,7 +3457,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (orgtbl-mode 1)) (defvar org-old-auto-fill-inhibit-regexp nil - "Local variable used by `orgtbl-mode'") + "Local variable used by `orgtbl-mode'.") (defconst orgtbl-line-start-regexp "[ \t]*\\(|\\|#\\+\\(TBLFM\\|ORGTBL\\|TBLNAME\\):\\)" @@ -3419,11 +3466,12 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (defconst orgtbl-extra-font-lock-keywords (list (list (concat "^" orgtbl-line-start-regexp ".*") 0 (quote 'org-table) 'prepend)) - "Extra font-lock-keywords to be added when orgtbl-mode is active.") + "Extra `font-lock-keywords' to be added when `orgtbl-mode' is active.") ;; Install it as a minor mode. (put 'orgtbl-mode :included t) (put 'orgtbl-mode :menu-tag "Org Table Mode") + ;;;###autoload (define-minor-mode orgtbl-mode "The `org-mode' table editor as a minor mode for use in other modes." @@ -3451,7 +3499,7 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (concat orgtbl-line-start-regexp "\\|" auto-fill-inhibit-regexp) orgtbl-line-start-regexp)) - (org-add-to-invisibility-spec '(org-cwidth)) + (add-to-invisibility-spec '(org-cwidth)) (when (fboundp 'font-lock-add-keywords) (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) (org-restart-font-lock)) @@ -3785,13 +3833,13 @@ overwritten, and the table is not marked as requiring realignment." (funcall func table nil))) (defun orgtbl-gather-send-defs () - "Gathers a plist of :name, :transform, :params for each destination before + "Gather a plist of :name, :transform, :params for each destination before a radio table." (save-excursion (goto-char (org-table-begin)) (let (rtn) (beginning-of-line 0) - (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") + (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") (let ((name (org-no-properties (match-string 1))) (transform (intern (match-string 2))) (params (if (match-end 3) @@ -3942,17 +3990,17 @@ First element has index 0, or I0 if given." (defvar *orgtbl-rtn* nil "Formatting routines push the output lines here.") ;; Formatting parameters for the current table section. -(defvar *orgtbl-hline* nil "Text used for horizontal lines") -(defvar *orgtbl-sep* nil "Text used as a column separator") -(defvar *orgtbl-default-fmt* nil "Default format for each entry") -(defvar *orgtbl-fmt* nil "Format for each entry") -(defvar *orgtbl-efmt* nil "Format for numbers") -(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt") -(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row") -(defvar *orgtbl-lstart* nil "Text starting a row") -(defvar *orgtbl-llstart* nil "Specializes lstart for the last row") -(defvar *orgtbl-lend* nil "Text ending a row") -(defvar *orgtbl-llend* nil "Specializes lend for the last row") +(defvar *orgtbl-hline* nil "Text used for horizontal lines.") +(defvar *orgtbl-sep* nil "Text used as a column separator.") +(defvar *orgtbl-default-fmt* nil "Default format for each entry.") +(defvar *orgtbl-fmt* nil "Format for each entry.") +(defvar *orgtbl-efmt* nil "Format for numbers.") +(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt.") +(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row.") +(defvar *orgtbl-lstart* nil "Text starting a row.") +(defvar *orgtbl-llstart* nil "Specializes lstart for the last row.") +(defvar *orgtbl-lend* nil "Text ending a row.") +(defvar *orgtbl-llend* nil "Specializes lend for the last row.") (defsubst orgtbl-get-fmt (fmt i) "Retrieve the format from FMT corresponding to the Ith column." @@ -4072,6 +4120,7 @@ directly by `orgtbl-send-table'. See manual." (let* ((splicep (plist-get params :splice)) (hline (plist-get params :hline)) (remove-nil-linesp (plist-get params :remove-nil-lines)) + (remove-newlines (plist-get params :remove-newlines)) (*orgtbl-hline* hline) (*orgtbl-table* table) (*orgtbl-sep* (plist-get params :sep)) @@ -4126,9 +4175,13 @@ directly by `orgtbl-send-table'. See manual." (let ((tend (orgtbl-eval-str (plist-get params :tend)))) (if tend (push tend *orgtbl-rtn*))))) - (mapconcat 'identity (nreverse (if remove-nil-linesp - (remq nil *orgtbl-rtn*) - *orgtbl-rtn*)) "\n"))) + (mapconcat (if remove-newlines + (lambda (tend) + (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend)) + 'identity) + (nreverse (if remove-nil-linesp + (remq nil *orgtbl-rtn*) + *orgtbl-rtn*)) "\n"))) (defun orgtbl-to-tsv (table params) "Convert the orgtbl-mode table to TAB separated material." @@ -4179,7 +4232,7 @@ this function is called." (orgtbl-to-generic table (org-combine-plists params2 params)))) (defun orgtbl-to-html (table params) - "Convert the orgtbl-mode TABLE to LaTeX. + "Convert the orgtbl-mode TABLE to HTML. TABLE is a list, each entry either the symbol `hline' for a horizontal separator line, or a list of fields for that line. PARAMS is a property list of parameters that can influence the conversion. @@ -4254,6 +4307,7 @@ and :tend suppress strings without splicing; they can be set to provide ORGTBL directives for the generated table." (let* ((params2 (list + :remove-newlines t :tstart nil :tend nil :hline "|---" :sep " | " @@ -4301,23 +4355,23 @@ list of the fields in the rectangle ." (setq buffer (marker-buffer id-loc) loc (marker-position id-loc)) (move-marker id-loc nil))) - (switch-to-buffer buffer) - (save-excursion - (save-restriction - (widen) - (goto-char loc) - (forward-char 1) - (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) - (not (match-beginning 1))) - (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 form)) - (if (and (string-match org-table-range-regexp form) - (> (length (match-string 0 form)) 1)) - (save-match-data - (org-table-get-range (match-string 0 form) tbeg 1)) - form)))))))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char loc) + (forward-char 1) + (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) + (not (match-beginning 1))) + (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 form)) + (if (and (string-match org-table-range-regexp form) + (> (length (match-string 0 form)) 1)) + (save-match-data + (org-table-get-range (match-string 0 form) tbeg 1)) + form))))))))) (provide 'org-table) diff --git a/lisp/org/org-taskjuggler.el b/lisp/org/org-taskjuggler.el new file mode 100644 index 00000000000..da9e156870e --- /dev/null +++ b/lisp/org/org-taskjuggler.el @@ -0,0 +1,648 @@ +;;; org-taskjuggler.el --- TaskJuggler exporter for org-mode +;; +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; +;; Emacs Lisp Archive Entry +;; Filename: org-taskjuggler.el +;; Version: 7.01 +;; 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 <http://www.gnu.org/licenses/>. + +;; 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 gant 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 <resource_id> 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: 2.0 +;; :END: +;; ** Workflow Guidelines +;; :PROPERTIES: +;; :Effort: 2.0 +;; :END: +;; * Presentation +;; :PROPERTIES: +;; :Effort: 2.0 +;; :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 + :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 + :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 + :type 'string) + +(defcustom org-export-taskjuggler-default-project-version "1.0" + "Default version string for the project." + :group 'org-export-taskjuggler + :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 + :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 + :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 + :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-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)) + (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-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-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 (nth 4 components)) + (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-assign-resource-ids (resources &optional unique-ids) + "Given a list of resources return the same list, assigning a +unique id to each resource." + (cond + ((null resources) nil) + (t + (let* ((resource (car resources)) + (unique-id (org-taskjuggler-get-unique-id resource unique-ids))) + (push (cons "unique-id" unique-id) resource) + (cons resource + (org-taskjuggler-assign-resource-ids (cdr resources) + (cons unique-id unique-ids))))))) + +(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 (member id unique-ids) + (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-regexp-in-string "[^a-zA-Z0-9_]" "_" 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 formated 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. If the effort string is something like 5:30 it +will be assumed to be hours and will be translated into 5.5h. +Otherwise if it contains something like 3.0 it is assumed to be +days and will be translated into 3.0d. Other formats that +taskjuggler supports (like weeks, months and years) are currently +not supported." + (cond + ((null effort) effort) + ((string-match "\\([0-9]+\\):\\([0-9]+\\)" effort) + (let ((hours (string-to-number (match-string 1 effort))) + (minutes (string-to-number (match-string 2 effort)))) + (format "%dh" (+ hours (/ minutes 60.0))))) + ((string-match "\\([0-9]+\\).\\([0-9]+\\)" effort) (concat effort "d")) + (t (error "Not a valid effort (%s)" effort)))) + +(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))) + (attributes + '(account start note duration endbuffer endcredit end + flags journalentry length maxend maxstart milestone + 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 allocations\n allocate %s\n" allocate)) + (and complete (format " complete %s\n" complete)) + (and effort (format " effort %s\n" effort)) + (and priority (format " priority %s\n" priority)) + + (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) + +;;; org-taskjuggler.el ends here diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index 91664eb7b1a..b773274e93b 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -27,6 +27,8 @@ ;; This file contains the relative timer code for Org-mode +;;; Code: + (require 'org) (declare-function org-show-notification "org-clock" (parameters)) @@ -48,6 +50,12 @@ the value of the relative timer." :group 'org-time :type 'string) +(defcustom org-timer-default-timer 0 + "The default timer when a timer is set. +When 0, the user is prompted for a value." + :group 'org-time + :type 'number) + (defvar org-timer-start-hook nil "Hook run after relative timer is started.") @@ -96,7 +104,7 @@ the region 0:00:00." (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s))))) (setq org-timer-start-time (seconds-to-time - (- (org-float-time) (org-timer-hms-to-secs s))))) + (- (org-float-time) delta)))) (org-timer-set-mode-line 'on) (message "Timer start time set to %s, current value is %s" (format-time-string "%T" org-timer-start-time) @@ -104,7 +112,8 @@ the region 0:00:00." (run-hooks 'org-timer-start-hook)))) (defun org-timer-pause-or-continue (&optional stop) - "Pause or continue the relative timer. With prefix arg, stop it entirely." + "Pause or continue the relative timer. +With prefix arg STOP, stop it entirely." (interactive "P") (cond (stop (org-timer-stop)) @@ -139,8 +148,9 @@ the region 0:00:00." (defun org-timer (&optional restart) "Insert a H:MM:SS string from the timer into the buffer. The first time this command is used, the timer is started. When used with -a `C-u' prefix, force restarting the timer. -When used with a double prefix arg `C-u C-u', change all the timer string +a \\[universal-argument] prefix, force restarting the timer. +When used with a double prefix argument \ +\\[universal-argument] \\universal-argument], change all the timer string in the region by a fixed amount. This can be used to recalibrate a timer that was not started at the correct moment." (interactive "P") @@ -299,12 +309,37 @@ VALUE can be `on', `off', or `pause'." (message "%d minute(s) %d seconds left before next time out" rmins rsecs)))) +(defun bzg-test (&optional test) + (interactive "P") + test) + ;;;###autoload -(defun org-timer-set-timer (minutes) - "Set a timer." - (interactive "sTime out in (min)? ") - (if (not (string-match "[0-9]+" minutes)) - (org-timer-show-remaining-time) +(defun org-timer-set-timer (&optional opt) + "Prompt for a duration and set a timer. + +If `org-timer-default-timer' is not zero, suggest this value as +the default duration for the timer. If a timer is already set, +prompt the use if she wants to replace it. + +Called with a numeric prefix argument, use this numeric value as +the duration of the timer. + +Called with a `C-u' prefix arguments, use `org-timer-default-timer' +without prompting the user for a duration. + +With two `C-u' prefix arguments, use `org-timer-default-timer' +without prompting the user for a duration and automatically +replace any running timer." + (interactive "P") + (let ((minutes (or (and (numberp opt) (number-to-string opt)) + (and (listp opt) (not (null opt)) + (number-to-string org-timer-default-timer)) + (read-from-minibuffer + "How many minutes left? " + (if (not (eq org-timer-default-timer 0)) + (number-to-string org-timer-default-timer)))))) + (if (not (string-match "[0-9]+" minutes)) + (org-timer-show-remaining-time) (let* ((mins (string-to-number (match-string 0 minutes))) (secs (* mins 60)) (hl (cond @@ -323,15 +358,21 @@ VALUE can be `on', `off', or `pause'." (org-get-heading)) (t (error "Not in an Org buffer")))) timer-set) - (if org-timer-current-timer - (error "You cannot run several timers at the same time") - (setq org-timer-current-timer - (run-with-timer - secs nil `(lambda () - (setq org-timer-current-timer nil) - (org-notify ,(format "%s: time out" hl) t) - (run-hooks 'org-timer-done-hook)))) - (run-hooks 'org-timer-set-hook))))) + (if (or (and org-timer-current-timer + (or (equal opt '(16)) + (y-or-n-p "Replace current timer? "))) + (not org-timer-current-timer)) + (progn + (when org-timer-current-timer + (cancel-timer org-timer-current-timer)) + (setq org-timer-current-timer + (run-with-timer + secs nil `(lambda () + (setq org-timer-current-timer nil) + (org-notify ,(format "%s: time out" hl) t) + (run-hooks 'org-timer-done-hook)))) + (run-hooks 'org-timer-set-hook)) + (message "No timer set")))))) (provide 'org-timer) diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el index 5677fe74644..4a28df6caa0 100644 --- a/lisp/org/org-vm.el +++ b/lisp/org/org-vm.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el index 24b5f4e7c3c..b457156f573 100644 --- a/lisp/org/org-w3m.el +++ b/lisp/org/org-w3m.el @@ -5,7 +5,7 @@ ;; Author: Andy Stewart <lazycat dot manatee at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -28,11 +28,11 @@ ;; This file implements copying HTML content from a w3m buffer and ;; transforming the text on the fly so that it can be pasted into ;; an org-mode buffer with hot links. It will also work for regions -;; in gnus buffers that have ben washed with w3m. +;; in gnus buffers that have been washed with w3m. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; -;;; Acknowledgements: +;;; Acknowledgments: ;; Richard Riley <rileyrgdev at googlemail dot com> ;; @@ -40,8 +40,9 @@ ;; proposed by Richard, I'm just coding it. ;; +;;; Code: + (require 'org) -(declare-function w3m-anchor "ext:w3m-util" (position)) (defun org-w3m-copy-for-org-mode () "Copy current buffer content or active region with `org-mode' style links. @@ -68,7 +69,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." ;; store current point before jump next anchor (setq temp-position (point)) ;; move to next anchor when current point is not at anchor - (or (w3m-anchor (point)) (org-w3m-get-next-link-start)) + (or (get-text-property (point) 'w3m-href-anchor) (org-w3m-get-next-link-start)) (if (<= (point) transform-end) ; if point is inside transform bound (progn ;; get content between two links. @@ -77,7 +78,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." (buffer-substring temp-position (point))))) ;; get link location at current point. - (setq link-location (w3m-anchor (point))) + (setq link-location (get-text-property (point) 'w3m-href-anchor)) ;; get link title at current point. (setq link-title (buffer-substring (point) (org-w3m-get-anchor-end))) @@ -115,7 +116,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." (while (next-single-property-change (point) 'w3m-anchor-sequence) ;; jump to next anchor (goto-char (next-single-property-change (point) 'w3m-anchor-sequence)) - (when (w3m-anchor (point)) + (when (get-text-property (point) 'w3m-href-anchor) ;; return point when current is valid link (throw 'reach nil)))) (point)) @@ -126,7 +127,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." (while (previous-single-property-change (point) 'w3m-anchor-sequence) ;; jump to previous anchor (goto-char (previous-single-property-change (point) 'w3m-anchor-sequence)) - (when (w3m-anchor (point)) + (when (get-text-property (point) 'w3m-href-anchor) ;; return point when current is valid link (throw 'reach nil)))) (point)) diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el index e0b438f0111..4d2f8ec1280 100644 --- a/lisp/org/org-wl.el +++ b/lisp/org/org-wl.el @@ -4,9 +4,10 @@ ;; Free Software Foundation, Inc. ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> +;; David Maus <dmaus at ictsoc dot de> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -40,9 +41,36 @@ :group 'org-link) (defcustom org-wl-link-to-refile-destination t - "Create a link to the refile destination if the message is marked as refile." - :group 'org-wl - :type 'boolean) + "Create a link to the refile destination if the message is marked as refile." + :group 'org-wl + :type 'boolean) + +(defcustom org-wl-link-remove-filter nil + "Remove filter condition if message is filter folder." + :group 'org-wl + :type 'boolean) + +(defcustom org-wl-shimbun-prefer-web-links nil + "If non-nil create web links for shimbun messages." + :group 'org-wl + :type 'boolean) + +(defcustom org-wl-nntp-prefer-web-links nil + "If non-nil create web links for nntp messages. +When folder name contains string \"gmane\" link to gmane, +googlegroups otherwise." + :type 'boolean + :group 'org-wl) + +(defcustom org-wl-disable-folder-check t + "Disable check for new messages when open a link." + :type 'boolean + :group 'org-wl) + +(defcustom org-wl-namazu-default-index nil + "Default namazu search index." + :type 'directory + :group 'org-wl) ;; Declare external functions and variables (declare-function elmo-folder-exists-p "ext:elmo" (folder) t) @@ -63,84 +91,185 @@ (declare-function wl-summary-registered-temp-mark "ext:wl-action" (number)) (declare-function wl-folder-goto-folder-subr "ext:wl-folder" (&optional folder sticky)) +(declare-function wl-folder-get-petname "ext:wl-folder" (name)) +(declare-function wl-folder-get-entity-from-buffer "ext:wl-folder" + (&optional getid)) +(declare-function wl-folder-buffer-group-p "ext:wl-folder") (defvar wl-init) (defvar wl-summary-buffer-elmo-folder) (defvar wl-summary-buffer-folder-name) +(defvar wl-folder-group-regexp) +(defvar wl-auto-check-folder-name) + +(defconst org-wl-folder-types + '(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool) + ("$" . archive) ("&" . pop) ("@" . shimbun) ("[" . search) + ("*" . multi) ("/" . filter) ("|" . pipe) ("'" . internal)) + "List of folder indicators. See Wanderlust manual, section 3.") ;; Install the link type (org-add-link-type "wl" 'org-wl-open) (add-hook 'org-store-link-functions 'org-wl-store-link) ;; Implementation + +(defun org-wl-folder-type (folder) + "Return symbol that indicates the type of FOLDER. +FOLDER is the wanderlust folder name. The first character of the +folder name determines the the folder type." + (let* ((indicator (substring folder 0 1)) + (type (cdr (assoc indicator org-wl-folder-types)))) + ;; maybe access or file folder + (when (not type) + (setq type + (cond + ((and (>= (length folder) 5) + (string= (substring folder 0 5) "file:")) + 'file) + ((and (>= (length folder) 7) + (string= (substring folder 0 7) "access:")) + 'access) + (t + nil)))) + type)) + +(defun org-wl-message-field (field entity) + "Return content of FIELD in ENTITY. +FIELD is a symbol of a rfc822 message header field. +ENTITY is a message entity." + (let ((content (elmo-message-entity-field entity field))) + (if (listp content) (car content) content))) + (defun org-wl-store-link () - "Store a link to a WL folder or message." - (when (eq major-mode 'wl-summary-mode) - (let* ((msgnum (wl-summary-message-number)) - (mark-info (wl-summary-registered-temp-mark msgnum)) - (folder-name - (if (and org-wl-link-to-refile-destination - mark-info - (equal (nth 1 mark-info) "o")) ; marked as refile - (nth 2 mark-info) - wl-summary-buffer-folder-name)) - (message-id (elmo-message-field wl-summary-buffer-elmo-folder - msgnum 'message-id)) - (wl-message-entity - (if (fboundp 'elmo-message-entity) - (elmo-message-entity - wl-summary-buffer-elmo-folder msgnum) - (elmo-msgdb-overview-get-entity - msgnum (wl-summary-buffer-msgdb)))) - (from (let ((from-field (elmo-message-entity-field wl-message-entity - 'from))) - (if (listp from-field) - (car from-field) - from-field))) - (to (let ((to-field (elmo-message-entity-field wl-message-entity - 'to))) - (if (listp to-field) - (car to-field) - to-field))) - (subject (let (wl-thr-indent-string wl-parent-message-entity) - (wl-summary-line-subject))) - desc link) - ;; remove text properties of subject string to avoid possible bug - ;; when formatting the subject - (set-text-properties 0 (length subject) nil subject) - - (org-store-link-props :type "wl" :from from :to to - :subject subject :message-id message-id) - (setq message-id (org-remove-angle-brackets message-id)) - (setq desc (org-email-link-description)) - (setq link (org-make-link "wl:" folder-name - "#" message-id)) - (org-add-link-props :link link :description desc) - link))) + "Store a link to a WL message or folder." + (cond + ((memq major-mode '(wl-summary-mode mime-view-mode)) + (org-wl-store-link-message)) + ((eq major-mode 'wl-folder-mode) + (org-wl-store-link-folder)) + (t + nil))) + +(defun org-wl-store-link-folder () + "Store a link to a WL folder." + (let* ((folder (wl-folder-get-entity-from-buffer)) + (petname (wl-folder-get-petname folder)) + (link (org-make-link "wl:" folder))) + (save-excursion + (beginning-of-line) + (unless (and (wl-folder-buffer-group-p) + (looking-at wl-folder-group-regexp)) + (org-store-link-props :type "wl" :description petname + :link link) + link)))) + +(defun org-wl-store-link-message () + "Store a link to a WL message." + (save-excursion + (let ((buf (if (eq major-mode 'wl-summary-mode) + (current-buffer) + (and (boundp 'wl-message-buffer-cur-summary-buffer) + wl-message-buffer-cur-summary-buffer)))) + (when buf + (with-current-buffer buf + (let* ((msgnum (wl-summary-message-number)) + (mark-info (wl-summary-registered-temp-mark msgnum)) + (folder-name + (if (and org-wl-link-to-refile-destination + mark-info + (equal (nth 1 mark-info) "o")) ; marked as refile + (nth 2 mark-info) + wl-summary-buffer-folder-name)) + (folder-type (org-wl-folder-type folder-name)) + (wl-message-entity + (if (fboundp 'elmo-message-entity) + (elmo-message-entity + wl-summary-buffer-elmo-folder msgnum) + (elmo-msgdb-overview-get-entity + msgnum (wl-summary-buffer-msgdb)))) + (message-id + (org-wl-message-field 'message-id wl-message-entity)) + (from (org-wl-message-field 'from wl-message-entity)) + (to (org-wl-message-field 'to wl-message-entity)) + (xref (org-wl-message-field 'xref wl-message-entity)) + (subject (org-wl-message-field 'subject wl-message-entity)) + desc link) + + ;; remove text properties of subject string to avoid possible bug + ;; when formatting the subject + ;; (Emacs bug #5306, fixed) + (set-text-properties 0 (length subject) nil subject) + + ;; maybe remove filter condition + (when (and (eq folder-type 'filter) org-wl-link-remove-filter) + (while (eq (org-wl-folder-type folder-name) 'filter) + (setq folder-name + (replace-regexp-in-string "^/[^/]+/" "" folder-name)))) + + ;; maybe create http link + (cond + ((and (eq folder-type 'shimbun) + org-wl-shimbun-prefer-web-links xref) + (org-store-link-props :type "http" :link xref :description subject + :from from :to to :message-id message-id + :subject subject)) + ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links) + (setq link + (format + (if (string-match "gmane\\." folder-name) + "http://mid.gmane.org/%s" + "http://groups.google.com/groups/search?as_umsgid=%s") + (org-fixup-message-id-for-http message-id))) + (org-store-link-props :type "http" :link link :description subject + :from from :to to :message-id message-id + :subject subject)) + (t + (org-store-link-props :type "wl" :from from :to to + :subject subject :message-id message-id) + (setq message-id (org-remove-angle-brackets message-id)) + (setq desc (org-email-link-description)) + (setq link (org-make-link "wl:" folder-name "#" message-id)) + (org-add-link-props :link link :description desc))) + (or link xref))))))) (defun org-wl-open (path) - "Follow the WL message link specified by PATH." - (require 'wl) - (unless wl-init (wl)) - ;; XXX: The imap-uw's MH folder names start with "%#". - (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in Wanderlust link")) - (let ((folder (match-string 1 path)) - (article (match-string 3 path))) - (if (not (elmo-folder-exists-p (org-no-warnings - (wl-folder-get-elmo-folder folder)))) - (error "No such folder: %s" folder)) - (let ((old-buf (current-buffer)) - (old-point (point-marker))) - (wl-folder-goto-folder-subr folder) - (save-excursion - ;; XXX: `wl-folder-goto-folder-subr' moves point to the - ;; beginning of the current line. So, restore the point - ;; in the old buffer. - (set-buffer old-buf) - (goto-char old-point)) - (and (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets - article)) - (wl-summary-redisplay))))) + "Follow the WL message link specified by PATH. +When called with one prefix, open message in namazu search folder +with `org-wl-namazu-default-index' as search index. When called +with two prefixes or `org-wl-namazu-default-index' is nil, ask +for namazu index." + (require 'wl) + (let ((wl-auto-check-folder-name + (if org-wl-disable-folder-check + 'none + wl-auto-check-folder-name))) + (unless wl-init (wl)) + ;; XXX: The imap-uw's MH folder names start with "%#". + (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)) + (error "Error in Wanderlust link")) + (let ((folder (match-string 1 path)) + (article (match-string 3 path))) + ;; maybe open message in namazu search folder + (when current-prefix-arg + (setq folder (concat "[" article "]" + (if (and (equal current-prefix-arg '(4)) + org-wl-namazu-default-index) + org-wl-namazu-default-index + (read-directory-name "Namazu index: "))))) + (if (not (elmo-folder-exists-p (org-no-warnings + (wl-folder-get-elmo-folder folder)))) + (error "No such folder: %s" folder)) + (let ((old-buf (current-buffer)) + (old-point (point-marker))) + (wl-folder-goto-folder-subr folder) + (with-current-buffer old-buf + ;; XXX: `wl-folder-goto-folder-subr' moves point to the + ;; beginning of the current line. So, restore the point + ;; in the old buffer. + (goto-char old-point)) + (and article (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets + article)) + (wl-summary-redisplay)))))) (provide 'org-wl) diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el index 6a907f2267a..af501058e86 100644 --- a/lisp/org/org-xoxo.el +++ b/lisp/org/org-xoxo.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -25,10 +25,11 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: +;; XOXO export -(require 'org-exp) +;;; Code: -;;; XOXO export +(require 'org-exp) (defvar org-export-xoxo-final-hook nil "Hook run after XOXO export, in the new buffer.") diff --git a/lisp/org/org.el b/lisp/org/org.el index cc74f7ff4f6..5b37e0aa260 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -6,7 +6,7 @@ ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.35i +;; Version: 7.01 ;; ;; This file is part of GNU Emacs. ;; @@ -76,14 +76,15 @@ (require 'calendar) ;; Emacs 22 calendar compatibility: Make sure the new variables are available -(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)) +(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))) ;; For XEmacs, noutline is not yet provided by outline.el, so arrange for ;; the file noutline.el being loaded. @@ -94,6 +95,7 @@ (require 'time-date) (unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) (require 'easymenu) +(require 'overlay) (require 'org-macs) (require 'org-entities) @@ -103,11 +105,86 @@ (require 'org-src) (require 'org-footnote) +;; babel +(require 'ob) +(require 'ob-table) +(require 'ob-lob) +(require 'ob-ref) +(require 'ob-tangle) +(require 'ob-comint) +(require 'ob-keys) + +;; load languages based on value of `org-babel-load-languages' +(defvar org-babel-load-languages) +;;;###autoload +(defun org-babel-do-load-languages (sym value) + "Load the languages defined in `org-babel-load-languages'." + (set-default sym value) + (mapc (lambda (pair) + (let ((active (cdr pair)) (lang (symbol-name (car pair)))) + (if active + (progn + (require (intern (concat "ob-" lang)))) + (progn + (funcall 'fmakunbound + (intern (concat "org-babel-execute:" lang))) + (funcall 'fmakunbound + (intern (concat "org-babel-expand-body:" lang))))))) + org-babel-load-languages)) + +(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 +below, note that each language will depend on a different set of +system executables and/or Emacs modes. When a language is +\"loaded\", then code blocks in that language can be evaluated +with `org-babel-execute-src-block' bound by default to C-c +C-c (note the `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can +be set to remove code block evaluation from the C-c C-c +keybinding. By default only Emacs Lisp (which has no +requirements) is loaded." + :group 'org-babel + :set 'org-babel-do-load-languages + :type '(alist :tag "Babel Languages" + :key-type + (choice + (const :tag "C" C) + (const :tag "R" R) + (const :tag "Asymptote" asymptote) + (const :tag "Clojure" clojure) + (const :tag "CSS" css) + (const :tag "Ditaa" ditaa) + (const :tag "Dot" dot) + (const :tag "Emacs Lisp" emacs-lisp) + (const :tag "Gnuplot" gnuplot) + (const :tag "Haskell" haskell) + (const :tag "Latex" latex) + (const :tag "Matlab" matlab) + (const :tag "Mscgen" mscgen) + (const :tag "Ocaml" ocaml) + (const :tag "Octave" octave) + (const :tag "Perl" perl) + (const :tag "Python" python) + (const :tag "Ruby" ruby) + (const :tag "Sass" sass) + (const :tag "Screen" screen) + (const :tag "Shell Script" sh) + (const :tag "Sql" sql) + (const :tag "Sqlite" sqlite)) + :value-type (boolean :tag "Activate" :value t))) + ;;;; Customization variables +(defcustom org-clone-delete-id nil + "Remove ID property of clones of a subtree. +When non-nil, clones of a subtree don't inherit the ID property. +Otherwise they inherit the ID property with a new unique +identifier." + :type 'boolean + :group 'org-id) ;;; Version -(defconst org-version "6.35i" +(defconst org-version "7.01" "The version number of the file org.el.") (defun org-version (&optional here) @@ -239,6 +316,7 @@ to add the symbol `xyz', and the package must have a call to (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 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 man: Support for links to manpages in Org-mode" org-man) (const :tag "C mtags: Support for muse-like tags" org-mtags) (const :tag "C panel: Simple routines for us with bad memory" org-panel) @@ -250,13 +328,14 @@ to add the symbol `xyz', and the package must have a call to (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 TaskJuggler: Export tasks to a TaskJuggler project" org-taskjuggler) (repeat :tag "External packages" :inline t (symbol :tag "Package")))) (defcustom org-support-shift-select nil "Non-nil means make shift-cursor commands select text when possible. In Emacs 23, when `shift-select-mode' is on, shifted cursor keys start -selecting a region, or enlarge thusly regions started in this way. +selecting a region, or enlarge regions started in this way. In Org-mode, in special contexts, these same keys are used for other purposes, important enough to compete with shift selection. Org tries to balance these needs by supporting `shift-select-mode' outside these @@ -335,6 +414,40 @@ the following lines anywhere in the buffer: (const :tag "Not" nil) (const :tag "Globally (slow on startup in large files)" t))) +(defcustom org-use-sub-superscripts t + "Non-nil means interpret \"_\" and \"^\" for export. +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 +needed. For example, the following things will be parsed as single +sub- or superscripts. + + 10^24 or 10^tau several digits will be considered 1 item. + 10^-12 or 10^-tau a leading sign with digits or a word + x^2-y^3 will be read as x^2 - y^3, because items are + 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\"." + :group 'org-startup + :group 'org-export-translation + :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 @@ -382,10 +495,10 @@ become effective." :type 'boolean) (defcustom org-use-extra-keys nil - "Non-nil means use extra key sequence definitions for certain -commands. This happens automatically if you run XEmacs or if -window-system is nil. This variable lets you do the same -manually. You must set it before loading org. + "Non-nil means use extra key sequence definitions for certain commands. +This happens automatically if you run XEmacs or if `window-system' +is nil. This variable lets you do the same manually. You must +set it before loading org. Example: on Carbon Emacs 22 running graphically, with an external keyboard on a Powerbook, the default way of setting M-left might @@ -416,14 +529,17 @@ therefore you'll have to restart Emacs to apply it after changing." (defun org-key (key) "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. -Or return the original if not disputed." - (if org-replace-disputed-keys - (let* ((nkey (key-description key)) - (x (org-find-if (lambda (x) - (equal (key-description (car x)) nkey)) - org-disputed-keys))) - (if x (cdr x) key)) - key)) +Or return the original if not disputed. +Also apply the translations defined in `org-xemacs-key-equivalents'." + (when org-replace-disputed-keys + (let* ((nkey (key-description key)) + (x (org-find-if (lambda (x) + (equal (key-description (car x)) nkey)) + org-disputed-keys))) + (setq key (if x (cdr x) key)))) + (when (featurep 'xemacs) + (setq key (or (cdr (assoc key org-xemacs-key-equivalents)) key))) + key) (defun org-find-if (predicate seq) (catch 'exit @@ -636,7 +752,7 @@ The cdr is either a command to be called interactively, a function to be called, or a form to be evaluated. An entry that is just a list with a single string will be interpreted as a descriptive headline that will be added when listing the speed -copmmands in the Help buffer using the `?' speed command." +commands in the Help buffer using the `?' speed command." :group 'org-structure :type '(repeat :value ("k" . ignore) (choice :value ("k" . ignore) @@ -702,7 +818,8 @@ This can also be set in on a per-file basis with (defcustom org-cycle-global-at-bob nil "Cycle globally if cursor is at beginning of buffer and not at a headline. This makes it possible to do global cycling without having to use S-TAB or -C-u TAB. For this special case to work, the first line of the buffer +\\[universal-argument] TAB. For this special case to work, the first line \ +of the buffer must not be a headline - it may be empty or some other text. When used in this way, `org-cycle-hook' is disables temporarily, to make sure the cursor stays at the beginning of the buffer. @@ -716,7 +833,7 @@ of the buffer." When the cursor is at the end of an empty headline, i.e with only stars and maybe a TODO keyword, TAB will then switch the entry to become a child, -and then all possible anchestor states, before returning to the original state. +and then all possible ancestor states, before returning to the original state. This makes data entry extremely fast: M-RET to create a new headline, on TAB to make it a child, two or more tabs to make it a (grand-)uncle. @@ -879,6 +996,18 @@ When t, the following will happen while the cursor is in the headline: :group 'org-edit-structure :type 'boolean) +(defcustom org-ctrl-k-protect-subtree nil + "Non-nil means, do not delete a hidden subtree with C-k. +When set to the symbol `error', simply throw an error when C-k is +used to kill (part-of) a headline that has hidden text behind it. +Any other non-nil value will result in a query to the user, if it is +OK to kill that hidden subtree. When nil, kill without remorse." + :group 'org-edit-structure + :type '(choice + (const :tag "Do not protect hidden subtrees" nil) + (const :tag "Protect hidden subtrees with a security query" t) + (const :tag "Never kill a hidden subtree with C-k" error))) + (defcustom org-yank-folded-subtrees t "Non-nil means when yanking subtrees, fold them. If the kill is a single subtree, or a sequence of subtrees, i.e. if @@ -962,9 +1091,8 @@ See also the QUOTE keyword." :group 'org-edit-structure :type 'boolean) - (defcustom org-goto-auto-isearch t - "Non-nil means typing characters in org-goto starts incremental search." + "Non-nil means typing characters in `org-goto' starts incremental search." :group 'org-edit-structure :type 'boolean) @@ -1150,11 +1278,11 @@ Changing this variable requires a restart of Emacs to become effective." (const :tag "Footnotes" footnote))) (defcustom org-make-link-description-function nil - "Function to use to generate link descriptions from links. If -nil the link location will be used. This function must take two -parameters; the first is the link and the second the description -org-insert-link has generated, and should return the description -to use." + "Function to use to generate link descriptions from links. +If nil the link location will be used. This function must take +two parameters; the first is the link and the second the +description `org-insert-link' has generated, and should return the +description to use." :group 'org-link :type 'function) @@ -1291,8 +1419,7 @@ implementation is bad." :type 'boolean) (defcustom org-return-follows-link nil - "Non-nil means on links RET will follow the link. -Needs to be set before org.el is loaded." + "Non-nil means on links RET will follow the link." :group 'org-link-follow :type 'boolean) @@ -1305,15 +1432,16 @@ Needs to be set before org.el is loaded." :type 'boolean) (defcustom org-mark-ring-length 4 - "Number of different positions to be recorded in the ring + "Number of different positions to be recorded in the ring. Changing this requires a restart of Emacs to work correctly." :group 'org-link-follow :type 'integer) (defcustom org-link-frame-setup '((vm . vm-visit-folder-other-frame) - (gnus . gnus-other-frame) - (file . find-file-other-window)) + (gnus . org-gnus-no-new-news) + (file . find-file-other-window) + (wl . wl-other-frame)) "Setup the frame configuration for following links. When following a link with Emacs, it may often be useful to display this link in another window or frame. This variable can be used to @@ -1329,6 +1457,9 @@ For FILE, use any of `find-file' `find-file-other-window' `find-file-other-frame' +For Wanderlust use any of + `wl' + `wl-other-frame' For the calendar, use the variable `calendar-setup'. For BBDB, it is currently only possible to display the matches in another window." @@ -1348,13 +1479,18 @@ another window." (choice (const find-file) (const find-file-other-window) - (const find-file-other-frame))))) + (const find-file-other-frame))) + (cons (const wl) + (choice + (const wl) + (const wl-other-frame))))) (defcustom org-display-internal-link-with-indirect-buffer nil "Non-nil means use indirect buffer to display infile links. Activating internal links (from one location in a file to another location in the same file) normally just jumps to the location. When the link is -activated with a C-u prefix (or with mouse-3), the link is displayed in +activated with a \\[universal-argument] prefix (or with mouse-3), the link \ +is displayed in another window. When this option is set, the other window actually displays an indirect buffer clone of the current buffer, to avoid any visibility changes to the current buffer." @@ -1379,7 +1515,7 @@ window on that directory." (defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") "Function and arguments to call for following mailto links. -This is a list with the first element being a lisp function, and the +This is a list with the first element being a Lisp function, and the remaining elements being arguments to the function. In string arguments, %a will be replaced by the address, and %s will be replaced by the subject if one was given like in <mailto:arthur@galaxy.org::this subject>." @@ -1406,6 +1542,9 @@ single keystroke rather than having to type \"yes\"." (const :tag "with yes-or-no (safer)" yes-or-no-p) (const :tag "with y-or-n (faster)" y-or-n-p) (const :tag "no confirmation (dangerous)" nil))) +(put 'org-confirm-shell-link-function + 'safe-local-variable + '(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) (defcustom org-confirm-elisp-link-function 'yes-or-no-p "Non-nil means ask for confirmation before executing Emacs Lisp links. @@ -1423,6 +1562,9 @@ single keystroke rather than having to type \"yes\"." (const :tag "with yes-or-no (safer)" yes-or-no-p) (const :tag "with y-or-n (faster)" y-or-n-p) (const :tag "no confirmation (dangerous)" nil))) +(put 'org-confirm-shell-link-function + 'safe-local-variable + '(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) (defconst org-file-apps-defaults-gnu '((remote . emacs) @@ -1474,10 +1616,37 @@ you can use this variable to set the application for a given file extension. The entries in this list are cons cells where the car identifies files and the cdr the corresponding command. Possible values for the file identifier are - \"regex\" Regular expression matched against the file: link. For - backward compatibility, this can also be a string with only - alphanumeric characters, which is then interpreted as an - extension. + \"string\" A string as a file identifier can be interpreted in different + ways, depending on its contents: + + - Alphanumeric characters only: + Match links with this file extension. + Example: (\"pdf\" . \"evince %s\") + to open PDFs with evince. + + - Regular expression: Match links where the + filename matches the regexp. If you want to + use groups here, use shy groups. + + Example: (\"\\.x?html\\'\" . \"firefox %s\") + (\"\\(?:xhtml\\|html\\)\" . \"firefox %s\") + to open *.html and *.xhtml with firefox. + + - Regular expression which contains (non-shy) groups: + Match links where the whole link, including \"::\", and + anything after that, matches the regexp. + In a custom command string, %1, %2, etc. are replaced with + the parts of the link that were matched by the groups. + For backwards compatibility, if a command string is given + that does not use any of the group matches, this case is + handled identically to the second one (i.e. match against + file name only). + In a custom lisp form, you can access the group matches with + (match-string n link). + + Example: (\"\\.pdf::\\(\\d+\\)\\'\" . \"evince -p %1 %s\") + to open [[file:document.pdf::5]] with evince at page 5. + `directory' Matches a directory `remote' Matches a remote file, accessible through tramp or efs. Remote files most likely should be visited through Emacs @@ -1491,7 +1660,7 @@ file identifier are `system' The system command to open files, like `open' on Windows and Mac OS X, and mailcap under GNU/Linux. This is the command that will be selected if you call `C-c C-o' with a double - `C-u C-u' prefix. + \\[universal-argument] \\[universal-argument] prefix. Possible values for the command are: `emacs' The file will be visited by the current Emacs process. @@ -1506,13 +1675,9 @@ Possible values for the command are: does define this command, but you can overrule/replace it here. string A command to be executed by a shell; %s will be replaced - by the path to the file. If the file identifier is a regex, - %n will be replaced by the match of the nth match group. + by the path to the file. sexp A Lisp form which will be evaluated. The file path will - be available in the Lisp variable `file', the link itself - in the Lisp variable `link'. If the file identifier is a regex, - the original match data will be restored, so subexpression - matches are accessible using (match-string n link). + be available in the Lisp variable `file'. For more examples, see the system specific constants `org-file-apps-defaults-macosx' `org-file-apps-defaults-windowsnt' @@ -1534,6 +1699,8 @@ For more examples, see the system specific constants (string :tag "Command") (sexp :tag "Lisp form"))))) + + (defgroup org-refile nil "Options concerning refiling entries in Org-mode." :tag "Org Refile" @@ -1557,10 +1724,8 @@ following situations: (defcustom org-default-notes-file (convert-standard-filename "~/.notes") "Default target for storing notes. -Used by the hooks for remember.el. This can be a string, or nil to mean -the value of `remember-data-file'. -You can set this on a per-template basis with the variable -`org-remember-templates'." +Used as a fall back file for org-remember.el and org-capture.el, for +templates that do not specify a target file." :group 'org-refile :group 'org-remember :type '(choice @@ -1582,7 +1747,7 @@ outline-path-completion Headlines in the current buffer are offered via (const :tag "Outline-path-completion" outline-path-completion))) (defcustom org-goto-max-level 5 - "Maximum level to be considered when running org-goto with refile interface." + "Maximum target level when running `org-goto' with refile interface." :group 'org-refile :type 'integer) @@ -1651,7 +1816,7 @@ This is list of cons cells. Each cell contains: order in hierarchy, not to the number of stars. You can set the variable `org-refile-target-verify-function' to a function -to verify each headline found by the simple critery above. +to verify each headline found by the simple criteria above. When this variable is nil, all top-level headlines in the current buffer are used, equivalent to the value `((nil . (:level . 1))'." @@ -1683,6 +1848,17 @@ of the subtree." :group 'org-refile :type 'function) +(defcustom org-refile-use-cache nil + "Non-nil means cache refile targets to speed up the process. +The cache for a particular file will be updated automatically when +the buffer has been killed, or when any of the marker used for flagging +refile targets no longer points at a live buffer. +If you have added new entries to a buffer that might themselves be targets, +you need to clear the cache manually by pressing `C-0 C-c C-w' or, if you +find that easier, `C-u C-u C-u C-c C-w'." + :group 'org-refile + :type 'boolean) + (defcustom org-refile-use-outline-path nil "Non-nil means provide refile targets as paths. So a level 3 headline will be available as level1/level2/level3. @@ -1742,9 +1918,8 @@ heading." '( (:tag "Sequence (cycling hits every state)" sequence) (:tag "Type (cycling directly to DONE)" type)) - "The available interpretation symbols for customizing - `org-todo-keywords'. - Interested libraries should add to this list.") + "The available interpretation symbols for customizing `org-todo-keywords'. +Interested libraries should add to this list.") (defcustom org-todo-keywords '((sequence "TODO" "DONE")) "List of TODO entry keyword sequences and their interpretation. @@ -1770,7 +1945,7 @@ Each keyword can optionally specify a character for fast state selection \(in combination with the variable `org-use-fast-todo-selection') and specifiers for state change logging, using the same syntax that is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says -that the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" +that the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" indicates to record a time stamp each time this state is selected. Each keyword may also specify if a timestamp or a note should be @@ -2114,6 +2289,7 @@ The value is an alist, with the car being a symbol indicating the note context, and the cdr is the heading to be used. The heading may also be the empty string. %t in the heading will be replaced by a time stamp. +%T will be an active time stamp instead the default inactive one %s will be replaced by the new TODO state, in double quotes. %S will be replaced by the old TODO state, in double quotes. %u will be replaced by the user name. @@ -2195,10 +2371,19 @@ When nil, the state change notes will be ordered according to time." :group 'org-progress :type 'boolean) +(defcustom org-todo-repeat-to-state nil + "The TODO state to which a repeater should return the repeating task. +By default this is the first task in a TODO sequence, or the previous state +in a TODO_TYP set. But you can specify another task here. +alternatively, set the :REPEAT_TO_STATE: property of the entry." + :group 'org-todo + :type '(choice (const :tag "Head of sequence" nil) + (string :tag "Specific state"))) + (defcustom org-log-repeat 'time "Non-nil means record moving through the DONE state when triggering repeat. An auto-repeating task is immediately switched back to TODO when -marked DONE. If you are not logging state changes (by adding \"@\" +marked DONE. If you are not logging state changes (by adding \"@\" or \"!\" to the TODO keyword definition), or set `org-log-done' to record a closing note, there will be no record of the task moving through DONE. This variable forces taking a note anyway. @@ -2287,12 +2472,12 @@ of N minutes, as given by the second value. When a setting is 0 or 1, insert the time unmodified. Useful rounding numbers should be factors of 60, so for example 5, 10, 15. -When this is larger than 1, you can still force an exact time-stamp by using -a double prefix argument to a time-stamp command like `C-c .' or `C-c !', +When this is larger than 1, you can still force an exact time stamp by using +a double prefix argument to a time stamp command like `C-c .' or `C-c !', and by using a prefix arg to `S-up/down' to specify the exact number of minutes to shift." :group 'org-time - :get '(lambda (var) ; Make sure all entries have 5 elements + :get '(lambda (var) ; Make sure both elements are there (if (integerp (default-value var)) (list (default-value var) 5) (default-value var))) @@ -2335,8 +2520,8 @@ commands, if custom time display is turned on at the time of export." f))) (defcustom org-time-clocksum-format "%d:%02d" - "The format string used when creating CLOCKSUM lines, or when -org-mode generates a time duration." + "The format string used when creating CLOCKSUM lines. +This is also used when org-mode generates a time duration." :group 'org-time :type 'string) @@ -2367,8 +2552,8 @@ Custom commands can set this variable in the options section." "Non-nil means assume future for incomplete date input from user. This affects the following situations: 1. The user gives a month but not a year. - For example, if it is april and you enter \"feb 2\", this will be read - as feb 2, *next* year. \"May 5\", however, will be this year. + For example, if it is April and you enter \"feb 2\", this will be read + as Feb 2, *next* year. \"May 5\", however, will be this year. 2. The user gives a day, but no month. For example, if today is the 15th, and you enter \"3\", Org-mode will read this as the third of *next* month. However, if you enter \"17\", @@ -2618,7 +2803,7 @@ is better to limit inheritance to certain tags using the variables (const :tag "List them, indented with leading dots" indented))) (defcustom org-tags-sort-function nil - "When set, tags are sorted using this function as a comparator" + "When set, tags are sorted using this function as a comparator." :group 'org-tags :type '(choice (const :tag "No sorting" nil) @@ -2649,7 +2834,7 @@ lined-up with respect to each other." (defcustom org-use-property-inheritance nil "Non-nil means properties apply also for sublevels. -This setting is chiefly used during property searches. Turning it on can +This setting is chiefly used during property searches. Turning it on can cause significant overhead when doing a search, which is why it is not on by default. @@ -2948,32 +3133,49 @@ will be appended." (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) + (if (and (consp x) (= (length x) 2)) + (list (car x) (nth 1 x) t) + x)) + 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)) + (list (car x) (nth 1 x) t) + 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 - '(("AUTO" "inputenc") - ("T1" "fontenc") - ("" "fixltx2e") - ("" "graphicx") - ("" "longtable") - ("" "float") - ("" "wrapfig") - ("" "soul") - ("" "t1enc") - ("" "textcomp") - ("" "marvosym") - ("" "wasysym") - ("" "latexsym") - ("" "amssymb") - ("" "hyperref") + '(("AUTO" "inputenc" t) + ("T1" "fontenc" t) + ("" "fixltx2e" nil) + ("" "graphicx" t) + ("" "longtable" nil) + ("" "float" nil) + ("" "wrapfig" nil) + ("" "soul" t) + ("" "t1enc" t) + ("" "textcomp" t) + ("" "marvosym" t) + ("" "wasysym" t) + ("" "latexsym" t) + ("" "amssymb" t) + ("" "hyperref" nil) "\\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. +to function properly. - inputenc, fontenc, t1enc: for basic font and character selection - textcomp, marvosymb, wasysym, latexsym, amssym: for various symbols used @@ -2987,31 +3189,42 @@ to function properly. 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\" \)." +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." :group 'org-export-latex + :set 'org-set-packages-alist + :get 'org-get-packages-alist :type '(repeat - (choice - (string :tag "A line of LaTeX") + (choice (list :tag "options/package pair" (string :tag "options") - (string :tag "package"))))) + (string :tag "package") + (boolean :tag "Snippet")) + (string :tag "A line of LaTeX")))) (defcustom org-export-latex-packages-alist nil - "Alist of packages to be inserted in every LaTeX the header. + "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\" \). -Make sure that you only lis packages here which: +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. +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'." :group 'org-export-latex + :set 'org-set-packages-alist + :get 'org-get-packages-alist :type '(repeat - (choice - (string :tag "A line of LaTeX") + (choice (list :tag "options/package pair" (string :tag "options") - (string :tag "package"))))) + (string :tag "package") + (boolean :tag "Snippet")) + (string :tag "A line of LaTeX")))) + (defgroup org-appearance nil "Settings for Org-mode appearance." @@ -3084,8 +3297,25 @@ org-level-* faces." :group 'org-appearance :type 'boolean) +(defcustom org-pretty-entities nil + "Non-nil means show entities as UTF8 characters. +When nil, the \\name form remains in the buffer." + :group 'org-appearance + :type 'boolean) + +(defcustom org-pretty-entities-include-sub-superscripts t + "Non-nil means, pretty entity display includes formatting sub/superscripts." + :group 'org-appearance + :type 'boolean) + (defvar org-emph-re nil - "Regular expression for matching emphasis.") + "Regular expression for matching emphasis. +After a match, the match groups contain these elements: +1 The character before the proper match, or empty at beginning of line +2 The proper match, including the leading and trailing markers +3 The leading marker like * or /, indicating the type of highlighting +4 The text between the emphasis markers, not including the markers +5 The character after the match, empty at the end of a line") (defvar org-verbatim-re nil "Regular expression for matching verbatim text.") (defvar org-emphasis-regexp-components) ; defined just below @@ -3187,6 +3417,7 @@ 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." :group 'org-appearance :set 'org-set-emph-re @@ -3282,6 +3513,7 @@ 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" ()) (defvar remember-data-file) (defvar texmathp-why) (declare-function speedbar-line-directory "speedbar" (&optional depth)) @@ -3298,18 +3530,18 @@ Normal means no org-mode-specific context." ;; by the functions setting up org-mode or checking for table context. (defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" - "Detects an org-type or table-type table.") + "Detect an org-type or table-type table.") (defconst org-table-line-regexp "^[ \t]*|" - "Detects an org-type table line.") + "Detect an org-type table line.") (defconst org-table-dataline-regexp "^[ \t]*|[^-]" - "Detects an org-type table line.") + "Detect an org-type table line.") (defconst org-table-hline-regexp "^[ \t]*|-" - "Detects an org-type table hline.") + "Detect an org-type table hline.") (defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" - "Detects a table-type table hline.") + "Detect a table-type table hline.") (defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" - "Searching from within a table (any type) this finds the first line -outside the table.") + "Detect the first line outside a table when searching from within it. +This works for both table types.") ;; Autoload the functions in org-table.el that are needed by functions here. @@ -3336,7 +3568,9 @@ outside the table.") org-table-rotate-recalc-marks org-table-sort-lines org-table-sum org-table-toggle-coordinate-overlays org-table-toggle-formula-debugger org-table-wrap-region - orgtbl-mode turn-on-orgtbl org-table-to-lisp))) + orgtbl-mode turn-on-orgtbl org-table-to-lisp + orgtbl-to-generic orgtbl-to-tsv orgtbl-to-csv orgtbl-to-latex + orgtbl-to-orgtbl orgtbl-to-html orgtbl-to-texinfo))) (defun org-at-table-p (&optional table-type) "Return t if the cursor is inside an org-type table. @@ -3376,7 +3610,7 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (message "recognizing table.el table...") (table-recognize-table) (message "recognizing table.el table...done"))) - (error "This should not happen...")) + (error "This should not happen")) t) nil) nil)) @@ -3391,21 +3625,22 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (defvar org-table-clean-did-remove-column nil) -(defun org-table-map-tables (function) +(defun org-table-map-tables (function &optional quietly) "Apply FUNCTION to the start of all tables in the buffer." (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (re-search-forward org-table-any-line-regexp nil t) - (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) + (unless quietly + (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size)))) (beginning-of-line 1) (when (looking-at org-table-line-regexp) (save-excursion (funcall function)) (or (looking-at org-table-line-regexp) (forward-char 1))) (re-search-forward org-table-any-border-regexp nil 1)))) - (message "Mapping tables: done")) + (unless quietly (message "Mapping tables: done"))) ;; Declare and autoload functions from org-exp.el & Co @@ -3459,6 +3694,11 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." '(org-remember-insinuate org-remember-annotation org-remember-apply-template org-remember org-remember-handler))) +(eval-and-compile + (org-autoload "org-capture" + '(org-capture org-capture-insert-template-here + org-capture-import-remember-templates))) + ;; Autoload org-clock.el @@ -3825,7 +4065,7 @@ Also put tags into group 4 if tags are present.") "Matches any of the 3 keywords, together with the time stamp.") (make-variable-buffer-local 'org-keyword-time-not-clock-regexp) (defvar org-maybe-keyword-time-regexp nil - "Matches a timestamp, possibly preceeded by a keyword.") + "Matches a timestamp, possibly preceded by a keyword.") (make-variable-buffer-local 'org-maybe-keyword-time-regexp) (defvar org-planning-or-clock-line-re nil "Matches a line with planning or clock info.") @@ -3921,7 +4161,9 @@ After a match, the following groups carry important information: ("noptag" org-tag-persistent-alist nil) ("hideblocks" org-hide-block-startup t) ("nohideblocks" org-hide-block-startup nil) - ("beamer" org-startup-with-beamer-mode t)) + ("beamer" org-startup-with-beamer-mode t) + ("entitiespretty" org-pretty-entities t) + ("entitiesplain" org-pretty-entities nil)) "Variable associated with STARTUP options for org-mode. Each element is a list of three items: The startup options as written in the #+STARTUP line, the corresponding variable, and the value to @@ -3944,9 +4186,11 @@ means to push this value onto the list in the variable.") (let ((re (org-make-options-regexp '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" - "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE" "LATEX_CLASS") + "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE" "LATEX_CLASS" + "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)) @@ -3961,10 +4205,9 @@ means to push this value onto the list in the variable.") (re-search-forward re nil t))) (setq key (upcase (match-string 1 ext-setup-or-nil)) value (org-match-string-no-properties 2 ext-setup-or-nil)) + (if (stringp value) (setq value (org-trim value))) (cond ((equal key "CATEGORY") - (if (string-match "[ \t]+$" value) - (setq value (replace-match "" t t value))) (setq cat value)) ((member key '("SEQ_TODO" "TODO")) (push (cons 'sequence (org-split-string value splitre)) kwds)) @@ -4015,12 +4258,14 @@ means to push this value onto the list in the variable.") (set (make-local-variable var) (symbol-value var)) (add-to-list var val)))))) ((equal key "ARCHIVE") - (string-match " *$" value) - (setq arch (replace-match "" t t value)) + (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") (setq setup-contents (org-file-contents (expand-file-name @@ -4033,6 +4278,7 @@ means to push this value onto the list in the variable.") "\n" setup-contents "\n" (substring ext-setup-or-nil start))))) )))) + (org-set-local 'org-use-sub-superscripts scripts) (when cat (org-set-local 'org-category (intern cat)) (push (cons "CATEGORY" cat) props)) @@ -4159,7 +4405,11 @@ means to push this value onto the list in the variable.") org-complex-heading-regexp-format (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(%s\\)" + "\\)\\>\\)?" + "\\(?:[ \t]*\\(\\[#.\\]\\)\\)?" + "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie + "[ \t]*\\(%s\\)" + "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") org-nl-done-regexp (concat "\n\\*+[ \t]+" @@ -4222,10 +4472,10 @@ means to push this value onto the list in the variable.") (not (file-readable-p file))) (if noerror (progn - (message "Cannot read file %s" file) + (message "Cannot read file \"%s\"" file) (ding) (sit-for 2) "") - (error "Cannot read file %s" file)) + (error "Cannot read file \"%s\"" file)) (with-temp-buffer (insert-file-contents file) (buffer-string)))) @@ -4298,7 +4548,7 @@ This is for getting out of special buffers like remember.") ;;;; Define the Org-mode (if (and (not (keymapp outline-mode-map)) (featurep 'allout)) - (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22.")) + (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22")) ;; We use a before-change function to check if a table might need @@ -4345,7 +4595,7 @@ The following commands are available: ;; we switch another buffer into org-mode. (if (featurep 'xemacs) (when (boundp 'outline-mode-menu-heading) - ;; Assume this is Greg's port, it used easymenu + ;; Assume this is Greg's port, it uses easymenu (easy-menu-remove outline-mode-menu-heading) (easy-menu-remove outline-mode-menu-show) (easy-menu-remove outline-mode-menu-hide)) @@ -4357,9 +4607,9 @@ The following commands are available: (easy-menu-add org-org-menu) (easy-menu-add org-tbl-menu) (org-install-agenda-files-menu) - (if org-descriptive-links (org-add-to-invisibility-spec '(org-link))) - (org-add-to-invisibility-spec '(org-cwidth)) - (org-add-to-invisibility-spec '(org-hide-block . t)) + (if org-descriptive-links (add-to-invisibility-spec '(org-link))) + (add-to-invisibility-spec '(org-cwidth)) + (add-to-invisibility-spec '(org-hide-block . t)) (when (featurep 'xemacs) (org-set-local 'line-move-ignore-invisible t)) (org-set-local 'outline-regexp org-outline-regexp) @@ -4382,7 +4632,6 @@ The following commands are available: (org-set-tag-faces 'org-tag-faces org-tag-faces)) ;; Calc embedded (org-set-local 'calc-embedded-open-mode "# ") - (modify-syntax-entry ?# "<") (modify-syntax-entry ?@ "w") (if org-startup-truncated (setq truncate-lines t)) (org-set-local 'font-lock-unfontify-region-function @@ -4397,6 +4646,9 @@ The following commands are available: (org-set-autofill-regexps) (setq indent-line-function 'org-indent-line-function) (org-update-radio-target-regexp) + ;; Beginning/end of defun + (org-set-local 'beginning-of-defun-function 'org-beginning-of-defun) + (org-set-local 'end-of-defun-function 'org-end-of-defun) ;; Make sure dependence stuff works reliably, even for users who set it ;; too late :-( (if org-enforce-todo-dependencies @@ -4411,7 +4663,7 @@ The following commands are available: 'org-block-todo-from-checkboxes)) ;; Comment characters -; (org-set-local 'comment-start "#") ;; FIXME: this breaks wrapping + (org-set-local 'comment-start "#") (org-set-local 'comment-padding " ") ;; Align options lines @@ -4445,7 +4697,7 @@ The following commands are available: (unless org-inhibit-startup (when org-startup-align-all-tables (let ((bmp (buffer-modified-p))) - (org-table-map-tables 'org-table-align) + (org-table-map-tables 'org-table-align 'quietly) (set-buffer-modified-p bmp))) (when org-startup-indented (require 'org-indent) @@ -4472,10 +4724,8 @@ The following commands are available: ;;;; Font-Lock stuff, including the activators (defvar org-mouse-map (make-sparse-keymap)) -(org-defkey org-mouse-map - (if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse) -(org-defkey org-mouse-map - (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse) +(org-defkey org-mouse-map [mouse-2] 'org-open-at-mouse) +(org-defkey org-mouse-map [mouse-3] 'org-find-file-at-mouse) (when org-mouse-1-follows-link (org-defkey org-mouse-map [follow-link] 'mouse-face)) (when org-tab-follows-link @@ -4486,7 +4736,7 @@ The following commands are available: (defconst org-non-link-chars "]\t\n\r<>") (defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" - "shell" "elisp")) + "shell" "elisp" "doi")) (defvar org-link-types-re nil "Matches a link that has a url-like prefix like \"http:\"") (defvar org-link-re-with-space nil @@ -4510,10 +4760,51 @@ Here is what the match groups contain after a match: 4: [desc] 5: desc") (defvar org-bracket-link-analytic-regexp++ nil - "Like org-bracket-link-analytic-regexp, but include coderef internal type.") + "Like `org-bracket-link-analytic-regexp', but include coderef internal type.") (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) + +(defun org-create-multibrace-regexp (left right n) + "Create a regular expression which will match a balanced sexp. +Opening delimiter is LEFT, and closing delimiter is RIGHT, both given +as single character strings. +The regexp returned will match the entire expression including the +delimiters. It will also define a single group which contains the +match except for the outermost delimiters. The maximum depth of +stacked delimiters is N. Escaping delimiters is not possible." + (let* ((nothing (concat "[^" left right "]*?")) + (or "\\|") + (re nothing) + (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) + (while (> n 1) + (setq n (1- n) + re (concat re or next) + next (concat "\\(?:" nothing left next right "\\)+" nothing))) + (concat left "\\(" re "\\)" right))) + +(defvar org-match-substring-regexp + (concat + "\\([^\\]\\)\\([_^]\\)\\(" + "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" + "\\|" + "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" + "\\|" + "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") + "The regular expression matching a sub- or superscript.") + +(defvar org-match-substring-with-braces-regexp + (concat + "\\([^\\]\\)\\([_^]\\)\\(" + "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" + "\\)") + "The regular expression matching a sub- or superscript, forcing braces.") + (defun org-make-link-regexps () "Update the link regular expressions. This should be called after the variable `org-link-types' has changed." @@ -4618,7 +4909,7 @@ The time stamps may be either active or inactive.") (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))) (add-text-properties (match-beginning 2) (match-end 2) - '(font-lock-multiline t)) + '(font-lock-multiline t org-emphasis t)) (when org-hide-emphasis-markers (add-text-properties (match-end 4) (match-beginning 5) '(invisible org-link)) @@ -4735,7 +5026,7 @@ will be prompted for." '(font-lock-fontified t face org-block)) t) ((and (match-end 4) (equal dc3 "begin")) - ;; Truely a block + ;; Truly a block (setq block-type (downcase (match-string 5)) quoting (member block-type org-protecting-blocks)) (when (re-search-forward @@ -4777,7 +5068,8 @@ will be prompted for." '(font-lock-fontified t face org-meta-line)) t) ((or (member dc1 '("begin:" "end:" "caption:" "label:" - "orgtbl:" "tblfm:" "tblname:")) + "orgtbl:" "tblfm:" "tblname:" "result:" + "results:" "source:" "srcname:" "call:")) (and (match-end 4) (equal dc3 "attr"))) (add-text-properties beg (match-end 0) @@ -4955,13 +5247,17 @@ will be prompted for." (if org-export-with-TeX-macros (list (concat "\\\\" (regexp-opt - (append (mapcar 'car (append org-entities-user - org-entities)) - (if (boundp 'org-latex-entities) - (mapcar (lambda (x) - (or (car-safe x) x)) - org-latex-entities) - nil)) + (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]+\\)"))) @@ -5000,7 +5296,7 @@ will be prompted for." rtn))) (defun org-restart-font-lock () - "Restart font-lock-mode, to force refontification." + "Restart `font-lock-mode', to force refontification." (when (and (boundp 'font-lock-mode) font-lock-mode) (font-lock-mode -1) (font-lock-mode 1))) @@ -5045,7 +5341,7 @@ 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. +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'. For plain list items, if they are matched by `outline-regexp', this returns @@ -5145,6 +5441,8 @@ For plain list items, if they are matched by `outline-regexp', this returns '(1 'org-archived prepend)) ;; Specials '(org-do-latex-and-special-faces) + '(org-fontify-entities) + '(org-raise-scripts) ;; Code '(org-activate-code (1 'org-code t)) ;; COMMENT @@ -5162,8 +5460,41 @@ For plain list items, if they are matched by `outline-regexp', this returns '(org-font-lock-keywords t nil nil backward-paragraph)) (kill-local-variable 'font-lock-keywords) nil)) +(defun org-toggle-pretty-entities () + "Toggle the composition display of entities as UTF8 characters." + (interactive) + (org-set-local 'org-pretty-entities (not org-pretty-entities)) + (org-restart-font-lock) + (if org-pretty-entities + (message "Entities are displayed as UTF8 characers") + (save-restriction + (widen) + (decompose-region (point-min) (point-max)) + (message "Entities are displayed plain")))) + +(defun org-fontify-entities (limit) + "Find an entity to fontify." + (let (ee) + (when org-pretty-entities + (catch 'match + (while (re-search-forward + "\\\\\\([a-zA-Z][a-zA-Z0-9]*\\)\\($\\|[^[:alnum:]\n]\\)" + limit t) + (if (and (not (org-in-indented-comment-line)) + (setq ee (org-entity-get (match-string 1))) + (= (length (nth 6 ee)) 1)) + (progn + (add-text-properties + (match-beginning 0) (match-end 1) + (list 'font-lock-fontified t)) + (compose-region (match-beginning 0) (match-end 1) + (nth 6 ee) nil) + (backward-char 1) + (throw 'match t)))) + nil)))) + (defun org-fontify-like-in-org-mode (s &optional odd-levels) - "Fontify string S like in Org-mode" + "Fontify string S like in Org-mode." (with-temp-buffer (insert s) (let ((org-odd-levels-only odd-levels)) @@ -5238,6 +5569,7 @@ If KWD is a number, get the corresponding match group." (inhibit-read-only t) (inhibit-point-motion-hooks t) (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename) + (decompose-region beg end) (remove-text-properties beg end (if org-indent-mode @@ -5245,10 +5577,69 @@ If KWD is a number, get the corresponding match group." '(mouse-face t keymap t org-linked-text t invisible t intangible t line-prefix t wrap-prefix t - org-no-flyspell t) + org-no-flyspell t org-emphasis t) '(mouse-face t keymap t org-linked-text t invisible t intangible t - org-no-flyspell t))))) + org-no-flyspell t org-emphasis t))) + (org-remove-font-lock-display-properties beg end))) + +(defconst org-script-display '(((raise -0.3) (height 0.7)) + ((raise 0.3) (height 0.7)) + ((raise -0.5)) + ((raise 0.5))) + "Display properties for showing superscripts and subscripts.") + +(defun org-remove-font-lock-display-properties (beg end) + "Remove specific display properties that have been added by font lock. +The will remove the raise properties that are used to show superscripts +and subscripts." + (let (next prop) + (while (< beg end) + (setq next (next-single-property-change beg 'display nil end) + prop (get-text-property beg 'display)) + (if (member prop org-script-display) + (put-text-property beg next 'display nil)) + (setq beg next)))) + +(defun org-raise-scripts (limit) + "Add raise properties to sub/superscripts." + (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts) + (if (re-search-forward + (if (eq org-use-sub-superscripts t) + org-match-substring-regexp + org-match-substring-with-braces-regexp) + limit t) + (let* ((pos (point)) table-p comment-p + (mpos (match-beginning 3)) + (emph-p (get-text-property mpos 'org-emphasis)) + (link-p (get-text-property mpos 'mouse-face)) + (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) + (goto-char (point-at-bol)) + (setq table-p (org-looking-at-p org-table-dataline-regexp) + comment-p (org-looking-at-p "[ \t]*#")) + (goto-char pos) + ;; FIXME: Should we go back one character here, for a_b^c + ;; (goto-char (1- pos)) ;???????????????????? + (if (or comment-p emph-p link-p keyw-p) + t + (put-text-property (match-beginning 3) (match-end 0) + 'display + (if (equal (char-after (match-beginning 2)) ?^) + (nth (if table-p 3 1) org-script-display) + (nth (if table-p 2 0) org-script-display))) + (add-text-properties (match-beginning 2) (match-end 2) + (list 'invisible t + 'org-dwidth t 'org-dwidth-n 1)) + (if (and (eq (char-after (match-beginning 3)) ?{) + (eq (char-before (match-end 3)) ?})) + (progn + (add-text-properties + (match-beginning 3) (1+ (match-beginning 3)) + (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)) + (add-text-properties + (1- (match-end 3)) (match-end 3) + (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)))) + t))))) ;;;; Visibility cycling, including org-goto and indirect buffer @@ -5295,7 +5686,7 @@ in special contexts. - When point is at the beginning of an empty headline and the variable `org-cycle-level-after-item/entry-creation' is set, cycle the level of the headline by demoting and promoting it to likely levels. This - speeds up creation document structure by presing TAB once or several + speeds up creation document structure by pressing TAB once or several times right after creating a new headline. - When there is a numeric prefix, go up to a heading with level ARG, do @@ -5473,7 +5864,6 @@ in special contexts. (while (and (not (eobp)) ;; this is like `next-line' (get-char-property (1- (point)) 'invisible)) (goto-char (next-single-char-property-change (point) 'invisible)) -;;;??? (or (bolp) (beginning-of-line 2)))) (and (eolp) (beginning-of-line 2)))) (setq eol (point))) (outline-end-of-heading) (setq eoh (point)) @@ -5535,7 +5925,7 @@ in special contexts. ;;;###autoload (defun org-global-cycle (&optional arg) "Cycle the global visibility. For details see `org-cycle'. -With C-u prefix arg, switch to startup visibility. +With \\[universal-argument] prefix arg, switch to startup visibility. With a numeric prefix, show all headlines up to that level." (interactive "P") (let ((org-cycle-include-plain-lists @@ -5564,7 +5954,7 @@ With a numeric prefix, show all headlines up to that level." (org-set-visibility-according-to-property 'no-cleanup) (org-cycle-hide-archived-subtrees 'all) (org-cycle-hide-drawers 'all) - (org-cycle-show-empty-lines 'all))) + (org-cycle-show-empty-lines t))) (defun org-set-visibility-according-to-property (&optional no-cleanup) "Switch subtree visibilities according to :VISIBILITY: property." @@ -5648,11 +6038,11 @@ This function is the default value of the hook `org-cycle-hook'." "Remove outline overlays that do not contain non-white stuff." (mapc (lambda (o) - (and (eq 'outline (org-overlay-get o 'invisible)) - (not (string-match "\\S-" (buffer-substring (org-overlay-start o) - (org-overlay-end o)))) - (org-delete-overlay o))) - (org-overlays-at pos))) + (and (eq 'outline (overlay-get o 'invisible)) + (not (string-match "\\S-" (buffer-substring (overlay-start o) + (overlay-end o)))) + (delete-overlay o))) + (overlays-at pos))) (defun org-clean-visibility-after-subtree-move () "Fix visibility issues after moving a subtree." @@ -5805,7 +6195,7 @@ Optional argument N means put the headline into the Nth line of the window." (defun org-outline-overlay-data (&optional use-markers) "Return a list of the locations of all outline overlays. The are overlays with the `invisible' property value `outline'. -The return valus is a list of cons cells, with start and stop +The return values is a list of cons cells, with start and stop positions for each overlay. If USE-MARKERS is set, return the positions as markers." (let (beg end) @@ -5814,15 +6204,15 @@ If USE-MARKERS is set, return the positions as markers." (widen) (delq nil (mapcar (lambda (o) - (when (eq (org-overlay-get o 'invisible) 'outline) - (setq beg (org-overlay-start o) - end (org-overlay-end o)) + (when (eq (overlay-get o 'invisible) 'outline) + (setq beg (overlay-start o) + end (overlay-end o)) (and beg end (> end beg) (if use-markers (cons (move-marker (make-marker) beg) (move-marker (make-marker) end)) (cons beg end))))) - (org-overlays-in (point-min) (point-max)))))))) + (overlays-in (point-min) (point-max)))))))) (defun org-set-outline-overlay-data (data) "Create visibility overlays for all positions in DATA. @@ -5833,8 +6223,8 @@ DATA should have been made by `org-outline-overlay-data'." (widen) (show-all) (mapc (lambda (c) - (setq o (org-make-overlay (car c) (cdr c))) - (org-overlay-put o 'invisible 'outline)) + (setq o (make-overlay (car c) (cdr c))) + (overlay-put o 'invisible 'outline)) data))))) (defmacro org-save-outline-visibility (use-markers &rest body) @@ -5844,6 +6234,7 @@ This means that the buffer may change while running BODY, but it also means that the buffer should stay alive during the operation, because otherwise all these markers will point nowhere." + (declare (indent 1)) `(let ((data (org-outline-overlay-data ,use-markers))) (unwind-protect (progn @@ -5868,9 +6259,8 @@ point nowhere." (make-variable-buffer-local 'org-hide-block-overlays) (defun org-block-map (function &optional start end) - "Call func at the head of all source blocks in the current -buffer. Optional arguments START and END can be used to limit -the range." + "Call FUNCTION at the head of all source blocks in the current buffer. +Optional arguments START and END can be used to limit the range." (let ((start (or start (point-min))) (end (or end (point-max)))) (save-excursion @@ -5893,7 +6283,8 @@ the range." (defun org-show-block-all () "Unfold all blocks in the current buffer." - (mapc 'org-delete-overlay org-hide-block-overlays) + (interactive) + (mapc 'delete-overlay org-hide-block-overlays) (setq org-hide-block-overlays nil)) (defun org-hide-block-toggle-maybe () @@ -5917,30 +6308,30 @@ the range." (end (match-end 0)) ;; end of entire body ov) (if (memq t (mapcar (lambda (overlay) - (eq (org-overlay-get overlay 'invisible) + (eq (overlay-get overlay 'invisible) 'org-hide-block)) - (org-overlays-at start))) + (overlays-at start))) (if (or (not force) (eq force 'off)) (mapc (lambda (ov) (when (member ov org-hide-block-overlays) (setq org-hide-block-overlays (delq ov org-hide-block-overlays))) - (when (eq (org-overlay-get ov 'invisible) + (when (eq (overlay-get ov 'invisible) 'org-hide-block) - (org-delete-overlay ov))) - (org-overlays-at start))) - (setq ov (org-make-overlay start end)) - (org-overlay-put ov 'invisible 'org-hide-block) + (delete-overlay ov))) + (overlays-at start))) + (setq ov (make-overlay start end)) + (overlay-put ov 'invisible 'org-hide-block) ;; make the block accessible to isearch - (org-overlay-put + (overlay-put ov 'isearch-open-invisible (lambda (ov) (when (member ov org-hide-block-overlays) (setq org-hide-block-overlays (delq ov org-hide-block-overlays))) - (when (eq (org-overlay-get ov 'invisible) + (when (eq (overlay-get ov 'invisible) 'org-hide-block) - (org-delete-overlay ov)))) + (delete-overlay ov)))) (push ov org-hide-block-overlays))) (error "Not looking at a source block")))) @@ -6157,10 +6548,12 @@ With numerical prefix ARG, go up to this level and then take that tree. If ARG is negative, go up that many levels. If `org-indirect-buffer-display' is not `new-frame', the command removes the indirect buffer previously made with this command, to avoid proliferation of -indirect buffers. However, when you call the command with a `C-u' prefix, or +indirect buffers. However, when you call the command with a \ +\\[universal-argument] prefix, or when `org-indirect-buffer-display' is `new-frame', the last buffer is kept so that you can work with several indirect buffers at the same time. -If `org-indirect-buffer-display' is `dedicated-frame', the C-u prefix also +If `org-indirect-buffer-display' is `dedicated-frame', the \ +\\[universal-argument] prefix also requests that a new frame be made for the new buffer, so that the dedicated frame is not changed." (interactive "P") @@ -6645,7 +7038,7 @@ After top level, it switches back to sibling level." (funcall fun))))) (defun org-fixup-indentation (diff) - "Change the indentation in the current entry by DIFF + "Change the indentation in the current entry by DIFF. However, if any line in the current entry has no indentation, or if it would end up with no indentation after the change, nothing at all is done." (save-excursion @@ -6683,10 +7076,11 @@ level 5 etc." (end-of-line 1)))))) (defun org-convert-to-oddeven-levels () - "Convert an org-mode file with only odd levels to one with odd and even levels. -This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a -section with an even level, conversion would destroy the structure of the file. An error -is signaled in this case." + "Convert an org-mode file with only odd levels to one with odd/even levels. +This promotes level 3 to level 2, level 5 to level 3 etc. If the +file contains a section with an even level, conversion would +destroy the structure of the file. An error is signaled in this +case." (interactive) (goto-char (point-min)) ;; First check if there are no even levels @@ -7025,18 +7419,22 @@ If yes, remember the marker and the distance to BEG." (if (org-on-heading-p) (backward-char 1)) (point)))))) +(eval-when-compile + (defvar org-property-drawer-re)) + (defun org-clone-subtree-with-time-shift (n &optional shift) "Clone the task (subtree) at point N times. The clones will be inserted as siblings. -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'. +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'. -When a valid repeater is given and the entry contains any time stamps, -the clones will become a sequence in time, with time stamps in the -subtree shifted for each clone produced. If SHIFT is nil or the -empty string, time stamps will be left alone. +When a valid repeater is given and the entry contains any time +stamps, the clones will become a sequence in time, with time +stamps in the subtree shifted for each clone produced. If SHIFT +is nil or the empty string, time stamps will be left alone. The +ID property of the original subtree is removed. If the original subtree did contain time stamps with a repeater, the following will happen: @@ -7050,7 +7448,7 @@ the following will happen: I 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 + (let (beg end template task idprop shift-n shift-what doshift nmin nmax (n-no-remove -1)) (if (not (and (integerp n) (> n 0))) (error "Invalid number of replications %s" n)) @@ -7067,6 +7465,7 @@ and still retain the repeater to cover future instances of the task." (setq nmin 1 nmax n) (org-back-to-heading t) (setq beg (point)) + (setq idprop (org-entry-get nil "ID")) (org-end-of-subtree t t) (or (bolp) (insert "\n")) (setq end (point)) @@ -7078,12 +7477,18 @@ and still retain the repeater to cover future instances of the task." (setq nmin 0 nmax (1+ nmax) n-no-remove nmax)) (goto-char end) (loop for n from nmin to nmax do - (if (not doshift) - (setq task template) - (with-temp-buffer - (insert template) - (org-mode) - (goto-char (point-min)) + ;; prepare clone + (with-temp-buffer + (insert template) + (org-mode) + (goto-char (point-min)) + (and idprop (if org-clone-delete-id + (org-entry-delete nil "ID") + (org-id-get-create t))) + (while (re-search-forward org-property-drawer-re nil t) + (org-remove-empty-drawer-at "PROPERTIES" (point))) + (goto-char (point-min)) + (when doshift (while (re-search-forward org-ts-regexp-both nil t) (org-timestamp-change (* n shift-n) shift-what)) (unless (= n n-no-remove) @@ -7092,8 +7497,8 @@ and still retain the repeater to cover future instances of the task." (save-excursion (goto-char (match-beginning 0)) (if (looking-at "<[^<>\n]+\\( +\\+[0-9]+[dwmy]\\)") - (delete-region (match-beginning 1) (match-end 1)))))) - (setq task (buffer-string)))) + (delete-region (match-beginning 1) (match-end 1))))))) + (setq task (buffer-string))) (insert task)) (goto-char beg))) @@ -7137,7 +7542,7 @@ Sorting can be alphabetically, numerically, by date/time as given by a time stamp, by a property or by priority. The command prompts for the sorting type unless it has been given to the -function through the SORTING-TYPE argument, which needs to a character, +function through the SORTING-TYPE argument, which needs to be a character, \(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?r ?R ?f ?F). Here is the precise meaning of each character: @@ -7430,15 +7835,15 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." "Keymap for the minor `orgstruct-mode'.") (defvar org-local-vars nil - "List of local variables, for use by `orgstruct-mode'") + "List of local variables, for use by `orgstruct-mode'.") ;;;###autoload (define-minor-mode orgstruct-mode - "Toggle the minor more `orgstruct-mode'. -This mode is for using Org-mode structure commands in other modes. -The following key behave as if Org-mode was active, if the cursor -is on a headline, or on a plain list item (both in the definition -of Org-mode). + "Toggle the minor mode `orgstruct-mode'. +This mode is for using Org-mode structure commands in other +modes. The following keys behave as if Org-mode were active, if +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 @@ -7489,7 +7894,7 @@ major mode, for example with \\[normal-mode]." (org-set-local 'orgstruct-is-++ t)))) (defvar orgstruct-is-++ nil - "Is orgstruct-mode in ++ version in the current-buffer?") + "Is `orgstruct-mode' in ++ version in the current-buffer?") (make-variable-buffer-local 'orgstruct-is-++) ;;;###autoload @@ -7731,7 +8136,7 @@ If yes, it should return a non-nil value after a calling `org-store-link-props' with a list of properties and values. Special properties are: -:type The link prefix. like \"http\". This must be given. +:type The link prefix, like \"http\". This must be given. :link The link, like \"http://www.astro.uva.nl/~dominik\". This is obligatory as well. :description Optional default description for the second pair @@ -7817,7 +8222,9 @@ For file links, arg negates `org-context-in-file-links'." (get-text-property (point) 'org-marker)))) (when m (org-with-point-at m - (call-interactively 'org-store-link))))) + (if (interactive-p) + (call-interactively 'org-store-link) + (org-store-link nil)))))) ((eq major-mode 'calendar-mode) (let ((cd (calendar-cursor-to-date))) @@ -8128,6 +8535,12 @@ This is the list that is used before handing over to the browser.") (defun org-fixup-message-id-for-http (s) "Replace special characters in a message id, so it can be used in an http query." + (when (string-match "%" s) + (setq s (mapconcat (lambda (c) + (if (eq c ?%) + "%25" + (char-to-string c))) + s ""))) (while (string-match "<" s) (setq s (replace-match "%3C" t t s))) (while (string-match ">" s) @@ -8295,8 +8708,9 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (t (save-match-data (if (string-match (concat "^" (regexp-quote - (file-name-as-directory - (expand-file-name ".")))) + (expand-file-name + (file-name-as-directory + default-directory)))) (expand-file-name path)) ;; We are linking a file with relative path name. (setq path (substring (expand-file-name path) @@ -8327,7 +8741,7 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (setq file (read-file-name "File: ")) (let ((pwd (file-name-as-directory (expand-file-name "."))) (pwd1 (file-name-as-directory (abbreviate-file-name - default-directory)))) + (expand-file-name "."))))) (cond ((equal arg '(16)) (setq link (org-make-link @@ -8565,6 +8979,8 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file. With a double prefix argument, try to open outside of Emacs, in the application the system uses for this file type." (interactive "P") + ;; if in a code block, then open the block's results + (unless (call-interactively #'org-babel-open-src-block-result) (org-load-modules-maybe) (move-marker org-open-link-marker (point)) (setq org-window-config-before-follow-link (current-window-configuration)) @@ -8671,6 +9087,11 @@ application the system uses for this file type." (browse-url (concat type ":" (org-link-escape path org-link-escape-chars-browser)))) + ((string= type "doi") + (browse-url (concat "http://dx.doi.org/" + (org-link-escape + path org-link-escape-chars-browser)))) + ((member type '("message")) (browse-url (concat type ":" path))) @@ -8741,7 +9162,7 @@ application the system uses for this file type." (t (browse-url-at-point))))))) (move-marker org-open-link-marker nil) - (run-hook-with-args 'org-follow-link-hook)) + (run-hook-with-args 'org-follow-link-hook))) (defun org-offer-links-in-entry (&optional nth zero) "Offer links in the current entry and follow the selected link. @@ -8811,10 +9232,10 @@ there is one, offer it as link number zero." (org-add-link-type "file+sys" 'org-open-file-with-system) (org-add-link-type "file+emacs" 'org-open-file-with-emacs) (defun org-open-file-with-system (path) - "Open file at PATH using the system way of opeing it." + "Open file at PATH using the system way of opening it." (org-open-file path 'system)) (defun org-open-file-with-emacs (path) - "Open file at PATH in emacs." + "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." @@ -8840,8 +9261,8 @@ These functions are called in turn with point at the location to which the link should point. A function in the hook should first test if it would like to -handle this file type, for example by checking the major-mode or -the file extension. If it decides not to handle this file, it +handle this file type, for example by checking the `major-mode' +or the file extension. If it decides not to handle this file, it should just return nil to give other functions a chance. If it does handle the file, it must return the search string to be used when following the link. The search string will be part of the @@ -8862,8 +9283,8 @@ buffer with \\[org-insert-link].") Functions added to this hook must accept a single argument, the search string that was part of the file link, the part after the double colon. The function must first check if it would like to -handle this search, for example by checking the major-mode or the -file extension. If it decides not to handle this search, it +handle this search, for example by checking the `major-mode' or +the file extension. If it decides not to handle this search, it should just return nil to give other functions a chance. If it does handle the search, it must return a non-nil value to keep other functions from trying. @@ -9135,20 +9556,23 @@ entry for this file type, and if yes, the corresponding command is launched. If no application is found, Emacs simply visits the file. With optional prefix argument IN-EMACS, Emacs will visit the file. -With a double C-c C-u prefix arg, Org tries to avoid opening in Emacs +With a double \\[universal-argument] \\[universal-argument] \ +prefix arg, Org tries to avoid opening in Emacs and to use an external application to visit the file. -Optional LINE specifies a line to go to, optional SEARCH a string to -search for. If LINE or SEARCH is given, but IN-EMACS is nil, it will -be assumed that org-open-file was called to open a file: link, and the -original link to match against org-file-apps will be reconstructed -from PATH and whichever of LINE or SEARCH is given. - +Optional LINE specifies a line to go to, optional SEARCH a string +to search for. If LINE or SEARCH is given, the file will be +opened in Emacs, unless an entry from org-file-apps that makes +use of groups in a regexp matches. If the file does not exist, an error is thrown." (let* ((file (if (equal path "") buffer-file-name (substitute-in-file-name (expand-file-name path)))) - (apps (append org-file-apps (org-default-apps))) + (file-apps (append org-file-apps (org-default-apps))) + (apps (org-remove-if + 'org-file-apps-entry-match-against-dlink-p file-apps)) + (apps-dlink (org-remove-if-not + 'org-file-apps-entry-match-against-dlink-p file-apps)) (remp (and (assq 'remote apps) (org-file-remote-p file))) (dirp (if remp nil (file-directory-p file))) (file (if (and dirp org-open-directory-means-index-dot-org) @@ -9180,21 +9604,19 @@ If the file does not exist, an error is thrown." (t (setq cmd (or (and remp (cdr (assoc 'remote apps))) (and dirp (cdr (assoc 'directory apps))) - ;; if we find a match in org-file-apps, store the match - ;; data for later - (let* ((re-list1 (org-apps-regexp-alist apps nil)) - (re-list2 - (if a-m-a-p - (org-apps-regexp-alist apps a-m-a-p) - re-list1)) - (private-match - (assoc-default dlink re-list1 'string-match)) - (general-match - (assoc-default dfile re-list2 'string-match))) - (if private-match + ; first, try matching against apps-dlink + ; if we get a match here, store the match data for later + (let ((match (assoc-default dlink apps-dlink + 'string-match))) + (if match (progn (setq link-match-data (match-data)) - private-match) - general-match)) + match) + (progn (setq in-emacs (or in-emacs line search)) + nil))) ; if we have no match in apps-dlink, + ; always open the file in emacs if line or search + ; is given (for backwards compatibility) + (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) + 'string-match) (cdr (assoc ext apps)) (cdr (assoc t apps)))))) (when (eq cmd 'system) @@ -9224,6 +9646,7 @@ If the file does not exist, an error is thrown." (shell-quote-argument (convert-standard-filename file))) t t cmd))) + ;; Replace "%1", "%2" etc. in command with group matches from regex (save-match-data (let ((match-index 1) @@ -9257,6 +9680,25 @@ If the file does not exist, an error is thrown." (not (equal old-pos (point)))) (org-mark-ring-push old-pos old-buffer)))) +(defun org-file-apps-entry-match-against-dlink-p (entry) + "This function returns non-nil if `entry' uses a regular +expression which should be matched against the whole link by +org-open-file. + +It assumes that is the case when the entry uses a regular +expression which has at least one grouping construct and the +action is either a lisp form or a command string containing +'%1', i.e. using at least one subexpression match as a +parameter." + (let ((selector (car entry)) + (action (cdr entry))) + (if (stringp selector) + (and (> (regexp-opt-depth selector) 0) + (or (and (stringp action) + (string-match "%[0-9]" action)) + (consp action))) + nil))) + (defun org-default-apps () "Return the default applications for this operating system." (cond @@ -9280,8 +9722,7 @@ be opened in Emacs." nil (if (string-match "\\W" (car x)) x - (cons (concat "\\." (car x) "\\(::.*\\)?\\'") - (cdr x))))) + (cons (concat "\\." (car x) "\\'") (cdr x))))) list)) (if add-auto-mode (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) @@ -9332,12 +9773,64 @@ on the system \"/user@host:\"." (defvar org-agenda-new-buffers nil "Buffers created to visit agenda files.") +(defvar org-refile-cache nil + "Cache for refile targets.") + + +(defvar org-refile-markers nil + "All the markers used for caching refile locations.") + +(defun org-refile-marker (pos) + "Get a new refile marker, but only if caching is in use." + (if (not org-refile-use-cache) + pos + (let ((m (make-marker))) + (move-marker m pos) + (push m org-refile-markers) + m))) + +(defun org-refile-cache-clear () + "Clear the refile cache and disable all the markers." + (mapc (lambda (m) (move-marker m nil)) org-refile-markers) + (setq org-refile-markers nil) + (setq org-refile-cache nil) + (message "Refile cache has been cleared")) + +(defun org-refile-cache-check-set (set) + "Check if all the markers in the cache still have live buffers." + (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 + (when (and marker (null (marker-buffer marker))) + (message "not found") (sit-for 3) + (throw 'exit nil))) + t))) + +(defun org-refile-cache-put (set &rest identifiers) + "Push the refile targets SET into the cache, under IDENTIFIERS." + (let* ((key (sha1 (prin1-to-string identifiers))) + (entry (assoc key org-refile-cache))) + (if entry + (setcdr entry set) + (push (cons key set) org-refile-cache)))) + +(defun org-refile-cache-get (&rest identifiers) + "Retrieve the cached value for refile targets given by IDENTIFIERS." + (cond + ((not org-refile-cache) nil) + ((not org-refile-use-cache) (org-refile-cache-clear) nil) + (t + (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers)) + org-refile-cache)))) + (and set (org-refile-cache-check-set set) set))))) + (defun org-get-refile-targets (&optional default-buffer) "Produce a table with refile targets." (let ((case-fold-search nil) ;; otherwise org confuses "TODO" as a kw and "Todo" as a word (entries (or org-refile-targets '((nil . (:level . 1))))) - targets txt re files f desc descre fast-path-p level pos0) + targets tgs txt re files f desc descre fast-path-p level pos0) (message "Getting targets...") (with-current-buffer (or default-buffer (current-buffer)) (while (setq entry (pop entries)) @@ -9376,46 +9869,64 @@ on the system \"/user@host:\"." (while (setq f (pop files)) (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)) - (if (bufferp f) (setq f (buffer-file-name (buffer-base-buffer f)))) - (setq f (and f (expand-file-name f))) - (if (eq org-refile-use-outline-path 'file) - (push (list (file-name-nondirectory f) f nil nil) targets)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward descre nil t) - (goto-char (setq pos0 (point-at-bol))) - (catch 'next - (when org-refile-target-verify-function - (save-match-data - (or (funcall org-refile-target-verify-function) - (throw 'next t)))) - (when (looking-at org-complex-heading-regexp) - (setq level (org-reduced-level (- (match-end 1) (match-beginning 1))) - txt (org-link-display-format (match-string 4)) - re (concat "^" (regexp-quote - (buffer-substring (match-beginning 1) - (match-end 4))))) - (if (match-end 5) (setq re (concat re "[ \t]+" - (regexp-quote - (match-string 5))))) - (setq re (concat re "[ \t]*$")) - (when org-refile-use-outline-path - (setq txt (mapconcat 'org-protect-slash - (append - (if (eq org-refile-use-outline-path 'file) - (list (file-name-nondirectory - (buffer-file-name (buffer-base-buffer)))) - (if (eq org-refile-use-outline-path 'full-file-path) - (list (buffer-file-name (buffer-base-buffer))))) - (org-get-outline-path fast-path-p level txt) - (list txt)) - "/"))) - (push (list txt f re (point)) targets))) - (when (= (point) pos0) - ;; verification function has not moved point - (goto-char (point-at-eol)))))))))) + (or + (setq tgs (org-refile-cache-get (buffer-file-name) descre)) + (progn + (if (bufferp f) (setq f (buffer-file-name + (buffer-base-buffer f)))) + (setq f (and f (expand-file-name f))) + (if (eq org-refile-use-outline-path 'file) + (push (list (file-name-nondirectory f) f nil nil) tgs)) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward descre nil t) + (goto-char (setq pos0 (point-at-bol))) + (catch 'next + (when org-refile-target-verify-function + (save-match-data + (or (funcall org-refile-target-verify-function) + (throw 'next t)))) + (when (looking-at org-complex-heading-regexp) + (setq level (org-reduced-level + (- (match-end 1) (match-beginning 1))) + txt (org-link-display-format (match-string 4)) + re (concat "^" (regexp-quote + (buffer-substring + (match-beginning 1) + (match-end 4))))) + (if (match-end 5) (setq re (concat + re "[ \t]+" + (regexp-quote + (match-string 5))))) + (setq re (concat re "[ \t]*$")) + (when org-refile-use-outline-path + (setq txt (mapconcat + 'org-protect-slash + (append + (if (eq org-refile-use-outline-path + 'file) + (list (file-name-nondirectory + (buffer-file-name + (buffer-base-buffer)))) + (if (eq org-refile-use-outline-path + 'full-file-path) + (list (buffer-file-name + (buffer-base-buffer))))) + (org-get-outline-path fast-path-p + level txt) + (list txt)) + "/"))) + (push (list txt f re (org-refile-marker (point))) + tgs))) + (when (= (point) pos0) + ;; verification function has not moved point + (goto-char (point-at-eol)))))))) + (when org-refile-use-cache + (org-refile-cache-put tgs (buffer-file-name) descre)) + (setq targets (append tgs targets)) + )))) (message "Getting targets...done") (nreverse targets))) @@ -9428,13 +9939,14 @@ on the system \"/user@host:\"." (defun org-get-outline-path (&optional fastp level heading) "Return the outline path to the current entry, as a list. -The parameters FASTP, LEVEL, and HEADING are for use be a scanner + +The parameters FASTP, LEVEL, and HEADING are for use by a scanner routine which makes outline path derivations for an entire file, -avoiding backtracing." +avoiding backtracing. Refile target collection makes use of that." (if fastp (progn (if (> level 19) - (error "Outline path failure, more than 19 levels.")) + (error "Outline path failure, more than 19 levels")) (loop for i from level upto 19 do (aset org-olpa i nil)) (prog1 @@ -9450,7 +9962,7 @@ avoiding backtracing." rtn))))) (defun org-format-outline-path (path &optional width prefix) - "Format the outlie path PATH for display. + "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." @@ -9512,6 +10024,7 @@ such as the file name." 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) "Move the entry at point to another heading. The list of target headings is compiled using the information in @@ -9523,119 +10036,130 @@ Depending on `org-reverse-note-order', the new subitem will either be the first or the last subitem. If there is an active region, all entries in that region will be moved. -However, the region must fulfil the requirement that the first heading +However, the region must fulfill the requirement that the first heading is the first one sets the top-level of the moved text - at most siblings below it are allowed. With prefix arg GOTO, the command will only visit the target location, not actually move anything. -With a double prefix `C-u C-u', go to the location where the last refiling +With a double prefix arg \\[universal-argument] \\[universal-argument], \ +go to the location where the last refiling operation has put the subtree. With a prefix argument of `2', refile to the running clock. RFLOC can be a refile location obtained in a different way. -See also `org-refile-use-outline-path' and `org-completion-use-ido'" +See also `org-refile-use-outline-path' and `org-completion-use-ido'. + +If you are using target caching (see `org-refile-use-cache'), +You have to clear the target cache in order to find new targets. +This can be done with a 0 prefix: `C-0 C-c C-w'" (interactive "P") - (let* ((cbuf (current-buffer)) - (regionp (org-region-active-p)) - (region-start (and regionp (region-beginning))) - (region-end (and regionp (region-end))) - (region-length (and regionp (- region-end region-start))) - (filename (buffer-file-name (buffer-base-buffer cbuf))) - pos it nbuf file re level reversed) - (setq last-command nil) - (when regionp - (goto-char region-start) - (or (bolp) (goto-char (point-at-bol))) - (setq region-start (point)) - (unless (org-kill-is-subtree-p - (buffer-substring region-start region-end)) - (error "The region is not a (sequence of) subtree(s)"))) - (if (equal goto '(16)) - (org-refile-goto-last-stored) - (when (or - (and (equal goto 2) - org-clock-hd-marker (marker-buffer org-clock-hd-marker) - (prog1 - (setq it (list (or org-clock-heading "running clock") - (buffer-file-name - (marker-buffer org-clock-hd-marker)) - "" - (marker-position org-clock-hd-marker))) - (setq goto nil))) - (setq it (or rfloc - (save-excursion - (org-refile-get-location - (if goto "Goto: " "Refile to: ") default-buffer - org-refile-allow-creating-parent-nodes))))) - (setq file (nth 1 it) - re (nth 2 it) - pos (nth 3 it)) - (if (and (not goto) - pos - (equal (buffer-file-name) file) - (if regionp - (and (>= pos region-start) - (<= pos region-end)) - (and (>= pos (point)) - (< pos (save-excursion - (org-end-of-subtree t t)))))) - (error "Cannot refile to position inside the tree or region")) - - (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) - (if goto - (progn - (switch-to-buffer nbuf) - (goto-char pos) - (org-show-context 'org-goto)) - (if regionp + (if (member goto '(0 (64))) + (org-refile-cache-clear) + (let* ((cbuf (current-buffer)) + (regionp (org-region-active-p)) + (region-start (and regionp (region-beginning))) + (region-end (and regionp (region-end))) + (region-length (and regionp (- region-end region-start))) + (filename (buffer-file-name (buffer-base-buffer cbuf))) + pos it nbuf file re level reversed) + (setq last-command nil) + (when regionp + (goto-char region-start) + (or (bolp) (goto-char (point-at-bol))) + (setq region-start (point)) + (unless (org-kill-is-subtree-p + (buffer-substring region-start region-end)) + (error "The region is not a (sequence of) subtree(s)"))) + (if (equal goto '(16)) + (org-refile-goto-last-stored) + (when (or + (and (equal goto 2) + org-clock-hd-marker (marker-buffer org-clock-hd-marker) + (prog1 + (setq it (list (or org-clock-heading "running clock") + (buffer-file-name + (marker-buffer org-clock-hd-marker)) + "" + (marker-position org-clock-hd-marker))) + (setq goto nil))) + (setq it (or rfloc + (save-excursion + (org-refile-get-location + (if goto "Goto: " "Refile to: ") default-buffer + org-refile-allow-creating-parent-nodes))))) + (setq file (nth 1 it) + re (nth 2 it) + pos (nth 3 it)) + (if (and (not goto) + pos + (equal (buffer-file-name) file) + (if regionp + (and (>= pos region-start) + (<= pos region-end)) + (and (>= pos (point)) + (< pos (save-excursion + (org-end-of-subtree t t)))))) + (error "Cannot refile to position inside the tree or region")) + + (setq nbuf (or (find-buffer-visiting file) + (find-file-noselect file))) + (if goto (progn - (org-kill-new (buffer-substring region-start region-end)) - (org-save-markers-in-region region-start region-end)) - (org-copy-subtree 1 nil t)) - (with-current-buffer (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) - (setq reversed (org-notes-order-reversed-p)) - (save-excursion - (save-restriction - (widen) - (if pos - (progn - (goto-char pos) - (looking-at outline-regexp) - (setq level (org-get-valid-level (funcall outline-level) 1)) - (goto-char - (if reversed - (or (outline-next-heading) (point-max)) - (or (save-excursion (org-get-next-sibling)) - (org-end-of-subtree t t) - (point-max))))) - (setq level 1) - (if (not reversed) - (goto-char (point-max)) - (goto-char (point-min)) - (or (outline-next-heading) (goto-char (point-max))))) - (if (not (bolp)) (newline)) - (org-paste-subtree level) - (when org-log-refile - (org-add-log-setup 'refile nil nil 'findpos - org-log-refile) - (unless (eq org-log-refile 'note) - (save-excursion (org-add-log-note)))) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-refile-last-stored") - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (run-hooks 'org-after-refile-insert-hook)))) - (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\"" (car it)))))) - (org-reveal)) + (switch-to-buffer nbuf) + (goto-char pos) + (org-show-context 'org-goto)) + (if regionp + (progn + (org-kill-new (buffer-substring region-start region-end)) + (org-save-markers-in-region region-start region-end)) + (org-copy-subtree 1 nil t)) + (with-current-buffer (setq nbuf (or (find-buffer-visiting file) + (find-file-noselect file))) + (setq reversed (org-notes-order-reversed-p)) + (save-excursion + (save-restriction + (widen) + (if pos + (progn + (goto-char pos) + (looking-at outline-regexp) + (setq level (org-get-valid-level (funcall outline-level) 1)) + (goto-char + (if reversed + (or (outline-next-heading) (point-max)) + (or (save-excursion (org-get-next-sibling)) + (org-end-of-subtree t t) + (point-max))))) + (setq level 1) + (if (not reversed) + (goto-char (point-max)) + (goto-char (point-min)) + (or (outline-next-heading) (goto-char (point-max))))) + (if (not (bolp)) (newline)) + (org-paste-subtree level) + (when org-log-refile + (org-add-log-setup 'refile nil nil 'findpos + org-log-refile) + (unless (eq org-log-refile 'note) + (save-excursion (org-add-log-note)))) + (and org-auto-align-tags (org-set-tags nil t)) + (bookmark-set "org-refile-last-stored") + ;; If we are refiling for capture, make sure that the + ;; last-capture pointers point here + (when (org-bound-and-true-p org-refile-for-capture) + (bookmark-set "org-capture-last-stored-marker") + (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)) + (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))))))) (defun org-refile-goto-last-stored () "Go to the location where the last refile was stored." @@ -9848,7 +10372,7 @@ blocks in the buffer." (org-update-dblock))) (defun org-update-dblock () - "Update the dynamic block at point + "Update the dynamic block at point. This means to empty the block, parse for parameters and then call the correct writing function." (save-window-excursion @@ -9943,12 +10467,12 @@ This function can be used in a hook." ) "Structure completion elements. This is a list of abbreviation keys and values. The value gets inserted -it you type @samp{.} followed by the key and then the completion key, +if you type `<' followed by the key and then press the completion key, usually `M-TAB'. %file will be replaced by a file name after prompting for the file using completion. There are two templates for each key, the first uses the original Org syntax, the second uses Emacs Muse-like syntax tags. These Muse-like tags become -the default when the /org-mtags.el/ module has been loaded. See also the +the default when the /org-mtags.el/ module has been loaded. See also the variable `org-mtags-prefer-muse-templates'. This is an experimental feature, it is undecided if it is going to stay in." :group 'org-completion @@ -10168,15 +10692,13 @@ this is nil.") (defvar org-todo-setup-filter-hook nil "Hook for functions that pre-filter todo specs. - -Each function takes a todo spec and returns either `nil' or the spec +Each function takes a todo spec and returns either nil or the spec transformed into canonical form." ) (defvar org-todo-get-default-hook nil "Hook for functions that get a default item for todo. - Each function takes arguments (NEW-MARK OLD-MARK) and returns either -`nil' or a string to be used for the todo mark." ) +nil or a string to be used for the todo mark." ) (defvar org-agenda-headline-snapshot-before-repeat) @@ -10193,10 +10715,12 @@ So for this example: when the item starts with TODO, it is changed to DONE. When it starts with DONE, the DONE is removed. And when neither TODO nor DONE are present, add TODO at the beginning of the heading. -With C-u prefix arg, use completion to determine the new state. +With \\[universal-argument] prefix arg, use completion to determine the new \ +state. With numeric prefix arg, switch to that state. -With a double C-u prefix, switch to the next set of TODO keywords (nextset). -With a triple C-u prefix, circumvent any state blocking. +With a double \\[universal-argument] prefix, switch to the next set of TODO \ +keywords (nextset). +With a triple \\[universal-argument] prefix, circumvent any state blocking. For calling through lisp, arg is also interpreted in the following way: 'none -> empty state @@ -10224,7 +10748,7 @@ For calling through lisp, arg is also interpreted in the following way: (looking-at " *")) (let* ((match-data (match-data)) (startpos (point-at-bol)) - (logging (save-match-data (org-entry-get nil "LOGGING" t))) + (logging (save-match-data (org-entry-get nil "LOGGING" t t))) (org-log-done org-log-done) (org-log-repeat org-log-repeat) (org-todo-log-states org-todo-log-states) @@ -10440,7 +10964,7 @@ changes. Such blocking occurs when: (let* ((pos (point)) (parent-pos (and (org-up-heading-safe) (point)))) (if (not parent-pos) (throw 'dont-block t)) ; no parent - (when (and (org-entry-get (point) "ORDERED") + (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) (re-search-forward org-not-done-heading-regexp pos t)) (throw 'dont-block nil)) ; block, there is an older sibling not done. @@ -10452,7 +10976,7 @@ changes. Such blocking occurs when: (setq pos (point)) (setq parent-pos (and (org-up-heading-safe) (point))) (if (not parent-pos) (throw 'dont-block t)) ; no parent - (when (and (org-entry-get (point) "ORDERED") + (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) (re-search-forward org-not-done-heading-regexp pos t)) (throw 'dont-block nil)))))))) ; block, older sibling not done. @@ -10846,12 +11370,17 @@ This function is run automatically after each state change to a DONE state." (org-log-done nil) (org-todo-log-states nil) (nshiftmax 10) (nshift 0) - re type n what ts time) + re type n what ts time to-state) (when repeat (if (eq org-log-repeat t) (setq org-log-repeat 'state)) - (org-todo (if (eq interpret 'type) last-state head)) - (org-entry-put nil "LAST_REPEAT" (format-time-string - (org-time-stamp-format t t))) + (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE") + org-todo-repeat-to-state)) + (unless (and to-state (member to-state org-todo-keywords-1)) + (setq to-state (if (eq interpret 'type) last-state head))) + (org-todo to-state) + (when (or org-log-repeat (org-entry-get nil "CLOCK")) + (org-entry-put nil "LAST_REPEAT" (format-time-string + (org-time-stamp-format t t)))) (when org-log-repeat (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) (memq 'org-add-log-note post-command-hook)) @@ -11015,7 +11544,7 @@ returns nil." (apply 'encode-time (org-parse-time-string time))))) (defun org-get-deadline-time (pom &optional inherit) - "Get the deadine as a time tuple, of a format suitable for + "Get the deadline as a time tuple, of a format suitable for calling org-deadline with, or if there is no scheduling, returns nil." (let ((time (org-entry-get pom "DEADLINE" inherit))) @@ -11133,7 +11662,7 @@ be removed." (end-of-line 1)) (goto-char (point-min)) (widen) - (if (and (looking-at "[ \t]+\n") + (if (and (looking-at "[ \t]*\n") (equal (char-before) ?\n)) (delete-region (1- (point)) (point-at-eol))) ts)))))) @@ -11283,6 +11812,9 @@ EXTRA is additional text that will be inserted into the notes buffer." (cons "%t" (format-time-string (org-time-stamp-format 'long 'inactive) (current-time))) + (cons "%T" (format-time-string + (org-time-stamp-format 'long nil) + (current-time))) (cons "%s" (if org-log-note-state (concat "\"" org-log-note-state "\"") "")) @@ -11337,7 +11869,8 @@ POS may also be a marker." This command can create sparse trees. You first need to select the type of match used to create the tree: -t Show entries with a specific TODO keyword. +t Show all TODO entries. +T Show entries with a specific TODO keyword. m Show entries selected by a tags/property match. p Enter a property name and its value (both with completion on existing names/values) and show entries with that property. @@ -11347,7 +11880,7 @@ b Show deadlines and scheduled items before a date. a Show deadlines and scheduled items after a date." (interactive "P") (let (ans kwd value) - (message "Sparse tree: [/]regexp [t]odo-kwd [m]atch [p]roperty [d]eadlines [b]efore-date [a]fter-date") + (message "Sparse tree: [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty [d]eadlines\n [b]efore-date [a]fter-date") (setq ans (read-char-exclusive)) (cond ((equal ans ?d) @@ -11357,6 +11890,8 @@ a Show deadlines and scheduled items after a date." ((equal ans ?a) (call-interactively 'org-check-after-date)) ((equal ans ?t) + (org-show-todo-tree nil)) + ((equal ans ?T) (org-show-todo-tree '(4))) ((member ans '(?T ?m)) (call-interactively 'org-match-sparse-tree)) @@ -11428,7 +11963,7 @@ that the match should indeed be shown." cnt)) (defun org-show-context (&optional key) - "Make sure point and context and visible. + "Make sure point and context are visible. How much context is shown depends upon the variables `org-show-hierarchy-above', `org-show-following-heading'. and `org-show-siblings'." @@ -11471,7 +12006,8 @@ not t for the search context. With optional argument SIBLINGS, on each level of the hierarchy all siblings are shown. This repairs the tree structure to what it would look like when opened with hierarchical calls to `org-cycle'. -With double optional argument `C-u C-u', go to the parent and show the +With double optional argument \\[universal-argument] \\[universal-argument], \ +go to the parent and show the entire tree." (interactive "P") (run-hooks 'org-reveal-start-hook) @@ -11487,8 +12023,8 @@ entire tree." (defun org-highlight-new-match (beg end) "Highlight from BEG to END and mark the highlight is an occur headline." - (let ((ov (org-make-overlay beg end))) - (org-overlay-put ov 'face 'secondary-selection) + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face 'secondary-selection) (push ov org-occur-highlights))) (defun org-remove-occur-highlights (&optional beg end noremove) @@ -11497,7 +12033,7 @@ BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." (interactive) (unless org-inhibit-highlight-removal - (mapc 'org-delete-overlay org-occur-highlights) + (mapc 'delete-overlay org-occur-highlights) (setq org-occur-highlights nil) (setq org-occur-parameters nil) (unless noremove @@ -12000,7 +12536,7 @@ epoch to the beginning of today (00:00)." (delq nil list)) (defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param -(defvar org-tags-overlay (org-make-overlay 1 1)) +(defvar org-tags-overlay (make-overlay 1 1)) (org-detach-overlay org-tags-overlay) (defun org-get-local-tags-at (&optional pos) @@ -12153,6 +12689,16 @@ If DATA is nil or the empty string, any tags will be removed." (if (looking-at ".*?\\([ \t]+\\)$") (delete-region (match-beginning 1) (match-end 1)))))) +(defun org-align-all-tags () + "Align the tags i all headings." + (interactive) + (save-excursion + (or (ignore-errors (org-back-to-heading t)) + (outline-next-heading)) + (if (org-on-heading-p) + (org-set-tags t) + (message "No headings")))) + (defun org-set-tags (&optional arg just-align) "Set the tags for the current headline. With prefix ARG, realign all tags in headings in the current buffer." @@ -12366,7 +12912,7 @@ Returns the new tags string, or nil to not change the current settings." (if (> (current-column) org-tags-column) " " (make-string (- org-tags-column (current-column)) ?\ )))))) - (org-move-overlay org-tags-overlay ov-start ov-end) + (move-overlay org-tags-overlay ov-start ov-end) (save-window-excursion (if expert (set-buffer (get-buffer-create " *Org tags*")) @@ -12674,7 +13220,7 @@ but in some other way.") "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" "EXPORT_FILE_NAME" "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" - "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" + "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE" "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS") "Some properties that are used by Org-mode for various purposes. Being in this list makes sure that they are offered for completion.") @@ -12764,12 +13310,11 @@ allowed value." (save-excursion (beginning-of-line 1) (when (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)")) - (let ((match (match-data)) ;; Keep match-data for use by calling - (p (point)) ;; procedures. - (range (unless (org-before-first-heading-p) - (org-get-property-block)))) - (prog1 (and range (<= (car range) p) (< p (cdr range))) - (set-match-data match)))))) + (save-match-data ;; Used by calling procedures + (let ((p (point)) + (range (unless (org-before-first-heading-p) + (org-get-property-block)))) + (and range (<= (car range) p) (< p (cdr range)))))))) (defun org-get-property-block (&optional beg end force) "Return the (beg . end) range of the body of the property drawer. @@ -12817,7 +13362,7 @@ things up because then unnecessary parsing is avoided." (let ((clockstr (substring org-clock-string 0 -1)) (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED")) (case-fold-search nil) - beg end range props sum-props key value string clocksum) + beg end range props sum-props key key1 value string clocksum) (save-excursion (when (condition-case nil (and (org-mode-p) (org-back-to-heading t)) @@ -12848,23 +13393,35 @@ things up because then unnecessary parsing is avoided." (when (or (not specific) (string= specific "BLOCKED")) (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)) (when (or (not specific) - (member specific org-all-time-keywords) - (member specific '("TIMESTAMP" "TIMESTAMP_IA"))) + (member specific + '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED" + "TIMESTAMP" "TIMESTAMP_IA"))) (while (re-search-forward org-maybe-keyword-time-regexp end t) - (setq key (if (match-end 1) (substring (org-match-string-no-properties 1) 0 -1)) + (setq key (if (match-end 1) + (substring (org-match-string-no-properties 1) + 0 -1)) string (if (equal key clockstr) (org-no-properties (org-trim - (buffer-substring - (match-beginning 3) (goto-char (point-at-eol))))) - (substring (org-match-string-no-properties 3) 1 -1))) - (unless key - (if (= (char-after (match-beginning 3)) ?\[) - (setq key "TIMESTAMP_IA") - (setq key "TIMESTAMP"))) - (when (or (equal key clockstr) (not (assoc key props))) + (buffer-substring + (match-beginning 3) (goto-char + (point-at-eol))))) + (substring (org-match-string-no-properties 3) + 1 -1))) + ;; Get the correct property name from the key. This is + ;; necessary if the user has configured time keywords. + (setq key1 (concat key ":")) + (cond + ((not key) + (setq key + (if (= (char-after (match-beginning 3)) ?\[) + "TIMESTAMP_IA" "TIMESTAMP"))) + ((equal key1 org-scheduled-string) (setq key "SCHEDULED")) + ((equal key1 org-deadline-string) (setq key "DEADLINE")) + ((equal key1 org-closed-string) (setq key "CLOSED")) + ((equal key1 org-clock-string) (setq key "CLOCK"))) + (when (or (equal key "CLOCK") (not (assoc key props))) (push (cons key string) props)))) - ) (when (memq which '(all standard)) @@ -12891,19 +13448,23 @@ things up because then unnecessary parsing is avoided." (push (cons "CATEGORY" value) props)) (append sum-props (nreverse props))))))) -(defun org-entry-get (pom property &optional inherit) +(defun org-entry-get (pom property &optional inherit literal-nil) "Get value of PROPERTY for entry at point-or-marker POM. If INHERIT is non-nil and the entry does not have the property, then also check higher levels of the hierarchy. If INHERIT is the symbol `selective', use inheritance only if the setting in `org-use-property-inheritance' selects PROPERTY for inheritance. If the property is present but empty, the return value is the empty string. -If the property is not present at all, nil is returned." +If the property is not present at all, nil is returned. + +If LITERAL-NIL is set, return the string value \"nil\" as a string, +do not interpret it as the list atom nil. This is used for inheritance +when a \"nil\" value can supersede a non-nil value higher up the hierarchy." (org-with-point-at pom (if (and inherit (if (eq inherit 'selective) (org-property-inherit-p property) t)) - (org-entry-get-with-inheritance property) + (org-entry-get-with-inheritance property literal-nil) (if (member property org-special-properties) ;; We need a special property. Use `org-entry-properties' to ;; retrieve it, but specify the wanted property @@ -12916,7 +13477,9 @@ If the property is not present at all, nil is returned." (cdr range) t)) ;; Found the property, return it. (if (match-end 1) - (org-match-string-no-properties 1) + (if literal-nil + (org-match-string-no-properties 1) + (org-not-nil (org-match-string-no-properties 1))) ""))))))) (defun org-property-or-variable-value (var &optional inherit) @@ -13011,8 +13574,12 @@ no match, the marker will point nowhere. Note that also `org-entry-get' calls this function, if the INHERIT flag is set.") -(defun org-entry-get-with-inheritance (property) - "Get entry property, and search higher levels if not present." +(defun org-entry-get-with-inheritance (property &optional literal-nil) + "Get entry property, and search higher levels if not present. +The search will stop at the first ancestor which has the property defined. +If the value found is \"nil\", return nil to show that the property +should be considered as undefined (this is the meaning of nil here). +However, if LITERAL-NIL is set, return the string value \"nil\" instead." (move-marker org-entry-property-inherited-from nil) (let (tmp) (save-excursion @@ -13020,15 +13587,16 @@ is set.") (widen) (catch 'ex (while t - (when (setq tmp (org-entry-get nil property)) + (when (setq tmp (org-entry-get nil property nil 'literal-nil)) (org-back-to-heading t) (move-marker org-entry-property-inherited-from (point)) (throw 'ex tmp)) (or (org-up-heading-safe) (throw 'ex nil))))) - (or tmp - (cdr (assoc property org-file-properties)) - (cdr (assoc property org-global-properties)) - (cdr (assoc property org-global-properties-fixed)))))) + (setq tmp (or tmp + (cdr (assoc property org-file-properties)) + (cdr (assoc property org-global-properties)) + (cdr (assoc property org-global-properties-fixed)))) + (if literal-nil tmp (org-not-nil tmp))))) (defvar org-property-changed-functions nil "Hook called when the value of a property has changed. @@ -13227,7 +13795,8 @@ in the current file." "In the current entry, delete PROPERTY." (interactive (let* ((completion-ignore-case t) - (prop (org-icompleting-read "Property: " (org-entry-properties nil 'standard)))) + (prop (org-icompleting-read "Property: " + (org-entry-properties nil 'standard)))) (list prop))) (message "Property %s %s" property (if (org-entry-delete nil property) @@ -13341,6 +13910,51 @@ completion." (skip-chars-forward " \t") (run-hook-with-args 'org-property-changed-functions key nval))) +(defun org-find-olp (path &optional this-buffer) + "Return a marker pointing to the entry at outline path OLP. +If anything goes wrong, throw an error. +You can wrap this call to catch the error like this: + + (condition-case msg + (org-mobile-locate-entry (match-string 4)) + (error (nth 1 msg))) + +The return value will then be either a string with the error message, +or a marker if everything is OK. + +If THIS-BUFFER is set, the outline path does not contain a file, +only headings." + (let* ((file (if this-buffer buffer-file-name (pop path))) + (buffer (if this-buffer (current-buffer) (find-file-noselect file))) + (level 1) + (lmin 1) + (lmax 1) + limit re end found pos heading cnt) + (unless buffer (error "File not found :%s" file)) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (setq limit (point-max)) + (goto-char (point-min)) + (while (setq heading (pop path)) + (setq re (format org-complex-heading-regexp-format + (regexp-quote heading))) + (setq cnt 0 pos (point)) + (while (re-search-forward re end t) + (setq level (- (match-end 1) (match-beginning 1))) + (if (and (>= level lmin) (<= level lmax)) + (setq found (match-beginning 0) cnt (1+ cnt)))) + (when (= cnt 0) (error "Heading not found on level %d: %s" + lmax heading)) + (when (> cnt 1) (error "Heading not unique on level %d: %s" + lmax heading)) + (goto-char found) + (setq lmin (1+ level) lmax (+ lmin (if org-odd-levels-only 1 0))) + (setq end (save-excursion (org-end-of-subtree t t)))) + (when (org-on-heading-p) + (move-marker (make-marker) (point)))))))) + (defun org-find-entry-with-id (ident) "Locate the entry that contains the ID property with exact value IDENT. IDENT can be a string, a symbol or a number, this function will search for @@ -13447,8 +14061,8 @@ So these are more for recording a certain time/date." (interactive "P") (org-time-stamp arg 'inactive)) -(defvar org-date-ovl (org-make-overlay 1 1)) -(org-overlay-put org-date-ovl 'face 'org-warning) +(defvar org-date-ovl (make-overlay 1 1)) +(overlay-put org-date-ovl 'face 'org-warning) (org-detach-overlay org-date-ovl) (defvar org-ans1) ; dynamically scoped parameter @@ -13469,10 +14083,15 @@ The prompt will suggest to enter an ISO date, but you can also enter anything which will at least partially be understood by `parse-time-string'. Unrecognized parts of the date will default to the current day, month, year, hour and minute. If this command is called to replace a timestamp at point, -of to enter the second timestamp of a range, the default time is taken from the -existing stamp. For example, +of to enter the second timestamp of a range, the default time is taken +from the existing stamp. Furthermore, the command prefers the future, +so if you are giving a date where the year is not given, and the day-month +combination is already past in the current year, it will assume you +mean next year. For details, see the manual. A few examples: + 3-2-5 --> 2003-02-05 feb 15 --> currentyear-02-15 + 2/15 --> currentyear-02-15 sep 12 9 --> 2009-09-12 12:45 --> today 12:45 22 sept 0:34 --> currentyear-09-22 0:34 @@ -13525,6 +14144,7 @@ user." (setq def (apply 'encode-time defdecode) defdecode (decode-time def))))) (calendar-frame-setup nil) + (calendar-setup nil) (calendar-move-hook nil) (calendar-view-diary-initially-flag nil) (calendar-view-holidays-initially-flag nil) @@ -13548,10 +14168,8 @@ user." (map (copy-keymap calendar-mode-map)) (minibuffer-local-map (copy-keymap minibuffer-local-map))) (org-defkey map (kbd "RET") 'org-calendar-select) - (org-defkey map (if (featurep 'xemacs) [button1] [mouse-1]) - 'org-calendar-select-mouse) - (org-defkey map (if (featurep 'xemacs) [button2] [mouse-2]) - 'org-calendar-select-mouse) + (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)))) @@ -13594,6 +14212,14 @@ user." (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 @@ -13608,7 +14234,7 @@ user." (remove-hook 'post-command-hook 'org-read-date-display) (use-local-map old-map) (when org-read-date-overlay - (org-delete-overlay org-read-date-overlay) + (delete-overlay org-read-date-overlay) (setq org-read-date-overlay nil))))))) (t ; Naked prompt only @@ -13616,7 +14242,7 @@ user." (setq ans (read-string prompt default-input 'org-read-date-history timestr)) (when org-read-date-overlay - (org-delete-overlay org-read-date-overlay) + (delete-overlay org-read-date-overlay) (setq org-read-date-overlay nil))))) (setq final (org-read-date-analyze ans def defdecode)) @@ -13638,7 +14264,7 @@ user." "Display the current date prompt interpretation in the minibuffer." (when org-read-date-display-live (when org-read-date-overlay - (org-delete-overlay org-read-date-overlay)) + (delete-overlay org-read-date-overlay)) (let ((p (point))) (end-of-line 1) (while (not (equal (buffer-substring @@ -13666,11 +14292,11 @@ user." (when org-read-date-analyze-futurep (setq txt (concat txt " (=>F)"))) (setq org-read-date-overlay - (org-make-overlay (1- (point-at-eol)) (point-at-eol))) + (make-overlay (1- (point-at-eol)) (point-at-eol))) (org-overlay-display org-read-date-overlay txt 'secondary-selection)))) (defun org-read-date-analyze (ans def defdecode) - "Analyse the combined answer of the date prompt." + "Analyze the combined answer of the date prompt." ;; FIXME: cleanup and comment (let ((nowdecode (decode-time (current-time))) delta deltan deltaw deltadef year month day @@ -13712,7 +14338,7 @@ user." t nil ans))) ;; Help matching american dates, like 5/30 or 5/30/7 (when (string-match - "^ *\\([0-3]?[0-9]\\)/\\([0-1]?[0-9]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans) + "^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans) (setq year (if (match-end 4) (string-to-number (match-string 4 ans)) (progn (setq kill-year t) @@ -13902,7 +14528,7 @@ Also, store the cursor date in variable org-ans2." (let* ((date (calendar-cursor-to-date)) (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) - (org-move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) + (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) (select-window sw) (org-select-frame-set-input-focus sf))) @@ -14196,7 +14822,7 @@ days in order to avoid rounding problems." (defun org-time-string-to-absolute (s &optional daynr prefer show-all) "Convert a time stamp to an absolute day number. -If there is a specifyer for a cyclic time stamp, get the closest date to +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." @@ -14309,7 +14935,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp." (if (string-match "\\(\\+[0-9]+\\)\\([dwmy]\\)" change) (setq dn (string-to-number (match-string 1 change)) dw (cdr (assoc (match-string 2 change) a1))) - (error "Invalid change specifyer: %s" change)) + (error "Invalid change specifier: %s" change)) (if (eq dw 'week) (setq dw 'day dn (* 7 dn))) (cond ((eq dw 'day) @@ -14355,7 +14981,7 @@ When SHOW-ALL is nil, only return the current occurrence of a time stamp." (t (if (= cday n1) n1 n2))))))) (defun org-date-to-gregorian (date) - "Turn any specification of DATE into a gregorian date for the calendar." + "Turn any specification of DATE into a Gregorian date for the calendar." (cond ((integerp date) (calendar-gregorian-from-absolute date)) ((and (listp date) (= (length date) 3)) date) ((stringp date) @@ -14387,7 +15013,7 @@ If the cursor is on the year, change the year. If it is on the month or the day, change that. With prefix ARG, change by that many units." (interactive "p") - (org-timestamp-change (prefix-numeric-value arg))) + (org-timestamp-change (prefix-numeric-value arg) nil 'updown)) (defun org-timestamp-down (&optional arg) "Decrease the date item at the cursor by one. @@ -14395,7 +15021,7 @@ If the cursor is on the year, change the year. If it is on the month or the day, change that. With prefix ARG, change by that many units." (interactive "p") - (org-timestamp-change (- (prefix-numeric-value arg)))) + (org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown)) (defun org-timestamp-up-day (&optional arg) "Increase the date in the time stamp by one day. @@ -14404,7 +15030,7 @@ With prefix ARG, change that many days." (if (and (not (org-at-timestamp-p t)) (org-on-heading-p)) (org-todo 'up) - (org-timestamp-change (prefix-numeric-value arg) 'day))) + (org-timestamp-change (prefix-numeric-value arg) 'day 'updown))) (defun org-timestamp-down-day (&optional arg) "Decrease the date in the time stamp by one day. @@ -14413,7 +15039,7 @@ With prefix ARG, change that many days." (if (and (not (org-at-timestamp-p t)) (org-on-heading-p)) (org-todo 'down) - (org-timestamp-change (- (prefix-numeric-value arg)) 'day))) + (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown)) (defun org-at-timestamp-p (&optional inactive-ok) "Determine if the cursor is in or at a timestamp." @@ -14458,7 +15084,7 @@ With prefix ARG, change that many days." (message "Timestamp is now %sactive" (if (equal (char-after beg) ?<) "" "in"))))) -(defun org-timestamp-change (n &optional what) +(defun org-timestamp-change (n &optional what updown) "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 @@ -14489,8 +15115,10 @@ in the timestamp determines what will be changed." (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) (setq with-hm t)) (setq time0 (org-parse-time-string ts)) - (when (and (eq org-ts-what 'minute) - (eq current-prefix-arg nil)) + (when (and updown + (eq org-ts-what 'minute) + (not current-prefix-arg)) + ;; This looks like s-up and s-down. Change by one rounding step. (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) (when (not (= 0 (setq rem (% (nth 1 time0) dm)))) (setcar (cdr time0) (+ (nth 1 time0) @@ -14677,21 +15305,31 @@ changes from another. I believe the procedure must be like this: ;;;; Agenda files ;;;###autoload -(defun org-iswitchb (&optional arg) - "Use `org-icompleting-read' to prompt for an Org buffer to switch to. +(defun org-switchb (&optional arg) + "Switch between Org buffers. With a prefix argument, restrict available to files. -With two prefix arguments, restrict available buffers to agenda files." +With two prefix arguments, restrict available buffers to agenda files. + +Defaults to `iswitchb' for buffer name completion. +Set `org-completion-use-ido' to make it use ido instead." (interactive "P") (let ((blist (cond ((equal arg '(4)) (org-buffer-list 'files)) ((equal arg '(16)) (org-buffer-list 'agenda)) - (t (org-buffer-list))))) + (t (org-buffer-list)))) + (org-completion-use-iswitchb org-completion-use-iswitchb) + (org-completion-use-ido org-completion-use-ido)) + (unless (or org-completion-use-ido org-completion-use-iswitchb) + (setq org-completion-use-iswitchb t)) (switch-to-buffer (org-icompleting-read "Org buffer: " - (mapcar 'list (mapcar 'buffer-name blist)) - nil t)))) + (mapcar 'list (mapcar 'buffer-name blist)) + nil t)))) +;;; Define some older names previously used for this functionality +;;;###autoload +(defalias 'org-ido-switchb 'org-switchb) ;;;###autoload -(defalias 'org-ido-switchb 'org-iswitchb) +(defalias 'org-iswitchb 'org-switchb) (defun org-buffer-list (&optional predicate exclude-tmp) "Return a list of Org buffers. @@ -14762,6 +15400,13 @@ used by the agenda files. If ARCHIVE is `ifmode', do this only if (setq files (org-add-archive-files files))) files)) +(defun org-agenda-file-p (&optional file) + "Return non-nil, if FILE is an agenda file. +If FILE is omitted, use the file associated with the current +buffer." + (member (or file (buffer-file-name)) + (org-agenda-files t))) + (defun org-edit-agenda-file-list () "Edit the list of agenda files. Depending on setup, this either uses customize to edit the variable @@ -15075,10 +15720,6 @@ looks only before point, not after." (org-in-regexp "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*"))) -(defun test () - (interactive) - (message "%s" (org-inside-latex-macro-p))) - (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 @@ -15120,7 +15761,7 @@ Revert to the normal definition outside of these fragments." (defun org-remove-latex-fragment-image-overlays () "Remove all overlays with LaTeX fragment images in current buffer." - (mapc 'org-delete-overlay org-latex-fragment-image-overlays) + (mapc 'delete-overlay org-latex-fragment-image-overlays) (setq org-latex-fragment-image-overlays nil)) (defun org-preview-latex-fragment (&optional subtree) @@ -15129,7 +15770,8 @@ If the cursor is in a LaTeX fragment, create the image and overlay it over the source code. If there is no fragment at point, display all fragments in the current text, from one headline to the next. With prefix SUBTREE, display all fragments in the current subtree. With a -double prefix `C-u C-u', or when the cursor is before the first headline, +double prefix arg \\[universal-argument] \\[universal-argument], or when \ +the cursor is before the first headline, display all fragments in the buffer. The images can be removed again with \\[org-ctrl-c-ctrl-c]." (interactive "P") @@ -15175,7 +15817,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) "Regular expressions for matching embedded LaTeX.") -(defun org-format-latex (prefix &optional dir overlays msg at forbuffer) +(defun org-format-latex (prefix &optional dir overlays msg at + forbuffer protect-only) "Replace LaTeX fragments with links to an image, and produce images. Some of the options can be changed using the variable `org-format-latex-options'." @@ -15205,60 +15848,63 @@ Some of the options can be changed using the variable (not (eq (get-char-property (match-beginning n) 'org-overlay-type) 'org-latex-overlay)))) - (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 - (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-format-latex-options - forbuffer txt))) - 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 - (setq checkdir t) - (or (file-directory-p todir) (make-directory todir))) - - (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 - txt movefile opt forbuffer)) - (if overlays - (progn - (mapc (lambda (o) - (if (eq (org-overlay-get o 'org-overlay-type) - 'org-latex-overlay) - (org-delete-overlay o))) - (org-overlays-in beg end)) - (setq ov (org-make-overlay beg end)) - (org-overlay-put ov 'org-overlay-type 'org-latex-overlay) - (if (featurep 'xemacs) - (progn - (org-overlay-put ov 'invisible t) - (org-overlay-put - ov 'end-glyph - (make-glyph (vector 'png :file movefile)))) - (org-overlay-put - ov 'display - (list 'image :type 'png :file movefile :ascent 'center))) - (push ov org-latex-fragment-image-overlays) - (goto-char end)) - (delete-region beg end) - (insert (org-add-props link - (list 'org-latex-src - (replace-regexp-in-string "\"" "" txt))))))))))) + (if protect-only + (add-text-properties (match-beginning n) (match-end n) + '(org-protected t)) + (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 + (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-format-latex-options + forbuffer txt))) + 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 + (setq checkdir t) + (or (file-directory-p todir) (make-directory todir))) + + (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 + txt movefile opt forbuffer)) + (if overlays + (progn + (mapc (lambda (o) + (if (eq (overlay-get o 'org-overlay-type) + 'org-latex-overlay) + (delete-overlay o))) + (overlays-in beg end)) + (setq ov (make-overlay beg end)) + (overlay-put ov 'org-overlay-type 'org-latex-overlay) + (if (featurep 'xemacs) + (progn + (overlay-put ov 'invisible t) + (overlay-put + ov 'end-glyph + (make-glyph (vector 'png :file movefile)))) + (overlay-put + ov 'display + (list 'image :type 'png :file movefile :ascent 'center))) + (push ov org-latex-fragment-image-overlays) + (goto-char end)) + (delete-region beg end) + (insert (org-add-props link + (list 'org-latex-src + (replace-regexp-in-string "\"" "" txt)))))))))))) ;; This function borrows from Ganesh Swami's latex2png.el (defun org-create-formula-image (string tofile options buffer) @@ -15287,7 +15933,7 @@ Some of the options can be changed using the variable (insert (org-splice-latex-header org-format-latex-header org-export-latex-default-packages-alist - org-export-latex-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) @@ -15321,13 +15967,13 @@ Some of the options can be changed using the variable (delete-file (concat texfilebase e))) pngfile)))) -(defun org-splice-latex-header (tpl def-pkg pkg &optional extra) +(defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra) "Fill a LaTeX header template TPL. In the template, the following place holders will be recognized: [DEFAULT-PACKAGES] \\usepackage statements for DEF-PKG [NO-DEFAULT-PACKAGES] do not include DEF-PKG - [PACKAGES] \\usepackage statements for PKG + [PACKAGES] \\usepackage statements for PKG [NO-PACKAGES] do not include PKG [EXTRA] the string EXTRA [NO-EXTRA] do not include EXTRA @@ -15336,19 +15982,22 @@ For backward compatibility, if both the positive and the negative place holder is missing, the positive one (without the \"NO-\") will be assumed to be present at the end of the template. DEF-PKG and PKG are assumed to be alists of options/packagename lists. -EXTRA is a string." +EXTRA is a string. +SNIPPETS-P indicates if this is run to create snippet images for HTML." (let (rpl (end "")) (if (string-match "^[ \t]*\\[\\(NO-\\)?DEFAULT-PACKAGES\\][ \t]*\n?" tpl) (setq rpl (if (or (match-end 1) (not def-pkg)) - "" (org-latex-packages-to-string def-pkg t)) + "" (org-latex-packages-to-string def-pkg snippets-p t)) tpl (replace-match rpl t t tpl)) - (if def-pkg (setq end (org-latex-packages-to-string def-pkg)))) - + (if def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p)))) + (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl) (setq rpl (if (or (match-end 1) (not pkg)) - "" (org-latex-packages-to-string pkg t)) + "" (org-latex-packages-to-string pkg snippets-p t)) tpl (replace-match rpl t t tpl)) - (if pkg (setq end (concat end "\n" (org-latex-packages-to-string pkg))))) + (if pkg (setq end + (concat end "\n" + (org-latex-packages-to-string pkg snippets-p))))) (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl) (setq rpl (if (or (match-end 1) (not extra)) @@ -15361,11 +16010,13 @@ EXTRA is a string." (concat tpl "\n" end) tpl))) -(defun org-latex-packages-to-string (pkg &optional newline) +(defun org-latex-packages-to-string (pkg &optional snippets-p newline) "Turn an alist of packages into a string with the \\usepackage macros." (setq pkg (mapconcat (lambda(p) (cond ((stringp p) p) + ((and snippets-p (>= (length p) 3) (not (nth 2 p))) + (format "%% Package %s omitted" (cadr p))) ((equal "" (car p)) (format "\\usepackage{%s}" (cadr p))) (t @@ -15385,6 +16036,80 @@ EXTRA is a string." "Return string to be used as color value for an RGB component." (format "%g" (/ value 65535.0))) +;; Image display + + +(defvar org-inline-image-overlays nil) +(make-variable-buffer-local 'org-inline-image-overlays) + +(defun org-toggle-inline-images (&optional include-linked) + "Toggle the display of inline images. +INCLUDE-LINKED is passed to `org-display-inline-images'." + (interactive "P") + (if org-inline-image-overlays + (progn + (org-remove-inline-images) + (message "Inline image display turned off")) + (org-display-inline-images include-linked) + (if org-inline-image-overlays + (message "%d images displayed inline" + (length org-inline-image-overlays)) + (message "No images to display inline")))) + +(defun org-display-inline-images (&optional include-linked refresh beg end) + "Display inline images. +Normally only links without a description part are inlined, because this +is how it will work for export. When INCLUDE-LINKED is set, also links +with a description part will be inlined. This can be nice for a quick +look at those images, but it does not reflect what exported files will look +like. +When REFRESH is set, refresh existing images between BEG and END. +This will create new image displays only if necessary. +BEG and END default to the buffer boundaries." + (interactive "P") + (unless refresh + (org-remove-inline-images) + (clear-image-cache)) + (save-excursion + (save-restriction + (widen) + (setq beg (or beg (point-min)) end (or end (point-max))) + (goto-char (point-min)) + (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([-+~.:/\\_0-9a-zA-Z ]+" + (substring (org-image-file-name-regexp) 0 -2) + "\\)\\]" (if include-linked "" "\\]"))) + old file ov img) + (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 + (concat (or (match-string 3) "") (match-string 4)))) + (when (file-exists-p file) + (if (and (car-safe old) refresh) + (image-refresh (overlay-get (cdr old) 'display)) + (setq img (create-image file)) + (when img + (setq ov (make-overlay (match-beginning 0) (match-end 0))) + (overlay-put ov 'display img) + (overlay-put ov 'face 'default) + (overlay-put ov 'org-image-overlay t) + (overlay-put ov 'modification-hooks + (list 'org-display-inline-modification-hook)) + (push ov org-inline-image-overlays))))))))) + +(defun org-display-inline-modification-hook (ov after beg end &optional len) + "Remove inline-display overlay if a corresponding region is modified." + (let ((inhibit-modification-hooks t)) + (when (and ov after) + (delete ov org-inline-image-overlays) + (delete-overlay ov)))) + +(defun org-remove-inline-images () + "Remove inline display of images." + (interactive) + (mapc 'delete-overlay org-inline-image-overlays) + (setq org-inline-image-overlays nil)) + ;;;; Key bindings ;; Make `C-c C-x' a prefix key @@ -15426,6 +16151,12 @@ EXTRA is a string." (org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright) (org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft) +;; Babel keys +(define-key org-mode-map org-babel-key-prefix org-babel-map) +(mapc (lambda (pair) + (define-key org-babel-map (car pair) (cdr pair))) + org-babel-key-bindings) + ;;; Extra keys for tty access. ;; We only set them when really needed because otherwise the ;; menus don't show the simple keys @@ -15483,7 +16214,6 @@ EXTRA is a string." (org-defkey org-mode-map "\C-c\C-s" 'org-schedule) (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-v" 'org-show-todo-tree) (org-defkey org-mode-map "\C-c\C-w" 'org-refile) (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. @@ -15554,6 +16284,8 @@ EXTRA is a string." (org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report) (org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) (org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) +(org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images) +(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-xe" 'org-set-effort) @@ -15646,7 +16378,7 @@ EXTRA is a string." "Show the available speed commands." (interactive) (if (not org-use-speed-commands) - (error "Speed commands are not activated, customize `org-use-speed-commands'.") + (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) @@ -15839,8 +16571,9 @@ See `org-ctrl-c-ctrl-c-hook' for more information. This hook runs as the first action when TAB is pressed, even before `org-cycle' messes around with the `outline-regexp' to cater for inline tasks and plain list item folding. -If any function in this hook returns t, not other actions like table -field motion visibility cycling will be done.") +If any function in this hook returns t, any other actions that +would have been caused by TAB (such as table field motion or visibility +cycling) will not occur.") (defvar org-tab-after-check-for-table-hook nil "Hook for functions to attach themselves to TAB. @@ -15891,6 +16624,34 @@ See `org-ctrl-c-ctrl-c-hook' for more information.") (defvar org-metareturn-hook nil "Hook for functions attaching themselves to `M-RET'. See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftup-hook nil + "Hook for functions attaching themselves to `S-up'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftup-final-hook nil + "Hook for functions attaching themselves to `S-up'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftdown-hook nil + "Hook for functions attaching themselves to `S-down'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftdown-final-hook nil + "Hook for functions attaching themselves to `S-down'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftleft-hook nil + "Hook for functions attaching themselves to `S-left'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftleft-final-hook nil + "Hook for functions attaching themselves to `S-left'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftright-hook nil + "Hook for functions attaching themselves to `S-right'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftright-final-hook nil + "Hook for functions attaching themselves to `S-right'. +This one runs after all other options except shift-select have been excluded. +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." @@ -15931,7 +16692,7 @@ See the individual commands for more information." ((run-hook-with-args-until-success 'org-shiftmetaleft-hook)) ((org-at-table-p) (call-interactively 'org-table-delete-column)) ((org-on-heading-p) (call-interactively 'org-promote-subtree)) - ((org-at-item-p) (call-interactively 'org-outdent-item)) + ((org-at-item-p) (call-interactively 'org-outdent-item-tree)) (t (org-modifier-cursor-error)))) (defun org-shiftmetaright () @@ -15944,7 +16705,7 @@ See the individual commands for more information." ((run-hook-with-args-until-success 'org-shiftmetaright-hook)) ((org-at-table-p) (call-interactively 'org-table-insert-column)) ((org-on-heading-p) (call-interactively 'org-demote-subtree)) - ((org-at-item-p) (call-interactively 'org-indent-item)) + ((org-at-item-p) (call-interactively 'org-indent-item-tree)) (t (org-modifier-cursor-error)))) (defun org-shiftmetaup (&optional arg) @@ -15973,6 +16734,10 @@ commands for more information." ((org-at-item-p) (call-interactively 'org-move-item-down)) (t (org-modifier-cursor-error)))) +(defsubst org-hidden-tree-error () + (error + "Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>")) + (defun org-metaleft (&optional arg) "Promote heading or move table column to left. Calls `org-do-promote' or `org-table-move-column', depending on context. @@ -15987,12 +16752,14 @@ See the individual commands for more information." (save-excursion (goto-char (region-beginning)) (org-on-heading-p)))) + (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) (call-interactively 'org-do-promote)) ((or (org-at-item-p) (and (org-region-active-p) (save-excursion (goto-char (region-beginning)) (org-at-item-p)))) + (when (org-check-for-hidden 'items) (org-hidden-tree-error)) (call-interactively 'org-outdent-item)) (t (call-interactively 'backward-word)))) @@ -16010,15 +16777,44 @@ See the individual commands for more information." (save-excursion (goto-char (region-beginning)) (org-on-heading-p)))) + (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) (call-interactively 'org-do-demote)) ((or (org-at-item-p) (and (org-region-active-p) (save-excursion (goto-char (region-beginning)) (org-at-item-p)))) + (when (org-check-for-hidden 'items) (org-hidden-tree-error)) (call-interactively 'org-indent-item)) (t (call-interactively 'forward-word)))) +(defun org-check-for-hidden (what) + "Check if there are hidden headlines/items in the current visual line. +WHAT can be either `headlines' or `items'. If the current line is +an outline or item heading and it has a folded subtree below it, +this function returns t, nil otherwise." + (let ((re (cond + ((eq what 'headlines) (concat "^" org-outline-regexp)) + ((eq what 'items) (concat "^" (org-item-re t))) + (t (error "This should not happen")))) + beg end) + (save-excursion + (catch 'exit + (unless (org-region-active-p) + (setq beg (point-at-bol)) + (beginning-of-line 2) + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (beginning-of-line 2)) + (setq end (point)) + (goto-char beg) + (goto-char (point-at-eol)) + (setq end (max end (point))) + (while (re-search-forward re end t) + (if (get-char-property (match-beginning 0) 'invisible) + (throw 'exit t)))) + nil)))) + (defun org-metaup (&optional arg) "Move subtree up or move table row up. Calls `org-move-subtree-up' or `org-table-move-row' or @@ -16051,6 +16847,7 @@ Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item', depending on context. See the individual commands for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftup-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'previous-line)) ((org-at-timestamp-p t) @@ -16063,6 +16860,7 @@ depending on context. See the individual commands for more information." ((and (not org-support-shift-select) (org-at-item-p)) (call-interactively 'org-previous-item)) ((org-clocktable-try-shift 'up arg)) + ((run-hook-with-args-until-success 'org-shiftup-final-hook)) (org-support-shift-select (org-call-for-shift-select 'previous-line)) (t (org-shiftselect-error)))) @@ -16073,6 +16871,7 @@ Calls `org-timestamp-down' or `org-priority-down', or `org-next-item' depending on context. See the individual commands for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftdown-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'next-line)) ((org-at-timestamp-p t) @@ -16085,6 +16884,7 @@ depending on context. See the individual commands for more information." ((and (not org-support-shift-select) (org-at-item-p)) (call-interactively 'org-next-item)) ((org-clocktable-try-shift 'down arg)) + ((run-hook-with-args-until-success 'org-shiftdown-final-hook)) (org-support-shift-select (org-call-for-shift-select 'next-line)) (t (org-shiftselect-error)))) @@ -16100,6 +16900,7 @@ Depending on context, this does one of the following: - on a clocktable definition line, move time block into the future" (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftright-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'forward-char)) ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) @@ -16119,6 +16920,7 @@ Depending on context, this does one of the following: (org-at-property-p)) (call-interactively 'org-property-next-allowed-value)) ((org-clocktable-try-shift 'right arg)) + ((run-hook-with-args-until-success 'org-shiftright-final-hook)) (org-support-shift-select (org-call-for-shift-select 'forward-char)) (t (org-shiftselect-error)))) @@ -16134,6 +16936,7 @@ Depending on context, this does one of the following: - on a clocktable definition line, move time block into the past" (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftleft-hook)) ((and org-support-shift-select (org-region-active-p)) (org-call-for-shift-select 'backward-char)) ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) @@ -16153,6 +16956,7 @@ Depending on context, this does one of the following: (org-at-property-p)) (call-interactively 'org-property-previous-allowed-value)) ((org-clocktable-try-shift 'left arg)) + ((run-hook-with-args-until-success 'org-shiftleft-final-hook)) (org-support-shift-select (org-call-for-shift-select 'backward-char)) (t (org-shiftselect-error)))) @@ -16215,24 +17019,33 @@ See the individual commands for more information." (org-table-paste-rectangle) (org-paste-subtree arg))) -(defun org-edit-special () +(defun org-edit-special (&optional arg) "Call a special editor for the stuff at point. When at a table, call the formula editor with `org-table-edit-formulas'. When at the first line of an src example, call `org-edit-src-code'. When in an #+include line, visit the include file. Otherwise call `ffap' to visit the file at point." (interactive) - (cond - ((org-at-table.el-p) - (org-edit-src-code)) - ((org-at-table-p) - (call-interactively 'org-table-edit-formulas)) + ;; possibly prep session before editing source + (when 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]*<include\\>.*?file=\"\\)\\([^\"\n>]+\\)")) (find-file (org-trim (match-string 1)))) ((org-edit-src-code)) ((org-edit-fixed-width-region)) + ((org-at-table.el-p) + (org-edit-src-code)) + ((org-at-table-p) + (call-interactively 'org-table-edit-formulas)) (t (call-interactively 'ffap)))) @@ -16276,7 +17089,13 @@ This command does many different things, depending on context: - If the cursor is on a numbered item in a plain list, renumber the ordered list. -- If the cursor is on a checkbox, toggle it." +- If the cursor is on a checkbox, toggle it. + +- If the cursor is on a code block, evaluate it. The variable + `org-confirm-babel-evaluate' can be used to control prompting + before code block evaluation, by default every code block + 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 @@ -16311,11 +17130,13 @@ This command does many different things, depending on context: (org-footnote-at-definition-p)) (call-interactively 'org-footnote-action)) ((org-at-item-checkbox-p) - (call-interactively 'org-toggle-checkbox)) + (call-interactively 'org-toggle-checkbox) + (org-list-send-list 'maybe)) ((org-at-item-p) (if arg (call-interactively 'org-toggle-checkbox) - (call-interactively 'org-maybe-renumber-ordered-list))) + (call-interactively 'org-maybe-renumber-ordered-list)) + (org-list-send-list 'maybe)) ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re)) ;; Dynamic block (beginning-of-line 1) @@ -16350,7 +17171,9 @@ Also updates the keyword regular expressions." "If this is a Note buffer, abort storing the note. Else call `show-branches'." (interactive) (if (not org-finish-function) - (call-interactively 'show-branches) + (progn + (hide-subtree) + (call-interactively 'show-branches)) (let ((org-note-abort t)) (funcall org-finish-function)))) @@ -16645,7 +17468,7 @@ See the individual commands for more information." ["Previous link" org-previous-link t] "--" ["Descriptive Links" - (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) + (progn (add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) :style radio :selected (member '(org-link) buffer-invisibility-spec)] ["Literal Links" @@ -16662,8 +17485,8 @@ See the individual commands for more information." ["Complete Keyword" org-complete (assq :todo-keyword (org-context))] ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))] ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]) - ["Show TODO Tree" org-show-todo-tree t] - ["Global TODO list" org-todo-list t] + ["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"] + ["Global TODO list" org-todo-list :active t :keys "C-c a t"] "--" ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies) :selected org-enforce-todo-dependencies :style toggle :active t] @@ -16759,7 +17582,7 @@ See the individual commands for more information." :style toggle :selected (and (boundp 'org-export-with-LaTeX-fragments) org-export-with-LaTeX-fragments)] "--" - ["Template for BEAMER" org-beamer-settings-template t]) + ["Template for BEAMER" org-insert-beamer-options-template t]) "--" ("MobileOrg" ["Push Files and Views" org-mobile-push t] @@ -16892,8 +17715,18 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (dir-org-contrib (ignore-errors (file-name-directory (org-find-library-name "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 (directory-files dir-org t file-re) + babel-files (and dir-org-contrib (directory-files dir-org-contrib t file-re)))) (remove-re (concat (if (featurep 'xemacs) @@ -16960,9 +17793,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions." "Display the given MESSAGE as a warning." (if (fboundp 'display-warning) (display-warning 'org message - (if (featurep 'xemacs) - 'warning - :warning)) + (if (featurep 'xemacs) 'warning :warning)) (let ((buf (get-buffer-create "*Org warnings*"))) (with-current-buffer buf (goto-char (point-max)) @@ -16976,6 +17807,13 @@ With prefix arg UNCOMPILED, load the uncompiled versions." "Is point in a line starting with `#'?" (equal (char-after (point-at-bol)) ?#)) +(defun org-in-indented-comment-line () + "Is point in a line starting with `#' after some white space?" + (save-excursion + (save-match-data + (goto-char (point-at-bol)) + (looking-at "[ \t]*#")))) + (defun org-in-verbatim-emphasis () (save-match-data (and (org-in-regexp org-emph-re 2) (member (match-string 3) '("=" "~"))))) @@ -17283,11 +18121,11 @@ and :keyword." (mapcar (lambda (x) (if (memq x org-latex-fragment-image-overlays) x)) - (org-overlays-at (point)))))) + (overlays-at (point)))))) (push (list :latex-fragment - (org-overlay-start o) (org-overlay-end o)) clist) + (overlay-start o) (overlay-end o)) clist) (push (list :latex-preview - (org-overlay-start o) (org-overlay-end o)) clist)) + (overlay-start o) (overlay-end o)) clist)) ((org-inside-LaTeX-fragment-p) ;; FIXME: positions wrong. (push (list :latex-fragment (point) (point)) clist))) @@ -17326,7 +18164,7 @@ really on, so that the block visually is on the match." nil)))) (defun org-in-regexps-block-p (start-re end-re) - "Returns t if the current point is between matches of START-RE and END-RE. + "Return t if the current point is between matches of START-RE and END-RE. This will also return to if point is on one of the two matches." (interactive) (let ((p (point))) @@ -17403,6 +18241,33 @@ for the search purpose." (setq list (delete (pop elts) list))) list) +(defun org-count (cl-item cl-seq) + "Count the number of occurrences of ITEM in SEQ. +Taken from `count' in cl-seq.el with all keyword arguments removed." + (let ((cl-end (length cl-seq)) (cl-start 0) (cl-count 0) cl-x) + (when (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) + (while (< cl-start cl-end) + (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start))) + (if (equal cl-item cl-x) (setq cl-count (1+ cl-count))) + (setq cl-start (1+ cl-start))) + cl-count)) + +(defun org-remove-if (predicate seq) + "Remove everything from SEQ that fulfills PREDICATE." + (let (res e) + (while seq + (setq e (pop seq)) + (if (not (funcall predicate e)) (push e res))) + (nreverse res))) + +(defun org-remove-if-not (predicate seq) + "Remove everything from SEQ that does not fulfill PREDICATE." + (let (res e) + (while seq + (setq e (pop seq)) + (if (funcall predicate e) (push e res))) + (nreverse res))) + (defun org-back-over-empty-lines () "Move backwards over whitespace, to the beginning of the first empty line. Returns the number of empty lines passed." @@ -17418,7 +18283,7 @@ Returns the number of empty lines passed." (defun org-point-in-group (point group &optional context) "Check if POINT is in match-group GROUP. If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the -match. If the match group does ot exist or point is not inside it, +match. If the match group does not exist or point is not inside it, return nil." (and (match-beginning group) (>= point (match-beginning group)) @@ -17429,7 +18294,8 @@ return nil." (defun org-switch-to-buffer-other-window (&rest args) "Switch to buffer in a second window on the current frame. -In particular, do not allow pop-up frames." +In particular, do not allow pop-up frames. +Returns the newly created buffer." (let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) (apply 'switch-to-buffer-other-window args))) @@ -17480,17 +18346,27 @@ TABLE is an association list with keys like \"%a\" and string values. The sequences in STRING may contain normal field width and padding information, for example \"%-5s\". Replacements happen in the sequence given by TABLE, so values can contain further %-escapes if they are define later in TABLE." - (let ((case-fold-search nil) - e re rpl) - (while (setq e (pop table)) + (let ((tbl (copy-alist table)) + (case-fold-search nil) + (pchg 0) + e re rpl) + (while (setq e (pop tbl)) (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) + (when (and (cdr e) (string-match re (cdr e))) + (let ((sref (substring (cdr e) (match-beginning 0) (match-end 0))) + (safe "SREF")) + (add-text-properties 0 3 (list 'sref sref) safe) + (setcdr e (replace-match safe t t (cdr e))))) (while (string-match re string) - (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") - (cdr e))) - (setq string (replace-match rpl t t string)))) + (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") + (cdr e))) + (setq string (replace-match rpl t t string)))) + (while (setq pchg (next-property-change pchg string)) + (let ((sref (get-text-property pchg 'sref string))) + (when (and sref (string-match "SREF" string pchg)) + (setq string (replace-match sref t t string))))) string)) - (defun org-sublist (list start end) "Return a section of LIST, from START to END. Counting starts at 1." @@ -17685,7 +18561,7 @@ the functionality can be provided as a fall-back.") (org-set-local 'fill-paragraph-function 'org-fill-paragraph) ;; Adaptive filling: To get full control, first make sure that ;; `adaptive-fill-regexp' never matches. Then install our own matcher. - (unless (local-variable-p 'adaptive-fill-regexp) + (unless (local-variable-p 'adaptive-fill-regexp (current-buffer)) (org-set-local 'org-adaptive-fill-regexp-backup adaptive-fill-regexp)) (org-set-local 'adaptive-fill-regexp "\000") @@ -17836,8 +18712,8 @@ beyond the end of the headline." (if (bobp) nil (backward-char 1) - (if (org-invisible-p) - (while (and (not (bobp)) (org-invisible-p)) + (if (org-truely-invisible-p) + (while (and (not (bobp)) (org-truely-invisible-p)) (backward-char 1) (beginning-of-line 1)) (forward-char 1)))) @@ -17933,6 +18809,11 @@ depending on context." ((or (not org-special-ctrl-k) (bolp) (not (org-on-heading-p))) + (if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible) + org-ctrl-k-protect-subtree) + (if (or (eq org-ctrl-k-protect-subtree 'error) + (not (y-or-n-p "Kill hidden subtree along with headline? "))) + (error "C-k aborted - would kill hidden subtree"))) (call-interactively 'kill-line)) ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$")) (kill-region (point) (match-beginning 1)) @@ -17960,7 +18841,8 @@ org-yank-adjusted-subtrees *visible* surrounding headings. Any prefix to this command will cause `yank' to be called directly with -no special treatment. In particular, a simple `C-u' prefix will just +no special treatment. In particular, a simple \\[universal-argument] prefix \ +will just plainly yank the text as it is. \[1] The test checks if the first non-white line is a heading @@ -18050,6 +18932,17 @@ interactive command with similar behavior." (outline-invisible-p) (get-char-property (point) 'invisible))) +(defun org-truely-invisible-p () + "Check if point is at a character currently not visible. +This version does not only check the character property, but also +`visible-mode'." + ;; Early versions of noutline don't have `outline-invisible-p'. + (if (org-bound-and-true-p visible-mode) + nil + (if (fboundp 'outline-invisible-p) + (outline-invisible-p) + (get-char-property (point) 'invisible)))) + (defun org-invisible-p2 () "Check if point is at a character currently not visible." (save-excursion @@ -18066,6 +18959,13 @@ interactive command with similar behavior." (error (error "Before first headline at position %d in buffer %s" (point) (current-buffer))))) +(defun org-beginning-of-defun () + "Go to the beginning of the subtree, i.e. back to the heading." + (org-back-to-heading)) +(defun org-end-of-defun () + "Go to the end of the subtree." + (org-end-of-subtree nil t)) + (defun org-before-first-heading-p () "Before first heading?" (save-excursion @@ -18410,11 +19310,11 @@ if no description is present" ;; Speedbar support -(defvar org-speedbar-restriction-lock-overlay (org-make-overlay 1 1) +(defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1) "Overlay marking the agenda restriction line in speedbar.") -(org-overlay-put org-speedbar-restriction-lock-overlay +(overlay-put org-speedbar-restriction-lock-overlay 'face 'org-agenda-restriction-lock) -(org-overlay-put org-speedbar-restriction-lock-overlay +(overlay-put org-speedbar-restriction-lock-overlay 'help-echo "Agendas are currently limited to this item.") (org-detach-overlay org-speedbar-restriction-lock-overlay) @@ -18447,8 +19347,8 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (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"))) - (org-move-overlay org-speedbar-restriction-lock-overlay - (point-at-bol) (point-at-eol)) + (move-overlay org-speedbar-restriction-lock-overlay + (point-at-bol) (point-at-eol)) (setq current-prefix-arg nil) (org-agenda-maybe-redo))) @@ -18462,7 +19362,6 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (add-hook 'speedbar-visiting-tag-hook (lambda () (and (org-mode-p) (org-show-context 'org-goto)))))) - ;;; Fixes and Hacks for problems with other packages ;; Make flyspell not check words in links, to not mess up our keymap |