diff options
| author | Carsten Dominik <dominik@science.uva.nl> | 2009-08-06 09:14:10 +0000 |
|---|---|---|
| committer | Carsten Dominik <dominik@science.uva.nl> | 2009-08-06 09:14:10 +0000 |
| commit | c8d0cf5ca023b996beb0ca15f7b054951acf9c7e (patch) | |
| tree | b1c465c4840dd899dc51ea577a3f5f70c4079e71 /lisp | |
| parent | 8c914fdb1828b576dd66fd4ef546c32d62252c06 (diff) | |
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-create-formula-image): Remove the -E option for
dvipng.
* org-exp.el (org-default-export-plist): Respect #+BIND.
(org-export-confirm-letbind): New function.
* org.el (org-paste-subtree): Test the kill ring entry if it is
going to be used.
(org-copy-subtree): Use `org-forward-same-level'.
(org-forward-same-level): Respect the `invisibe-ok' arg for
back-to-heading.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-table-map-tables): Make sure cursor is back at table
beginning after funcall.
* org-agenda.el (org-agenda-bulk-action): Make sure parents are
handled before children, and do not error if an entry is not
found, probably because it hase been remove when the parent was
archived or refiled.
* org.el (org-ido-completing-read): Accept straight lists for
completion as well as alists.
* org-timer.el (org-timer-cancel-timers): Renamed from
`org-timer-cancel-timers'.
* org.el (org-cycle-internal-local): Fix problem with finding next
invisible line.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-list.el (org-list-send-list): Call
`org-list-goto-true-beginning' instead of
`org-list-find-true-beginning', which does not exist.
* org-timer.el (org-timer-reset-timers): Use `mapc'.
(org-timer-set-timer): Do not assign to heading.
* org-id.el (org-id-open): Quote function name.
* org-macs.el (org-unmodified): Turn off recording undo
information while running inside the macro.
* org-table.el (org-table-export): Also work in file-less
buffers.
* org.el (org-startup-indented): New option.
(org-startup-options): Add new options indent and noindent.
(org-unfontify-region): Remove line-prefix and wrap-prefix
properties.
(org-after-demote-entry-hook, org-after-promote-entry-hook): New
hooks.
(org-promote, org-demote): Run the new hooks.
* org-table.el (org-table-align): Replace leading \n as well.
* org-exp.el (org-export-push-to-kill-ring): Remove `line-prefix'
and `line-wrap' text properties.
* org-compat.el (org-kill-new): New function.
* org-agenda.el (org-format-agenda-item): Remove `line-prefix' and
`line-wrap' text properties.
* org-indent.el: New file.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-provide-todo-statistics): Tweak docstring.
* org-id.el (org-id-open): Honor `org-link-frame-setup'.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-as-org): Insert the "-source" string
before the extension.
* org.el (org-read-date): Make sure the calendar is in the current
frame.
(org-set-emph-re): Remove the ? from the post-match.
(org-emphasis-regexp-components): Add backslash to the
postmatch class.
(org-set-font-lock-defaults): Write \n instead of \xa, and make it
optional so that also lines at the end of the buffers will still
be matched as headlines.
* org-table.el (org-table-error-on-row-ref-crossing-hline):
Variable made obsolete.
(org-table-relative-ref-may-cross-hline): New option.
(org-table-find-row-type): Honow the new option
`org-table-relative-ref-may-cross-hline'.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-table.el (org-table-cut-region, org-table-copy-region): Work
on single field if no active region.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-make-header): Only insert title
if one is defined.
* org.el (org-make-options-regexp): Allow empty values.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-cycle-internal-local): Improved version of finding
next visible line.
(org-cycle-hide-drawers): Only hide drawers if this is really
necessary.
(outline-end-of-subtree): Make `outline-end-of-subtree' use the
org-version of this function in Org-mode. We use advice to
implement this change, so that future changes to this function in
outline.el wil be handled properly.
(org-forward-same-level, org-backward-same-level): New commands.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-remove-empty-overlays-at)
(org-clean-visibility-after-subtree-move): New functons.
(org-move-subtree-down): Simplify cleanup of display.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-mac-message.el (org-mac-message-get-links): Improve
docstring. Make argument SELECT-OR-FLAGGED optional, default to
"s". Fix the return value.
(org-mac-message-insert-flagged): Simplify.
* org.el (org-refile-get-location): Tamper with refile history o
that history contains compete matches instead of the entered
string.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-store-link): Never store a link to an inline task.
* org-footnote.el (org-footnote-goto-local-insertion-point): Skip
inline tasks when positioning footnotes.
* org.el (org-refile): Remove the END line when archiving an
inline task that does have an END line.
* org-archive.el (org-archive-subtree): Remove the END line when
archiving an inline task that does have an END line.
* org-macs.el (org-with-limited-levels): New macro.
(org-get-limited-outline-regexp): New function.
* org-exp.el (org-export-format-source-code-or-example): Fix bug
that did not enumerate first line.
(org-export-mark-radio-links): Skip matches in links.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-activate-plain-links): Make single-match.
(org-adapt-indentation): Fix docstring.
* org-macs.el (org-unmodified): Turn of modification hooks while
running this macro.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org.el (org-adapt-indentation): Slightly improve the docstring.
(org-occur): Sends an error when the user inputs an empty string.
(org-priority): Bugfix: the tag alignement should happen within
save-excursion.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org.el (org-make-link-regexps): Don't exclude parentheses from
`org-plain-link-re'
(org-cycle-internal-local): When locally cycling, switch directly
from CHILDREN to FOLDED if there is no subtree
(org-cycle): Update the docstring to document the new behavior of
`org-cycle-internal-local'.
2009-08-06 Nicolas Goaziou <n.goaziou@neuf.fr> (tiny change)
* org-clock.el (org-clock-in): Bugfix: recognize timestamps with
an abbreviated format for days.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org-protocol.el (org-protocol-default-template-key): New
option.
* org.el (org-refile): Bugfix: save-excursion before reading the
refile target, otherwise cursor moves might confuse `org-refile'.
* org.el (org-toggle-heading): Bugfix: correctly convert list
items before the first headline.
* org.el (org-provide-todo-statistics): Allow a list of TODO
keywords to compute statistics against headlines containing a
keyword from this list.
(org-update-parent-todo-statistics): Possibly use the new allowed
value of `org-provide-todo-statistics'.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org-timer.el: Add autoload cookie.
* org.el (org-occur-link-in-agenda-files): New function.
* org-timer.el (org-timer-last-timer): New variable.
* org-agenda.el (org-agenda-mode-map): New key for
org-timer-set-timer called from the agenda.
* org.el (org-mode-map): New key for org-timer-set-timer.
* org-timer.el (org-timer-reset-timers)
(org-timer-show-remaining-time, org-timer-set-timer): New
functions.
* org-clock.el (org-show-notification): Update the docstring.
* org.el (org-provide-todo-statistics): Allow new value
'all-headlines for this option, which includes entries with no
TODO keywords in the todo statistics.
(org-update-parent-todo-statistics): Possibly use the new
'all-headline value from `org-provide-todo-statistics'.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org-clock.el (org-dblock-write:clocktable): Add a new option
:timestamp which allows display of timestamps in clock reports.
* org.el (org-mode-map): Define new key `C-c C-*': convert a plain
list to a subtree, preserving the structure of the list.
(org-set-emph-re): Make the last element optional in the regexp.
This regexp now matches an emphasized string at the end of a line.
* org-list.el (org-list-goto-true-beginning)
(org-list-make-subtree, org-list-make-subtrees): New functions.
* org.el (org-eval-in-calendar): Select the right frame.
(org-save-frame-excursion): Remove this macro.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org-list.el (org-list-beginning-re): Bugfix: don't use * when
trying to find the beginning of a list.
* org-exp.el (org-get-file-contents): Use a new argument: markup.
When present, tell org-get-file-contents not to protect org-like
lines.
* org-id.el (org-id-uuid-program): New option to set the name of
the uuidgen program.
(org-id-method): Use `org-id-uuid-program'.
(org-id-new): Use `org-id-uuid-program'.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org-exp.el (org-export-number-lines): Allow whitespace in code
references. Allow the -r switch to remove the references in the
source code even when the lines are not numbered: the labels can
be explicit enough.
* org.el (org-fontify-whole-heading-line): New option.
(org-set-font-lock-defaults): Use the new option.
* org-clock.el (org-show-notification-handler): New option.
(org-show-notification): Use the new option.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org.el (org-eval-in-calendar): Fix a bug about calendar
navigation when `calendar-setup' value is 'calendar-only.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org.el (orgstruct++-mode): Fix typo in docstring.
(org-insert-link): Clean up: (or (...)) => (...)
(org-insert-link): Use TAB for stored links completion.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org.el (org-get-refile-targets): Fix bug: don't ignore case when
building the list of targets.
* org-remember.el (org-remember-delete-empty-lines-at-end): New
option.
(org-remember-handler): Use the new option.
2009-08-06 James TD Smith <ahktenzero@mohorovi.cc>
* org.el (org-tags-sort-function): New option for sorting tags.
(org-set-tags): Use the new option to sort tags.
* org-plot.el (org-plot/gnuplot): Run with an idle timer to avoid
premature deletion of the data when using org-plot in a script.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org-clock.el (org-clock-in-prepare-hook): New hook.
(org-clock-in): Use this new hook.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org.el (org-special-ctrl-a/e): Explicitely bind the value
'reversed for this option to the "true line boundary first"
behavior.
(org-tags-match-list-sublevels): Document the 'indented value for
this variable.
* org-latex.el (org-export-latex-first-lines): Fix problem with
publishing the region.
* org-exp.el (org-export-format-source-code-or-example): Fix
bad line numbering when exporting examples in HTML.
2009-08-06 James TD Smith <ahktenzero@mohorovi.cc>
* org-colview.el (org-format-time-period): Formats a time in
fractional days as days, hours, mins, seconds.
(org-columns-display-here): Add special handling for SINCE and
SINCE_IA to format for display.
* org.el (org-time-since): Add a function to get the time since an
org timestamp.
(org-entry-properties): Add two new special properties: SINCE and
SINCE_IA. These give the time since any active or inactive
timestamp in an entry.
(org-special-properties): Add SINCE, SINCE_IA.
(org-tags-sort-function): Add custom declaration for tags
sorting function.
(org-set-tags): Sort tags if org-tags-sort-function is set
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-clock-goto): Find hidden headlines as well.
* org.el (org-narrow-to-subtree): Find hidden headlines as well.
* org-plot.el (org-plot/add-options-to-plist): Add timeind
option.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-publish.el (org-publish-remove-all-timestamps): New function.
(org-publish-all): Remove all timestamp files if `org-publish-all'
is called with a prefix argument.
* org-list.el (org-indent-item): Fix typo.
(org-item-indent-positions): Normalize ordered bullet.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-macs.el (org-set-local): Make a local variable, do not make
the variable buffer-local!
* org-latex.el (org-export-as-latex): Call `org-install-letbind'.
* org-exp.el (org-infile-export-plist): Read BIND lines.
(org-install-letbind): New function.
(org-export-as-org, org-export-preprocess-string): Call
`org-install-letbind'.
* org-list.el (org-list-demote-modify-bullet): New option.
(org-first-list-item-p): Save point.
(org-fix-bullet-type): New optional argument FORCE-BULLET.
(org-indent-item): Honor `org-list-demote-modify-bullet'.
(org-item-indent-positions): Return bullet types along with
indentation.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-show-entry): Hide drawers.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-footnote.el (org-footnote-auto-adjust): New option.
(org-footnote-auto-adjust-maybe): New function.
(org-footnote-new, org-footnote-delete): Call
`org-footnote-auto-adjust-maybe'.
* org.el (org-startup-options): Add new footnote-related
keywords.
* org-publish.el (org-publish-timestamp-filename): Additional
arguments PUB-DIR and PUB-FUNC, which are included in the hash.
(org-publish-needed-p): Additional arguments PUB-DIR PUB-FUNC
TRUE-PUB-DIR. Pass them through to
`org-publish-timestamp-filename'.
(org-publish-update-timestamp): Additional arguments PUB-DIR and
PUB-FUNC, which are included in the hash.
(org-publish-file): Delay timestamp test until the publishing
function is known.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-bulk-action): Add scheduling and
setting the deadline.
* org.el (org-read-date-final-answer): New variable.
(org-read-date): Store the final answer string, including the date
from the calendar, for reuse by agenda bulk commands.
* org-publish.el (org-publish-attachment): Fix publishing of
attachments.
* org-latex.el (org-export-latex-quotation-marks): Fix export of
quotation makrs in parenthesis.
(org-remove-initial-hash): New function.
(org-export-latex-preprocess): Fix bug with infinite loop if
environment is not properly closed.
* org-table.el (org-table-get-remote-range): Find #+TBLNAME also
when indented.
* org.el (org-fontify-meta-lines-and-blocks): Make #+TBLNAME
highlight also when indented.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-footnote.el (org-footnote-renumber-fn:N): New command.
(org-footnote-action): Offer renumbering.
* org.el (org-cycle): Honor the `integrate' value of
org-cycle-include-plain-lists'.
* org-list.el (org-cycle-include-plain-lists): New allowed value
`internal'. Improve the docstring.
* org.el (org-set-autofill-regexps): Improve the paragraph-start
regexp to work better with LaTeX commands.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-inline-image-extensions): Add ps
and eps extensions.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-write-agenda): Make sure org-icalendar is
loaded.
* org.el (org-map-entries): No longer force
`org-tags-match-list-sublevels' to t during a todo-only tags
search.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-low-levels): Allow user-defined
environment.
(org-export-latex-subcontent): Handle user-defined environment.
* org-agenda.el (org-agenda-view-mode-dispatch): Add more keys to
the View dispatcher.
* org.el (org-hide-block-toggle): Use `org-make-overlay' instead of
`make-overlay'.
* org-latex.el (org-export-as-pdf): Protect match data during call
to shell-quote-argument.
* org-agenda.el (org-agenda-mode-map): Modify bulk action keys.
(org-agenda-view-mode-dispatch): New function.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-mode): Reset list of marks.
(org-agenda-mode-map): Define new keys for refile and bulk action.
(org-agenda-menu): Add menu itesm for refile and bulk action.
(org-agenda-refile): New function.
(org-agenda-set-tags): Optional arguments TAG and ONOFF.
(org-agenda-marked-entries): New variable.
(org-agenda-bulk-select, org-agenda-remove-bulk-action-overlays)
(org-agenda-remove-all-bulk-action-marks)
(org-agenda-bulk-action): New functions/commands.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-get-file-contents): Protect org-like lines in
included files.
(org-export-format-source-code-or-example): Remove newlines.
* org-latex.el (org-export-latex-links): Check for no-description
marking.
* org-exp.el (org-export-preprocess-apply-macros): Switch macro
argument separator back to comma.
(org-export-normalize-links): Mark links without description.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-infile-export-plist): Fix bug in macro
processing.
* org-agenda.el (org-agenda-clock-out): Update line after clocking
out.
(org-agenda-highlight-todo): Fix bug with highlighting.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-set-font-lock-defaults): Adapt formatting to capture
new alignment strings.
* org-table.el (orgtbl-self-insert-command): Add yas/expand to
command list.
(org-table-align): Check for forced align type.
* org.el (org-self-insert-command): Add yas/expand to command
list.
* org-clock.el (org-clock-in-hook): New hook.
(org-clock-in): Run `org-clock-in-hook.
(org-clock-out-hook): New hook.
(org-clock-out): Run `org-clock-out-hook.
(org-clock-cancel-hook): New hook.
(org-clock-cancel): Run `org-clock-cancel-hook.
(org-clock-goto-hook): New hook.
(org-clock-goto): Run `org-clock-goto-hook.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-store-link): Better default description for link to
Org-mode headline.
* org-exp.el (org-export-generic): Autoload the generic exporter
function.
(org-export): Implement the `g' key for the generic exporter.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-table.el (orgtbl-setup): Add a binding for `S-iso-lefttab',
and for zbacktab'.
* org-exp.el (org-infile-export-plist): Get macros also from
#+SETUPFILE.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-colview.el (org-columns-capture-view): Protect vertical bars
in column values.
(org-columns-capture-view): Exclude comment and archived trees.
* org-colview-xemacs.el (org-columns-capture-view): Protect
vertical bars in column values.
(org-columns-capture-view): Exclude comment and archived trees.
* org.el (org-quote-vert): New function.
* org-latex.el (org-export-latex-verbatim-wrap): New option.
* org-exp.el (org-export-format-source-code-or-example): Use
`org-export-latex-verbatim-wrap'.
* org.el (org-clone-subtree-with-time-shift): Also shift inactive
time stamps.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp-blocks.el: New file.
* org-remember.el (org-remember-templates): Allow the headline
element to be a function.
(org-remember-apply-template): If the headline is a function, call
it to get the true function.
* org-clock.el (org-clock-menu): New function.
(org-clock-update-mode-line): Update help string.
(org-clock-modify-effort-estimate): New function.
(org-clock-mark-default-task): New function.
* org.el (org-hh:mm-string-to-minutes): Also take just a number of
minutes as input.
(org-org-menu): Add new clocking stuff.
(org-clock-is-active): New function.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-open-non-existing-files): Improve docstring.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-icalendar.el (org-icalendar-include-bbdb-anniversaries): New
option.
(org-export-icalendar): Call `org-bbdb-anniv-export-ical'.
* org-bbdb.el (org-bbdb-anniv-export-ical): New function.
* org-list.el (org-get-checkbox-statistics-face): Use the new
faces.
* org-faces.el (org-checkbox-statistics-todo)
(org-checkbox-statistics-done): New faces.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-use-verb): New variable.
(org-export-latex-emph-format): Prefer \texttt over \verb when
org-export-latex-use-verb is set.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-remember.el (org-remember-handler): Abort remember if the
buffer is empty.
* org-exp.el (org-export-format-source-code-or-example): Run
`org-src-mode-hook'.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-indent-line-function): Fix indentation of +#end lines.
2009-08-06 Tassilo Horn <tassilo@member.fsf.org>
* org-gnus.el (org-gnus-store-link): Require message.el in
org-gnus-store-link.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-src.el: New file, split out of org.el
* org-macs.el (org-replace-match-keep-properties): New function.
* org-exp.el (org-export-mark-blockquote-verse-center): Better
preprocessing of center and quote and verse blocks.
* org-list.el (org-list-end): Respect the stored "original"
indentation when determining the end of the list.
* org-exp.el (org-export-replace-src-segments-and-examples):
Remember indentation correctly.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-clock-update-mode-line): Apply face
org-mode-line-clock.
* org-faces.el (org-mode-line-clock): New face.
2009-08-06 Tassilo Horn <tassilo@member.fsf.org>
* org-gnus.el (org-gnus-store-link): Fix bug where
`org-gnus-store-link' used wrong subject when called in an article
buffer. Patch provided by fengli AT gmail DOT com.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-format-source-code-or-example): Remember
the original indentation of source code snippets and examples.
* org-latex.el (org-export-as-latex): Relocate the table of
contents.
* org.el (org-ctrl-c-ctrl-c): Update clock lines.
* org-agenda.el (org-run-agenda-series): Scope global options also
when creating the agenda buffer.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-adapt-indentation): Improve documentation.
(org-insert-property-drawer): Respect org-adapt-indentation when
inserting the drawer.
(org-remove-flyspell-overlays-in): New function.
(org-do-emphasis-faces, org-activate-plain-links)
(org-activate-code, org-fontify-meta-lines-and-blocks)
(org-activate-angle-links, org-activate-footnote-links)
(org-activate-bracket-links, org-activate-dates)
(org-activate-target-links, org-activate-tags): Remove flyspell
overlays.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-edit-src-save): New function.
* org-clock.el (org-clock-out-switch-to-state): New option.
(org-clock-out): Honor `org-clock-out-switch-to-state'.
* org-compat.el (org-compatible-face): Improve macro.
* org.el (org-global-properties-fixed): Add default for
CLOCK_MODELINE_TOTAL.
* org-clock.el (org-clock-sum): Accept lists and strigs as tstart
andd tend.
(org-clock-sum-current-item): Optional argument TSTART, pass it to
org-clock-sum.
(org-clock-get-sum-start): New function.
* org.el (org-startup-options): New keywords blockhide and
blockshow.
(org-mode): Add new invisibility spec.
(org-set-startup-visibility): Hide block on startup if so
desired.
(org-hide-block-startup): New option.
(org-block-regexp): New constant.
(org-hide-block-overlays): New variable.
(org-block-map, org-hide-block-toggle-all, org-hide-block-all)
(org-show-block-all, org-hide-block-toggle-maybe)
(org-hide-block-toggle): New functions.
(org-edit-src-exit): Do not quote lines starting with # and no +
behind it.
(org-auto-repeat-maybe): Add LAST_REPEAT properter for a repeating
entry.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-buffer-property-keys): Add Effort property for
completion.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-clock-sum-current-item): Fix positioning bug
when retrieving total clocked time in the subtree.
* org.el (org-quoting-blocks): New variable.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-table.el (org-table-store-formulas)
(org-table-get-stored-formulas, org-table-fix-formulas)
(org-table-edit-formulas, orgtbl-ctrl-c-ctrl-c)
(orgtbl-gather-send-defs): Allow indented #+TBLFM line.
* org.el (org-fontify-meta-lines, org-ctrl-c-ctrl-c): Allow
indented #+TBLFM line.
* org-footnote.el (org-footnote-goto-local-insertion-point): Allow
indented #+TBLFM line.
* org-colview.el (org-dblock-write:columnview): Allow indented
#+TBLFM line.
* org-colview-xemacs.el (org-dblock-write:columnview): Allow
indented #+TBLFM line.
* org-clock.el (org-dblock-write:clocktable): Allow indented
#+TBLFM line.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-format-source-code-or-example): Make
editing indented blocks work correctly.
* org.el (org-edit-src-nindent): New variable.
(org-edit-src-code, org-edit-fixed-width-region)
(org-edit-src-find-region-and-lang, org-edit-src-exit): Make
editing indented blocks work correctly.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-replace-src-segments-and-examples): FInd
indented blocks.
(org-export-format-source-code-or-example): Fix indentation of
blocks.
(org-export-remove-indentation): New function.
(org-export-select-backend-specific-text): Allow backend-specific
code to be indented.
(org-export-mark-blockquote-verse-center): Allow markers to be
indented.
* org.el (org-fontify-meta-lines): New function.
(org-set-font-lock-defaults): Call the new fontification
function.
* org-faces.el (org-meta-line): New face
(org-block): New face.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-treat-insert-todo-heading-as-state-change)
(org-treat-S-cursor-todo-selection-as-state-change): New
variables.
(org-insert-todo-heading): Honor
`org-treat-insert-todo-heading-as-state-change'.
(org-shiftright, org-shiftleft): Honor
`org-treat-S-cursor-todo-selection-as-state-change'.
(org-inhibit-logging): New variable.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-remove-subtree-entries-from-agenda): Reduce
range for marker position checking.
* org-latex.el (org-export-latex-first-lines): Fix bug when
exporting a region.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-push-to-kill-ring): Protect using
x-set-selection, because that does not always work.
* org-agenda.el (org-agenda-list): Apply the new face
`org-agenda-date-today'.
* org-faces.el (org-agenda-date-today): New face.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-to-appt): Turn off restriction when
creating appointments.
* org-latex.el (org-export-latex-low-levels): Fix customization
type.
* org.el (org-priority, org-shiftup, org-shiftdown): Disable
priority commands.
* org-agenda.el (org-agenda-priority): Disable priority commands.
* org.el (org-enable-priority-commands): New option.
* org-colview-xemacs.el (org-columns-compute)
(org-columns-number-to-string): Fix problems with empty fields.
* org-colview.el (org-columns-compute)
(org-columns-number-to-string): Fix problems with empty fields.
* org-exp.el (org-export-push-to-kill-ring): New function.
(org-export-copy-to-kill-ring): New option.
* org-latex.el (org-export-as-latex): Call
`org-export-push-to-kill-ring'.
* org-exp.el (org-export-show-temporary-export-buffer): New
option.
* org-latex.el (org-export-as-latex): Use
`org-export-show-temporary-export-buffer'.
* org-exp.el (org-export-show-temporary-export-buffer): New
option.
(org-export-push-to-kill-ring): New function.
* org-colview.el (org-columns-compile-map): New variable.
(org-columns-new, org-columns-compute)
(org-columns-number-to-string, org-columns-uncompile-format)
(org-columns-compile-format): Implement new operators.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-plist-vars): Add :xml-declaration.
* org-list.el (org-update-checkbox-count): Make property
dependent.
* org.el (org-hierarchical-todo-statistics): New option.
(org-update-parent-todo-statistics): Modified to handle recursive
statistics.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-publish.el (org-publish): Make this function behave
correctly in interactive use when called with a prefix argument.
* org.el (org-todo-statistics-hook): New hook.
(org-update-parent-todo-statistics): Use new hook.
(org-log-into-drawer): New function.
(org-add-log-setup): Use the new `org-log-into-drawer' function to
determine if we should be logging into a drawer.
(org-log-into-drawer): Update docstring.
(org-default-properties): Add LOG_INTO_DRAWER as a property.
* org-list.el (org-checkbox-statistics-hook): New hook.
(org-update-checkbox-count-maybe): Use new hook.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-edit-src-code, org-edit-fixed-width-region): Use a
better bufer-generating mechanism.
(org-edit-src-find-buffer): New function.
* org-icalendar.el (org-print-icalendar-entries): Don't check for
archive tag, this is already done by `org-agenda-skip'.
data while constructing lost of tags.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-preprocess-apply-macros): Use semicolon
as argument separator in macros.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-after-sorting-entries-or-items-hook): New hook.
(org-sort-entries-or-items): Run the new hook.
(org-after-refile-insert-hook): New hook.
(org-refile): Run `org-after-refile-insert-hook'.
* org-agenda.el (org-agenda-get-progress): Never take time of day
from headline when displaying progress.
* org-latex.el (org-export-latex-complex-heading-re): New variable.
(org-export-as-latex): Force the correct regexp in the
preprocessor buffer.
(org-export-latex-set-initial-vars): Set
`org-export-latex-complex-heading-re'.
* org-agenda.el (org-agenda-start-with-log-mode): New option.
(org-agenda-mode): Use `org-agenda-start-with-log-mode'.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-tables-centered): New option.
(org-export-latex-tables): Use `org-export-latex-tables-centered'.
* org-exp.el (org-export-as-org): New command.
(org-export-as-org): New command.
* org-publish.el (org-publish-org-to-org): New function.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-yank): Just call `org-yank-generic'.
(org-yank-generic): New function, containing the formaer
functionality of `org-yank'.
* org-latex.el (org-export-latex-not-done-keywords)
(org-export-latex-done-keywords): New variables.
(org-export-latex-todo-keyword-markup): New option.
(org-export-latex-set-initial-vars): Remember the TODO keywords.
(org-export-latex-keywords-maybe): Apply the TODO markup.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-infile-export-plist): Add more default macros.
(org-export-preprocess-apply-macros): Process macro arguments.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-icalendar.el (org-icalendar-include-todo): New allowedvalue
`unblocked'.
(org-print-icalendar-entries): Respect the new value of
`org-icalendar-include-todo'.
* org.el (org-link-try-special-completion)
(org-file-complete-link): New functions.
(org-insert-link): Add special completion support for some link
types.
* org-bbdb.el (org-bbdb-complete-link): New function.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-list.el (org-update-checkbox-count): Allow recursive
statistics.
(org-hierarchical-checkbox-statistics): New option.
* org.el (org-cycle): Remove erraneous space character.
* org-icalendar.el (org-icalendar-timezone): Initialize from
environment.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-autoload): Fix autoloading of ascii export
functions.
(org-modules): Add org-special-blocks.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-icalendar.el (org-start-icalendar-file): Use the new option.
(org-ical-timezone): New option.
* org-exp.el (org-export-get-coderef-format): Use the description
is present.
* org.el (org-sort-entries-or-items): Improve docstring, and make
better implementation for time sorting.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-edit-src-persistent-message): New option.
(org-edit-src-code, org-edit-fixed-width-region): Use the new
option.
* org-clock.el (org-clock-insert-selection-line): Fix prefious
patch.
* org.el (org-edit-src-code, org-edit-fixed-width-region): Use
separate buffer instead of indirect buffer to edit source code.
(org-edit-src-exit): Make this function work with the new setup.
* org-clock.el (org-clock-insert-selection-line): Make sure tasks
are properly fontified before shown in the selection menu.
* org.el (org-fontify-like-in-org-mode): New function.
* org-latex.el (org-export-latex-links): Use the property list to
retrieve the default image attributes.
* org-exp.el (org-export-plist-vars): Add a new option.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export, org-export-visible): Support ASCII
export to buffer
(org-export-normalize-links): Do not protect the description if it
is explicitly given.
* org-list.el (org-reset-checkbox-state-subtree): Moved here from
org-checklist.el.
(org-reset-checkbox-state-subtree): Call
`org-reset-checkbox-state-subtree'.
* org-remember.el (org-select-remember-template): For the
selection of a valid template.
* org-latex.el (org-export-region-as-latex): Supply the
force-no-subtree argument.
(org-export-as-latex): Provide better limits when exporting the
first line. When exporting to string, we still want the first
lines.
(org-export-latex-first-lines): New argument END, to force the end
of the region.
(org-export-region-as-latex): Use the property list.
(org-export-as-latex):
* org-colview-xemacs.el (org-columns-remove-overlays)
(org-columns): Fix call to `local-variable-p'.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-after-blockquotes-hook): New hook.
(org-export-latex-preprocess): Run the new hook.
* org-exp.el (org-export-preprocess-after-blockquote-hook): New hook.
(org-export-preprocess-string): Run the new hook.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-macs.el (org-check-external-command): New defsubst.
* org.el (org-mode-map): New key for reload.
(org-format-latex): Better error message when external programs
are not available.
* org-agenda.el (org-agenda-mode-map): Bind `org-reload'.
* org.el (org-sort-entries-or-items): Explicit sorting function
for priorities, needed for XEmacs compatibility.
* org-remember.el (org-remember-apply-template): Improve auto-save
behavior.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-preprocess): Also protect
environments ending in a star.
* org-list.el (org-at-item-p): Fix regular expression.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-end-of-subtree): Improve speed.
* org-agenda.el (org-agenda-get-timestamps)
(org-agenda-get-progress, org-agenda-get-deadlines)
(org-agenda-get-scheduled, org-agenda-get-blocks): Optimizations,
in particular, wait as long as possible to collect the tags.
(org-stuck-projects): Improve docstring.
* org.el (org-store-link): No errors when getting custom id before
first headline.
(org-get-tags-at): Use `org-up-heading-safe' when getting tags.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-prepare-agenda-buffers): Catch a throw to nextfile.
* org-protocol.el: Remove dependency on url.el.
(org-protocol-unhex-compound, org-protocol-open-source): Remove
dependency on url.el.
* org-latex.el (org-export-as-pdf): Use
`org-latex-to-pdf-process'.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-latex-to-pdf-process): New option.
* org-agenda.el (org-agenda-skip-additional-timestamps-same-entry):
New option.
(org-agenda-get-timestamps): Honor
`org-agenda-skip-additional-timestamps-same-entry'.
* org-clock.el (org-clock-goto-may-find-recent-task): New option.
(org-clock-goto): Find recent task only if
`org-clock-goto-may-find-recent-task' allows it.
* org-exp.el (org-export-remove-or-extract-drawers): Handle empty
drawers, and drawers that are missing the :END: line.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-clock-goto): Go to recently clocked task if no
clock is running.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-update-parent-todo-statistics): Check for
STATISTICS_FROM property.
* org-list.el (org-update-checkbox-count): Check for
STATISTICS_FROM property.
* org.el (org-tab-first-hook)
(org-tab-after-check-for-table-hook)
(org-tab-after-check-for-cycling-hook): New hooks.
(org-cycle-internal-global, org-cycle-internal-local): New
functions, split out from `org-cycle'.
(org-cycle): Call the new hooks.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-preprocess-string): Reset the list of
preferred targets for each run of the preprocessor.
* org.el (org-refile-target-verify-function): Improve
documentation.
(org-get-refile-targets): Respect point being moved by the
verification function.
* org-latex.el (org-export-latex-timestamp-keyword-markup): New
option.
(org-export-latex-keywords): Use new option.
* org.el (org-rear-nonsticky-at): New defsubst.
(org-activate-plain-links, org-activate-angle-links)
(org-activate-footnote-links, org-activate-bracket-links)
(org-activate-dates, org-activate-target-links)
(org-activate-tags): Place the rear-nonsticky properties at the
correct location.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-protocol.el (server-edit): Declare `server-edit'.
(org-protocol-unhex-string, org-protocol-unhex-compound): New
functions.
(org-protocol-check-filename-for-protocol): Call `server-edit'.
* org.el (org-default-properties): New default properteis for
completion.
* org-exp.el (org-export-add-subtree-options): Add new properties
for subtree export.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-id.el (org-id-get-with-outline-path-completion): Turn off
org-refile-target-verify-function for the duration of the command.
* org.el (org-link-to-org-use-id): New possible value
`create-if-interactive-and-no-custom-id'.
(org-store-link): Use custom IDs.
(org-link-search): Find custom ID properties from #link.
(org-default-properties): Add CUSTOM_ID for property completion.
(org-refile-target-verify-function): New option.
(org-goto): Turn off org-refile-target-verify-function
for the duration of the command.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-preferred-target-alist): New variable.
(org-export-define-heading-targets): Find the new CUSTOM_ID
property.
(org-export-target-internal-links): Target the custom ids when
possible.
* org-latex.el (org-export-latex-preprocess): Better regexp for
matching latex macros with arguments.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-remember.el (org-remember-handler): Allow filing to non-org
files.
2009-08-06 Magnus Henoch <magnus.henoch@gmail.com>
* org-table.el (org-table-fix-formulas): Do not change references
to remote tables.
(org-table-get-remote-range): Convert standard coordinates to RC
format.
* org-latex.el (org-export-latex-keywords): Fix regexp bug.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-compat.el (org-sha1-string): Function removed.
* org.el (org-refile-allow-creating-parent-nodes): New option.
(org-refile-get-location): New argument NEW-NODES.
(org-refile): Call `org-refile-get-location' with the new
argument.
(org-refile-get-location): Arrange for adding a new child.
(org-refile-new-child): New function.
* org-clock.el: Fix a number of docstrings.
(org-clock-find-position): New argument
FIND-UNCLOSED to make the function find an unclosed clock in the
entry.
(org-clock-in): Call `org-clock-find-position' with the new
argument if we might be resuming a clock.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-display-custom-times): New variable.
(org-export-latex-timestamp-markup): New option.
(org-export-latex-set-initial-vars): Remember the local value of
`org-display-custom-times'.
(org-export-latex-content): Process time stamps.
(org-export-latex-time-stamps): New function.
* org-macs.el (org-maybe-intangible): Add intangible property
again to invisible text.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-default-export-plist): Handle undefined
variables.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-sort-entries-or-items): Match TODO keywrds
case-sensitively, when sorting.
(org-priority): Do not match TODO keywords with wrong case.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-todo): Honor the NOBLOCKING property.
* org-agenda.el (org-agenda-dim-blocked-tasks): Honor the
NOBLOCKING property.
* org.el (org-scan-tags): Fix bug in tag scanner
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-modules): Mark obsolete packages.
* org-html.el: New file, split out from org-exp.el.
* org-icalendar.el: New file, split out from org-exp.el.
* org-xoxo.el: New file, split out from org-exp.el.
* org-ascii.el: New file, split out from org-exp.el.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-compat.el (org-find-library-name): New function.
* org.el (org-pre-cycle-hook): New hook.
(org-cycle): Call the new hook in appropriate places.
(org-reload): Only reload files that have been loaded before.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-set-font-lock-defaults): Enforxe space or line end
after todo keyword.
(org-todo): When changing TODO state, do matching
case-sensitively.
(org-map-continue-from): New variable.
(org-scan-tags): Respect values in `org-map-continue-from'.
(org-reload): Make XEmacs compatible.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-protocol.el (org-protocol-flatten-greedy): New function.
(org-protocol-flatten): New function.
* org.el (org-open-link-from-string): Pass reference buffer to
`org-open-at-point'.
(org-open-at-point): New optional argument `reference-buffer'.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-scan-tags): Make tag scan find headline in first
line, 2nd attempt.
(org-get-refile-targets): Add the naked file name.
(org-refile): Store as top-level entry when only file name was
given.
* org-agenda.el (org-agenda-get-progress): Fix regexp bug.
* org.el (org-block-todo-from-children-or-siblings-or-parent):
Renamed from org-block-todo-from-children-or-siblings, and
enhanced to look for the parent's status as well.
* org-agenda.el (org-agenda-log-mode-add-notes): New option.
(org-agenda-get-progress): Add first notes line to log entry if so
desired.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-cleanup-fancy-diary-hook): New hook.
(org-agenda-cleanup-fancy-diary): Call the new hook.
* org-remember.el (org-remember-apply-template): Take the default
for the annotation from the :annotation property.
* org-mac-message.el (org-mac-message-get-link): Remove the
quotes.
(org-mac-message-get-link): Return the result.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-refile-get-location): Add file name only if not
already included in outline path.
* org-faces.el (org-n-level-faces): Fix customization type from
number to integer.
* org-exp.el (org-export-headline-levels): Fix customization type
from number to integer.
* org-agenda.el (org-agenda-confirm-kill)
(org-agenda-custom-commands-local-options)
(org-timeline-show-empty-dates, org-agenda-ndays)
(org-agenda-start-on-weekday, org-scheduled-past-days): Fix
customization type from number to integer.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-protocol.el: Declare some functions.
* org-agenda.el (org-agenda-compare-effort): Honor
`org-sort-agenda-noeffort-is-high'.
(org-agenda-filter-by-tag, org-agenda-filter-make-matcher)
(org-agenda-compare-effort): Implement the "?" operator for
finding entries without effort setting.
* org.el (org-extract-attributes-from-string): New function.
* org-exp.el (org-export-splice-attributes): New function.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-mouse.el: XEmacs compatibility fixes
* org.el (org-modules): Add org-inlinetasks.el
(org-cycle): Implement limiting level on cycling.
(org-move-subtree-down): Fix bug with swapping subtrees at end of
buffer.
* org-inlinetask.el: New file.
* org-protocol.el: New file.
* org.el (org-emphasis-regexp-components): Allow braces in
emphasis pre and post match.
* org-footnote.el (org-footnote-normalize): When only dorting, do
not insert inline notes at the end.
* org.el (org-require-autoloaded-modules): Add org-docbook.el.
* org-docbook.el: New file.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-reftex-citation): New command.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-cmp-user-defined): New option.
(org-sorting-choice, org-agenda-sorting-strategy): Add the new
sorting options.
(org-entries-lessp): Apply the new sorting option.
* org.el (org-block-todo-from-children-or-siblings): Fix bug in
blocker code, when an older sibling has children.
* org-mac-message.el (org-mac-message-get-link): Improve getting
links from multiple selected messages.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-remember.el (org-remember-finalize): Do not set buffer file
name to nil.
(org-remember-handler): Mark buffer as unmodified.
(org-remember-handler): Delete backup file and show message about
remaining backup files.
(org-remember-auto-remove-backup-files): New option.
* org.el (org-store-link): Use buffer name as link description in
w3-mode buffers.
(org-ido-switchb): Fix argument bug for completion.
* org-remember.el (org-remember-apply-template): Set local
variable `auto-save-visited-file-name' instead of global one.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-get-todos): Fix bug with match-data.
(org-agenda-get-todos): Mark file tags as inherited.
(org-agenda-list): Always search diary lines for a time.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-feed.el: New file.
* org-exp.el (org-export-as-html): Close local lists depending on
indentation, also when starting a table.
* org-remember.el (org-remember-backup-directory)
(org-remember-backup-name): New internal variable.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-clock-out-if-current): Make buffer detection
work in indirect buffers as well.
* org.el (org-emphasis-regexp-components): Add the exxclamation
mark to the post-emphasis characters.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-read-date-minibiffer-septup-hook): New hook.
(org-read-date): Run the new hook.
* org-mac-message.el (org-mac-flagged-mail): New group.
(org-mac-mail-account): New variable.
(org-mac-create-flagged-mail, org-mac-insert-flagged-mail): New
commands.
* org-remember.el (org-remember-backup-directory): New variable.
(org-remember-apply-template): Write file to backup directory.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-mouse.el (org-mouse-todo-menu): New function.
(org-mouse-todo-keywords): Function removed.
(org-mouse-context-menu): Use `org-mouse-todo-menu'.
* org-table.el (org-table-beginning-of-field)
(org-table-end-of-field): New commands
(org-table-previous-field, org-table-beginning-of-field): Better
error messages.
(orgtbl-setup): Include `M-a' and `M-e'.
* org.el (org-backward-sentence, org-forward-sentence): New
commands.
* org-colview.el (org-colview-initial-truncate-line-value): New
variable.
(org-columns-remove-overlays): Restore the value of `truncate-lines'.
(org-columns): Remember the value of `truncate-lines'.
* org-colview-xemacs.el (org-colview-initial-truncate-line-value):
New variable.
(org-columns-remove-overlays): Restore the value of
`truncate-lines'.
(org-columns): Remember the value of `truncate-lines'.
* org.el (org-columns-skip-arrchived-trees): New option.
* org-agenda.el (org-agenda-export-html-style): Define color for
org-agenda-done face.
(org-search-view, org-agenda-get-todos, org-agenda-get-progress)
(org-agenda-get-deadlines, org-agenda-get-scheduled): Use new face.
* org.el (org-scan-tags): Use the new face.
* org-faces.el (org-agenda-done): New face.
* org.el (org-scan-tags): Test the value org
`org-tags-match-list-sublevels'.
(org-tags-match-list-sublevels): New allowed value: indented.
* org-latex.el (org-export-latex-make-header): Apply macros
in header.
* org-exp.el (org-export-apply-macros-in-string): New function.
* org-latex.el (org-export-latex-list-parameters): Fix bug
with the definition of a checked box.
* org-clock.el (org-clock-find-position): Fix drawer indentations.
* org-latex.el (org-export-latex-low-levels): More options
for how to process lower levels in LaTeX.
(org-export-latex-subcontent): Better treatment for lists as a
means of publishing lower levels.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-set-font-lock-defaults): Use new checkbox face.
* org-faces.el (org-checkbox): New face.
* org-exp.el (org-export-html-preprocess): Only create LaTeX
fragement images if there is an export file.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-stuck-projects): Document that the subtree of
projects that are not stuck will now be searched for stuck
sub-projects.
(org-agenda-skip-entry-when-regexp-matches)
(org-agenda-skip-entry-when-regexp-matches-in-subtree): New functions.
(org-agenda-list-stuck-projects): Use
`org-agenda-skip-entry-when-regexp-matches-in-subtree'.
* org-latex.el (org-export-latex-preprocess): Improve
export of verses.
* org-exp.el (org-export-as-html): Implement centering as a div
rather than a paragraph. Do a better job with line-end in verse
environments.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-open-at-point): Fix tags searches by mouse click.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-preprocess): Implement the
centering markup.
* org-exp.el (org-export-mark-blockquote-verse-center): Renamed
from `org-export-mark-blockquote-and-verse'.
(org-export-as-html): Implement the centering markup.
* org-latex.el (org-export-latex-tables): Fix vertical
lines in tables.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-read-date-history): New variable.
(org-read-date): Use new history variable.
(org-toggle-heading): Fix bug when used before first headline.
(org-store-log-note): Remove drawer if empty while note is
aborted.
(org-remove-empty-drawer-at): New function.
(org-check-after-date): New command.
(org-sparse-tree): New sparse tree command "a".
* org-exp.el (org-export-as-ascii): Improve export of plain lists.
2009-08-06 Bastien Guerry <bzg@altern.org>
* org.el (org-toggle-fixed-width-section): Bug fix: insert a
column and a space, not only a column.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-latex-emphasis-alist): Better
defaults for verbose emphasis.
(org-export-latex-emph-format): New function.
(org-export-latex-fontify): Call `org-export-latex-emph-format'.
* org-agenda.el (org-agenda-menu): Add new commands to menu.
(org-agenda-do-date-later, org-agenda-do-date-earlier)
(org-agenda-date-later-minutes, org-agenda-date-earlier-minutes)
(org-agenda-date-later-hours, org-agenda-date-earlier-hours): New
commands.
* org.el (org-timestamp-change): Move end-time along with start
time.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-target-internal-links)
(org-export-as-html): Protect links specified as #name.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-clone-subtree-with-time-shift): New command.
* org-latex.el (org-export-latex-special-chars)
(org-export-latex-treat-sub-super-char): Fix subscript export.
* org-exp.el (org-create-multibrace-regexp): Do not add
backslashes to the class.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-colview.el (org-columns-map): Better functions for moving up
and down a row, even if `truncate-line' is nil.
* org.el (org-insert-todo-heading): Make sure the keyword is
inserted at the correct position.
* org-publish.el (org-publish-project-alist)
(org-publish-projects, org-publish-org-index): Change default anme
for the index of file names to "sitemap.org".
* org-latex.el (org-export-latex-tables): Use
`org-split-string', for Emacs 21 compatibility.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-log-mode-items): Improve docstring.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-page-description)
(org-export-page-keywords): New variables.
(org-export-plist-vars): Add entries for :keywords and
:description.
(org-infile-export-plist): Parse for new keywords.
(org-get-current-options): Add new keywords
(org-export-as-html): Publish description and keywords.
* org-agenda.el (org-agenda-add-entry-text-descriptive-links): New
option.
(org-agenda-add-entry-text): Honor
`org-agenda-add-entry-text-descriptive-links'.
* org-latex.el (org-export-latex-preprocess): Make all
external preprocess functions use a PARAMETER arg.
* org-exp.el (org-export-preprocess-string)
(org-export-select-backend-specific-text)
(org-export-format-source-code-or-example)
(org-format-org-table-html): Support docbook export.
(org-export-preprocess-string): Make all external preprocess
functions use a PARAMETER arg.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-html-style-include-scripts): New option.
(org-export-plist-vars): Add new option
`org-export-html-style-include-scripts'.
(org-export-as-html): Honor new option
`org-export-html-style-include-scripts'.
(org-export-html-scripts, org-export-html-style-default): Fix
xml issues with the Safari browser.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-publish.el (org-publish-attachment): Only copy file when the
directories differ.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-clock.el (org-clocktable-steps): Use inactive time stamps
for clocktable steps.
* org.el (org-additional-option-like-keywords): Add two more
keywords.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-format-source-code-or-example): Mark
temporary buffer unmodified, so that it will be killed even if
mode like message mode has decided to assign a file name.
* org.el (org-scan-tags): Improve tag inheritance.
(org-scan-tags, org-make-tags-matcher): Make tag comparison
case-sensitive.
(org-scan-tags): Use the internal tags list instead of creating it
from scratch.
(org-trust-scanner-tags, org-scanner-tags): New variables.
(org-scan-tags): Set `org-scanner-tags'.
(org-get-tags-at): Take advantage of `org-trust-scanner-tags'.
(org-map-entries): Document the possible speedup using scanner
tags.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-add-planning-info): Fix bug with looking for keyword
only at column 0.
* org-agenda.el (org-agenda-custom-commands-local-options): Add
option for tags filter preset.
(org-prepare-agenda): Store filter preset as a property on the
filter variable.
(org-finalize-agenda): Call the filter, if there is a preset.
(org-agenda-filter-by-tag): Filter again after clearing the
filter, when there still is a preset.
(org-agenda-filter-make-matcher, org-agenda-set-mode-name):
Include the preset filter.
(org-agenda-redo): Apply the filter again, also the preset filter.
* org-exp.el (org-export-as-html): Use IDs in the correct way.
* org.el (org-uuidgen-p): New funtion.
* org-agenda.el (org-agenda-fontify-priorities): New default value
`cookies'.
(org-agenda-fontify-priorities): Renamed from
org-fontify-priorities.
* org.el (org-set-font-lock-defaults): Call
`org-font-lock-add-priority-faces'.
(org-font-lock-add-priority-faces): New function.
* org-faces.el: (org-set-tag-faces): New option.
(org-priority-faces): New variable.
* org-exp.el (org-export-as-html): Add a "content" div around the
entire content of the body tag.
(org-export-html-get-bibliography): New function.
(org-export-html-validation-link): New variable.
(org-export-as-html): Add validation link to exported page.
* org.el (org-match-sparse-tree): Renamed from
`org-tags-sparse-tree'.
(org-tags-sparse-tree): New alias.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-get-valid-level): Catch the case where the level
change is nil.
* org-clock.el (org-clock-find-position): Better indentation of
new clock drawers.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda-quit): Delete window only when the
frame-setup was not `current-window'.
* org.el (org-tag-persistent-alist): New option.
(org-startup-options): Add keyword `noptag'.
(org-fast-todo-selection): Handle :newline correctly.
(org-set-tags): Handle :newline correctly.
(org-fast-tag-selection): Handle :newline correctly.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-as-ascii): Reverse link buffer before
outputting it.
(org-export-ascii-push-links): Fix bug with pussing links into the
export buffer.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-archive.el (org-archive-subtree): Do not add 1 to level if
pasting at top level.
* org-bbdb.el: Improve documentation.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-list.el (org-insert-item): Only consider insert empty lines
is `org-empty-line-terminates-plain-lists' is not nil.
* org.el (org-blank-before-new-entry): Mention the dependence on
`org-empty-line-terminates-plain-lists' in the docstring.
* org-publish.el (org-publish-get-project-from-filename): New
optional argument UP. Only find the top project if UP is set.
(org-publish-current-project): Find the top encloding project.
* org-agenda.el (org-agenda-before-write-hook)
(org-agenda-add-entry-text-maxlines): New options.
(org-write-agenda): Run the new hook in the temporary buffer.
(org-agenda-add-entry-text): New function.
(org-write-agenda): Implement PDF export, using ps2pdf.
* org.el (org-global-properties-fixed, org-global-properties):
Improve documentation string.
* org-exp.el (org-export-ascii-links-to-notes): New option.
(org-export-as-ascii): Handle links better.
(org-export-ascii-wrap, org-export-ascii-push-links): New
functions.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-agenda.el (org-agenda): Make prefix arg optional.
(org-agenda-search-headline-for-time): New option.
(org-format-agenda-item): Honor
`org-agenda-search-headline-for-time'.
* org-table.el (orgtbl-self-insert-command): Cluster undo for 20
characters.
* org.el (org-self-insert-cluster-for-undo): New option.
(org-self-insert-command): Cluster undo for 20 characters.
(org-self-insert-command-undo-counter): New variable.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-exp.el (org-export-as-html): Fix problem with closing colone
example.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org-latex.el (org-export-as-latex)
(org-export-latex-first-lines): Avoid modification flag when
adding or removing text properties.
(org-export-latex-fontify): Catch error when org-emph-alist has
entries that are not defined for LaTeX export.
* org-export-latex.el: renamed to org-latex.el
* org-latex.el: renamed from org-export-latex.el
* org.el (orgstruct++-mode): New function.
(turn-on-orgstruct++): Call `orgstruct++-mode'.
(org-context-p): Allow detecting item context after the first line
of an item.
(orgstruct-make-binding): Detect if item-body context should be
seen.
(orgstruct-is-++): New variable.
(org-add-planning-info): Catch the case when there is no planning
info yet and the call does not want to add anything, only maybe
tries to remove something.
(org-special-ctrl-a/e): All value to be a cons cell with separate
settings for `C-a. and `C-e'.
(org-beginning-of-line, org-end-of-line): Honor separate values
for `C-a' and `C-e'.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.el (org-reload): New command.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Publishing action): Improve documentation of file
names when publishing to the source directory.
(Clean view): Document `org-indent-mode'.
(Clocking work time): Add documentation for the
new :timetamp option when creating a clock report.
(Paragraphs): Fix many typos.
(Plain lists): Remove duplicate explanation about the
`C-c *' command.
(Literal examples): Update to reflect the new behavior
of the -n -r -k switches when exporting source code examples.
(Structure editing): Add information about `C-c *',
converting a plain list into a list of Org items.
(Remember): Small rephrasing of the paragraph
describing remember.el. Also mentioned that remember.el is part
of Emacs 23, not Emacs 22.
(Clocking work time): Add documentation about
displaying the current clocking time against the effort estimate.
Also add a footnote about using `org-clock-in-prepare-hook' to add
an effort estimate on the fly, just before clocking it.
(Footnotes): Document automatic renumbering and
sorting.
(Agenda commands): Document new bulk commands.
(Plain lists): Document new behavior of
`org-cycle-include-plain-lists'.
Hyphenation only in TeX.
(Clocking work time): Document the key to update effort
estimates.
(Clocking work time): Document the clock time display.
(Structure editing, TODO basics): Document new
variables.
(Column attributes): Document new colciew operators.
(Publishing options): Document :xml-declaration.
(Tracking TODO state changes): Document the
LOG_INTO_DRAWER property.
(Literal examples): Document the new implementation for
editing source code.
(Publishing action): Mention the new publishing
function, to publish an Org source file.
(Publishing links): Mention how to link to an Org source file.
(Macro replacement): Document new macros.
(Handling links): Document type-specific completion
when inserting links.
(Structure editing, Plain lists): Improve documentation
on sorting.
(Internal links): Document custom ids for links.
(Handling links): Document custom ids for links.
(CSS support): Document new class.
(Refiling notes): Document the possibility to create new nodes
during refiling.
(Agenda commands): Document the "?" operator to find
tasks without effort setting.
(Exporting agenda information): Section moved.
(RSS Feeds): New section.
(Built-in table editor): Document M-e and M-a navigate
inside table field.
(Stuck projects): Docment that projects identified as
un-stuck will still be searchd for stuck sub-projects.
(Paragraphs): Document centering.
(Creating timestamps, Agenda commands): Document new
behavior when changing time stamps.
(Structure editing): Document the new command
`org-clone-subtree-with-time-shift'.
(Publishing): Refresh this chapter.
(Export options, Export options, In-buffer settings):
Document the new keywords.
(Matching tags and properties): Collect all
documentation about tags/property matches here.
(Setting tags): Document `org-tag-persistent-alist'.
(Weekly/daily agenda): New section.
(Orgstruct mode): Describe `orgstruct++-mode'.
(Drawers): Mention the LOGBOOK drawer.
(Export options, Sectioning structure): Document the
#+LEATEX_HEADER in-buffer setting.
(Bugs): Section removed.
(Hooks): New section.
(Add-on packages): Moved here from old location.
(Context-sensitive commands): New section.
(Setting tags): Document newline option.
(Global TODO list, Matching tags and properties):
Mention more variables.
(Checkboxes): Update to changed command behavior.
Diffstat (limited to 'lisp')
45 files changed, 16084 insertions, 5240 deletions
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 74150d9de13..5f216ef6d0c 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,1814 @@ +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-create-formula-image): Remove the -E option for + dvipng. + + * org-exp.el (org-default-export-plist): Respect #+BIND. + (org-export-confirm-letbind): New function. + + * org.el (org-paste-subtree): Test the kill ring entry if it is + going to be used. + (org-copy-subtree): Use `org-forward-same-level'. + (org-forward-same-level): Respect the `invisibe-ok' arg for + back-to-heading. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-table-map-tables): Make sure cursor is back at table + beginning after funcall. + + * org-agenda.el (org-agenda-bulk-action): Make sure parents are + handled before children, and do not error if an entry is not + found, probably because it hase been remove when the parent was + archived or refiled. + + * org.el (org-ido-completing-read): Accept straight lists for + completion as well as alists. + + * org-timer.el (org-timer-cancel-timers): Renamed from + `org-timer-cancel-timers'. + + * org.el (org-cycle-internal-local): Fix problem with finding next + invisible line. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-list-send-list): Call + `org-list-goto-true-beginning' instead of + `org-list-find-true-beginning', which does not exist. + + * org-timer.el (org-timer-reset-timers): Use `mapc'. + (org-timer-set-timer): Do not assign to heading. + + * org-id.el (org-id-open): Quote function name. + + * org-macs.el (org-unmodified): Turn off recording undo + information while running inside the macro. + + * org-table.el (org-table-export): Also work in file-less + buffers. + + * org.el (org-startup-indented): New option. + (org-startup-options): Add new options indent and noindent. + (org-unfontify-region): Remove line-prefix and wrap-prefix + properties. + (org-after-demote-entry-hook, org-after-promote-entry-hook): New + hooks. + (org-promote, org-demote): Run the new hooks. + + * org-table.el (org-table-align): Replace leading \n as well. + + * org-exp.el (org-export-push-to-kill-ring): Remove `line-prefix' + and `line-wrap' text properties. + + * org-compat.el (org-kill-new): New function. + + * org-agenda.el (org-format-agenda-item): Remove `line-prefix' and + `line-wrap' text properties. + + * org-indent.el: New file. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-provide-todo-statistics): Tweak docstring. + + * org-id.el (org-id-open): Honor `org-link-frame-setup'. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-as-org): Insert the "-source" string + before the extension. + + * org.el (org-read-date): Make sure the calendar is in the current + frame. + (org-set-emph-re): Remove the ? from the post-match. + (org-emphasis-regexp-components): Add backslash to the + postmatch class. + (org-set-font-lock-defaults): Write \n instead of \xa, and make it + optional so that also lines at the end of the buffers will still + be matched as headlines. + + * org-table.el (org-table-error-on-row-ref-crossing-hline): + Variable made obsolete. + (org-table-relative-ref-may-cross-hline): New option. + (org-table-find-row-type): Honow the new option + `org-table-relative-ref-may-cross-hline'. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-cut-region, org-table-copy-region): Work + on single field if no active region. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-make-header): Only insert title + if one is defined. + + * org.el (org-make-options-regexp): Allow empty values. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-cycle-internal-local): Improved version of finding + next visible line. + (org-cycle-hide-drawers): Only hide drawers if this is really + necessary. + (outline-end-of-subtree): Make `outline-end-of-subtree' use the + org-version of this function in Org-mode. We use advice to + implement this change, so that future changes to this function in + outline.el wil be handled properly. + (org-forward-same-level, org-backward-same-level): New commands. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-remove-empty-overlays-at) + (org-clean-visibility-after-subtree-move): New functons. + (org-move-subtree-down): Simplify cleanup of display. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mac-message.el (org-mac-message-get-links): Improve + docstring. Make argument SELECT-OR-FLAGGED optional, default to + "s". Fix the return value. + (org-mac-message-insert-flagged): Simplify. + + * org.el (org-refile-get-location): Tamper with refile history o + that history contains compete matches instead of the entered + string. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-store-link): Never store a link to an inline task. + + * org-footnote.el (org-footnote-goto-local-insertion-point): Skip + inline tasks when positioning footnotes. + + * org.el (org-refile): Remove the END line when archiving an + inline task that does have an END line. + + * org-archive.el (org-archive-subtree): Remove the END line when + archiving an inline task that does have an END line. + + * org-macs.el (org-with-limited-levels): New macro. + (org-get-limited-outline-regexp): New function. + + * org-exp.el (org-export-format-source-code-or-example): Fix bug + that did not enumerate first line. + (org-export-mark-radio-links): Skip matches in links. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-activate-plain-links): Make single-match. + (org-adapt-indentation): Fix docstring. + + * org-macs.el (org-unmodified): Turn of modification hooks while + running this macro. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org.el (org-adapt-indentation): Slightly improve the docstring. + (org-occur): Sends an error when the user inputs an empty string. + (org-priority): Bugfix: the tag alignement should happen within + save-excursion. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org.el (org-make-link-regexps): Don't exclude parentheses from + `org-plain-link-re' + (org-cycle-internal-local): When locally cycling, switch directly + from CHILDREN to FOLDED if there is no subtree + (org-cycle): Update the docstring to document the new behavior of + `org-cycle-internal-local'. + +2009-08-06 Nicolas Goaziou <n.goaziou@neuf.fr> (tiny change) + + * org-clock.el (org-clock-in): Bugfix: recognize timestamps with + an abbreviated format for days. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org-protocol.el (org-protocol-default-template-key): New + option. + + * org.el (org-refile): Bugfix: save-excursion before reading the + refile target, otherwise cursor moves might confuse `org-refile'. + + * org.el (org-toggle-heading): Bugfix: correctly convert list + items before the first headline. + + * org.el (org-provide-todo-statistics): Allow a list of TODO + keywords to compute statistics against headlines containing a + keyword from this list. + (org-update-parent-todo-statistics): Possibly use the new allowed + value of `org-provide-todo-statistics'. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org-timer.el: Add autoload cookie. + + * org.el (org-occur-link-in-agenda-files): New function. + + * org-timer.el (org-timer-last-timer): New variable. + + * org-agenda.el (org-agenda-mode-map): New key for + org-timer-set-timer called from the agenda. + + * org.el (org-mode-map): New key for org-timer-set-timer. + + * org-timer.el (org-timer-reset-timers) + (org-timer-show-remaining-time, org-timer-set-timer): New + functions. + + * org-clock.el (org-show-notification): Update the docstring. + + * org.el (org-provide-todo-statistics): Allow new value + 'all-headlines for this option, which includes entries with no + TODO keywords in the todo statistics. + (org-update-parent-todo-statistics): Possibly use the new + 'all-headline value from `org-provide-todo-statistics'. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org-clock.el (org-dblock-write:clocktable): Add a new option + :timestamp which allows display of timestamps in clock reports. + + * org.el (org-mode-map): Define new key `C-c C-*': convert a plain + list to a subtree, preserving the structure of the list. + (org-set-emph-re): Make the last element optional in the regexp. + This regexp now matches an emphasized string at the end of a line. + + * org-list.el (org-list-goto-true-beginning) + (org-list-make-subtree, org-list-make-subtrees): New functions. + + * org.el (org-eval-in-calendar): Select the right frame. + (org-save-frame-excursion): Remove this macro. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org-list.el (org-list-beginning-re): Bugfix: don't use * when + trying to find the beginning of a list. + + * org-exp.el (org-get-file-contents): Use a new argument: markup. + When present, tell org-get-file-contents not to protect org-like + lines. + + * org-id.el (org-id-uuid-program): New option to set the name of + the uuidgen program. + (org-id-method): Use `org-id-uuid-program'. + (org-id-new): Use `org-id-uuid-program'. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org-exp.el (org-export-number-lines): Allow whitespace in code + references. Allow the -r switch to remove the references in the + source code even when the lines are not numbered: the labels can + be explicit enough. + + * org.el (org-fontify-whole-heading-line): New option. + (org-set-font-lock-defaults): Use the new option. + + * org-clock.el (org-show-notification-handler): New option. + (org-show-notification): Use the new option. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org.el (org-eval-in-calendar): Fix a bug about calendar + navigation when `calendar-setup' value is 'calendar-only. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org.el (orgstruct++-mode): Fix typo in docstring. + (org-insert-link): Clean up: (or (...)) => (...) + (org-insert-link): Use TAB for stored links completion. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org.el (org-get-refile-targets): Fix bug: don't ignore case when + building the list of targets. + + * org-remember.el (org-remember-delete-empty-lines-at-end): New + option. + (org-remember-handler): Use the new option. + +2009-08-06 James TD Smith <ahktenzero@mohorovi.cc> + + * org.el (org-tags-sort-function): New option for sorting tags. + (org-set-tags): Use the new option to sort tags. + + * org-plot.el (org-plot/gnuplot): Run with an idle timer to avoid + premature deletion of the data when using org-plot in a script. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org-clock.el (org-clock-in-prepare-hook): New hook. + (org-clock-in): Use this new hook. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org.el (org-special-ctrl-a/e): Explicitely bind the value + 'reversed for this option to the "true line boundary first" + behavior. + (org-tags-match-list-sublevels): Document the 'indented value for + this variable. + + * org-latex.el (org-export-latex-first-lines): Fix problem with + publishing the region. + + * org-exp.el (org-export-format-source-code-or-example): Fix + bad line numbering when exporting examples in HTML. + +2009-08-06 James TD Smith <ahktenzero@mohorovi.cc> + + * org-colview.el (org-format-time-period): Formats a time in + fractional days as days, hours, mins, seconds. + (org-columns-display-here): Add special handling for SINCE and + SINCE_IA to format for display. + + * org.el (org-time-since): Add a function to get the time since an + org timestamp. + (org-entry-properties): Add two new special properties: SINCE and + SINCE_IA. These give the time since any active or inactive + timestamp in an entry. + (org-special-properties): Add SINCE, SINCE_IA. + (org-tags-sort-function): Add custom declaration for tags + sorting function. + (org-set-tags): Sort tags if org-tags-sort-function is set + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-goto): Find hidden headlines as well. + + * org.el (org-narrow-to-subtree): Find hidden headlines as well. + + * org-plot.el (org-plot/add-options-to-plist): Add timeind + option. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-remove-all-timestamps): New function. + (org-publish-all): Remove all timestamp files if `org-publish-all' + is called with a prefix argument. + + * org-list.el (org-indent-item): Fix typo. + (org-item-indent-positions): Normalize ordered bullet. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el (org-set-local): Make a local variable, do not make + the variable buffer-local! + + * org-latex.el (org-export-as-latex): Call `org-install-letbind'. + + * org-exp.el (org-infile-export-plist): Read BIND lines. + (org-install-letbind): New function. + (org-export-as-org, org-export-preprocess-string): Call + `org-install-letbind'. + + * org-list.el (org-list-demote-modify-bullet): New option. + (org-first-list-item-p): Save point. + (org-fix-bullet-type): New optional argument FORCE-BULLET. + (org-indent-item): Honor `org-list-demote-modify-bullet'. + (org-item-indent-positions): Return bullet types along with + indentation. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-show-entry): Hide drawers. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-footnote.el (org-footnote-auto-adjust): New option. + (org-footnote-auto-adjust-maybe): New function. + (org-footnote-new, org-footnote-delete): Call + `org-footnote-auto-adjust-maybe'. + + * org.el (org-startup-options): Add new footnote-related + keywords. + + * org-publish.el (org-publish-timestamp-filename): Additional + arguments PUB-DIR and PUB-FUNC, which are included in the hash. + (org-publish-needed-p): Additional arguments PUB-DIR PUB-FUNC + TRUE-PUB-DIR. Pass them through to + `org-publish-timestamp-filename'. + (org-publish-update-timestamp): Additional arguments PUB-DIR and + PUB-FUNC, which are included in the hash. + (org-publish-file): Delay timestamp test until the publishing + function is known. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-bulk-action): Add scheduling and + setting the deadline. + + * org.el (org-read-date-final-answer): New variable. + (org-read-date): Store the final answer string, including the date + from the calendar, for reuse by agenda bulk commands. + + * org-publish.el (org-publish-attachment): Fix publishing of + attachments. + + * org-latex.el (org-export-latex-quotation-marks): Fix export of + quotation makrs in parenthesis. + (org-remove-initial-hash): New function. + (org-export-latex-preprocess): Fix bug with infinite loop if + environment is not properly closed. + + * org-table.el (org-table-get-remote-range): Find #+TBLNAME also + when indented. + + * org.el (org-fontify-meta-lines-and-blocks): Make #+TBLNAME + highlight also when indented. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-footnote.el (org-footnote-renumber-fn:N): New command. + (org-footnote-action): Offer renumbering. + + * org.el (org-cycle): Honor the `integrate' value of + org-cycle-include-plain-lists'. + + * org-list.el (org-cycle-include-plain-lists): New allowed value + `internal'. Improve the docstring. + + * org.el (org-set-autofill-regexps): Improve the paragraph-start + regexp to work better with LaTeX commands. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-inline-image-extensions): Add ps + and eps extensions. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-write-agenda): Make sure org-icalendar is + loaded. + + * org.el (org-map-entries): No longer force + `org-tags-match-list-sublevels' to t during a todo-only tags + search. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-low-levels): Allow user-defined + environment. + (org-export-latex-subcontent): Handle user-defined environment. + + * org-agenda.el (org-agenda-view-mode-dispatch): Add more keys to + the View dispatcher. + + * org.el (org-hide-block-toggle): Use `org-make-overlay' instead of + `make-overlay'. + + * org-latex.el (org-export-as-pdf): Protect match data during call + to shell-quote-argument. + + * org-agenda.el (org-agenda-mode-map): Modify bulk action keys. + (org-agenda-view-mode-dispatch): New function. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-mode): Reset list of marks. + (org-agenda-mode-map): Define new keys for refile and bulk action. + (org-agenda-menu): Add menu itesm for refile and bulk action. + (org-agenda-refile): New function. + (org-agenda-set-tags): Optional arguments TAG and ONOFF. + (org-agenda-marked-entries): New variable. + (org-agenda-bulk-select, org-agenda-remove-bulk-action-overlays) + (org-agenda-remove-all-bulk-action-marks) + (org-agenda-bulk-action): New functions/commands. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-get-file-contents): Protect org-like lines in + included files. + (org-export-format-source-code-or-example): Remove newlines. + + * org-latex.el (org-export-latex-links): Check for no-description + marking. + + * org-exp.el (org-export-preprocess-apply-macros): Switch macro + argument separator back to comma. + (org-export-normalize-links): Mark links without description. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-infile-export-plist): Fix bug in macro + processing. + + * org-agenda.el (org-agenda-clock-out): Update line after clocking + out. + (org-agenda-highlight-todo): Fix bug with highlighting. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-set-font-lock-defaults): Adapt formatting to capture + new alignment strings. + + * org-table.el (orgtbl-self-insert-command): Add yas/expand to + command list. + (org-table-align): Check for forced align type. + + * org.el (org-self-insert-command): Add yas/expand to command + list. + + * org-clock.el (org-clock-in-hook): New hook. + (org-clock-in): Run `org-clock-in-hook. + (org-clock-out-hook): New hook. + (org-clock-out): Run `org-clock-out-hook. + (org-clock-cancel-hook): New hook. + (org-clock-cancel): Run `org-clock-cancel-hook. + (org-clock-goto-hook): New hook. + (org-clock-goto): Run `org-clock-goto-hook. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-store-link): Better default description for link to + Org-mode headline. + + * org-exp.el (org-export-generic): Autoload the generic exporter + function. + (org-export): Implement the `g' key for the generic exporter. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (orgtbl-setup): Add a binding for `S-iso-lefttab', + and for zbacktab'. + + * org-exp.el (org-infile-export-plist): Get macros also from + #+SETUPFILE. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-colview.el (org-columns-capture-view): Protect vertical bars + in column values. + (org-columns-capture-view): Exclude comment and archived trees. + + * org-colview-xemacs.el (org-columns-capture-view): Protect + vertical bars in column values. + (org-columns-capture-view): Exclude comment and archived trees. + + * org.el (org-quote-vert): New function. + + * org-latex.el (org-export-latex-verbatim-wrap): New option. + + * org-exp.el (org-export-format-source-code-or-example): Use + `org-export-latex-verbatim-wrap'. + + * org.el (org-clone-subtree-with-time-shift): Also shift inactive + time stamps. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp-blocks.el: New file. + + * org-remember.el (org-remember-templates): Allow the headline + element to be a function. + (org-remember-apply-template): If the headline is a function, call + it to get the true function. + + * org-clock.el (org-clock-menu): New function. + (org-clock-update-mode-line): Update help string. + (org-clock-modify-effort-estimate): New function. + (org-clock-mark-default-task): New function. + + * org.el (org-hh:mm-string-to-minutes): Also take just a number of + minutes as input. + (org-org-menu): Add new clocking stuff. + (org-clock-is-active): New function. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-open-non-existing-files): Improve docstring. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-icalendar.el (org-icalendar-include-bbdb-anniversaries): New + option. + (org-export-icalendar): Call `org-bbdb-anniv-export-ical'. + + * org-bbdb.el (org-bbdb-anniv-export-ical): New function. + + * org-list.el (org-get-checkbox-statistics-face): Use the new + faces. + + * org-faces.el (org-checkbox-statistics-todo) + (org-checkbox-statistics-done): New faces. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-use-verb): New variable. + (org-export-latex-emph-format): Prefer \texttt over \verb when + org-export-latex-use-verb is set. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-remember.el (org-remember-handler): Abort remember if the + buffer is empty. + + * org-exp.el (org-export-format-source-code-or-example): Run + `org-src-mode-hook'. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-indent-line-function): Fix indentation of +#end lines. + +2009-08-06 Tassilo Horn <tassilo@member.fsf.org> + + * org-gnus.el (org-gnus-store-link): Require message.el in + org-gnus-store-link. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-src.el: New file, split out of org.el + + * org-macs.el (org-replace-match-keep-properties): New function. + + * org-exp.el (org-export-mark-blockquote-verse-center): Better + preprocessing of center and quote and verse blocks. + + * org-list.el (org-list-end): Respect the stored "original" + indentation when determining the end of the list. + + * org-exp.el (org-export-replace-src-segments-and-examples): + Remember indentation correctly. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-update-mode-line): Apply face + org-mode-line-clock. + + * org-faces.el (org-mode-line-clock): New face. + +2009-08-06 Tassilo Horn <tassilo@member.fsf.org> + + * org-gnus.el (org-gnus-store-link): Fix bug where + `org-gnus-store-link' used wrong subject when called in an article + buffer. Patch provided by fengli AT gmail DOT com. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): Remember + the original indentation of source code snippets and examples. + + * org-latex.el (org-export-as-latex): Relocate the table of + contents. + + * org.el (org-ctrl-c-ctrl-c): Update clock lines. + + * org-agenda.el (org-run-agenda-series): Scope global options also + when creating the agenda buffer. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-adapt-indentation): Improve documentation. + (org-insert-property-drawer): Respect org-adapt-indentation when + inserting the drawer. + (org-remove-flyspell-overlays-in): New function. + (org-do-emphasis-faces, org-activate-plain-links) + (org-activate-code, org-fontify-meta-lines-and-blocks) + (org-activate-angle-links, org-activate-footnote-links) + (org-activate-bracket-links, org-activate-dates) + (org-activate-target-links, org-activate-tags): Remove flyspell + overlays. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-edit-src-save): New function. + + * org-clock.el (org-clock-out-switch-to-state): New option. + (org-clock-out): Honor `org-clock-out-switch-to-state'. + + * org-compat.el (org-compatible-face): Improve macro. + + * org.el (org-global-properties-fixed): Add default for + CLOCK_MODELINE_TOTAL. + + * org-clock.el (org-clock-sum): Accept lists and strigs as tstart + andd tend. + (org-clock-sum-current-item): Optional argument TSTART, pass it to + org-clock-sum. + (org-clock-get-sum-start): New function. + + * org.el (org-startup-options): New keywords blockhide and + blockshow. + (org-mode): Add new invisibility spec. + (org-set-startup-visibility): Hide block on startup if so + desired. + (org-hide-block-startup): New option. + (org-block-regexp): New constant. + (org-hide-block-overlays): New variable. + (org-block-map, org-hide-block-toggle-all, org-hide-block-all) + (org-show-block-all, org-hide-block-toggle-maybe) + (org-hide-block-toggle): New functions. + (org-edit-src-exit): Do not quote lines starting with # and no + + behind it. + (org-auto-repeat-maybe): Add LAST_REPEAT properter for a repeating + entry. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-buffer-property-keys): Add Effort property for + completion. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-sum-current-item): Fix positioning bug + when retrieving total clocked time in the subtree. + + * org.el (org-quoting-blocks): New variable. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-table.el (org-table-store-formulas) + (org-table-get-stored-formulas, org-table-fix-formulas) + (org-table-edit-formulas, orgtbl-ctrl-c-ctrl-c) + (orgtbl-gather-send-defs): Allow indented #+TBLFM line. + + * org.el (org-fontify-meta-lines, org-ctrl-c-ctrl-c): Allow + indented #+TBLFM line. + + * org-footnote.el (org-footnote-goto-local-insertion-point): Allow + indented #+TBLFM line. + + * org-colview.el (org-dblock-write:columnview): Allow indented + #+TBLFM line. + + * org-colview-xemacs.el (org-dblock-write:columnview): Allow + indented #+TBLFM line. + + * org-clock.el (org-dblock-write:clocktable): Allow indented + #+TBLFM line. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): Make + editing indented blocks work correctly. + + * org.el (org-edit-src-nindent): New variable. + (org-edit-src-code, org-edit-fixed-width-region) + (org-edit-src-find-region-and-lang, org-edit-src-exit): Make + editing indented blocks work correctly. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-replace-src-segments-and-examples): FInd + indented blocks. + (org-export-format-source-code-or-example): Fix indentation of + blocks. + (org-export-remove-indentation): New function. + (org-export-select-backend-specific-text): Allow backend-specific + code to be indented. + (org-export-mark-blockquote-verse-center): Allow markers to be + indented. + + * org.el (org-fontify-meta-lines): New function. + (org-set-font-lock-defaults): Call the new fontification + function. + + * org-faces.el (org-meta-line): New face + (org-block): New face. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-treat-insert-todo-heading-as-state-change) + (org-treat-S-cursor-todo-selection-as-state-change): New + variables. + (org-insert-todo-heading): Honor + `org-treat-insert-todo-heading-as-state-change'. + (org-shiftright, org-shiftleft): Honor + `org-treat-S-cursor-todo-selection-as-state-change'. + (org-inhibit-logging): New variable. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-remove-subtree-entries-from-agenda): Reduce + range for marker position checking. + + * org-latex.el (org-export-latex-first-lines): Fix bug when + exporting a region. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-push-to-kill-ring): Protect using + x-set-selection, because that does not always work. + + * org-agenda.el (org-agenda-list): Apply the new face + `org-agenda-date-today'. + + * org-faces.el (org-agenda-date-today): New face. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-to-appt): Turn off restriction when + creating appointments. + + * org-latex.el (org-export-latex-low-levels): Fix customization + type. + + * org.el (org-priority, org-shiftup, org-shiftdown): Disable + priority commands. + + * org-agenda.el (org-agenda-priority): Disable priority commands. + + * org.el (org-enable-priority-commands): New option. + + * org-colview-xemacs.el (org-columns-compute) + (org-columns-number-to-string): Fix problems with empty fields. + + * org-colview.el (org-columns-compute) + (org-columns-number-to-string): Fix problems with empty fields. + + * org-exp.el (org-export-push-to-kill-ring): New function. + (org-export-copy-to-kill-ring): New option. + + * org-latex.el (org-export-as-latex): Call + `org-export-push-to-kill-ring'. + + * org-exp.el (org-export-show-temporary-export-buffer): New + option. + + * org-latex.el (org-export-as-latex): Use + `org-export-show-temporary-export-buffer'. + + * org-exp.el (org-export-show-temporary-export-buffer): New + option. + (org-export-push-to-kill-ring): New function. + + * org-colview.el (org-columns-compile-map): New variable. + (org-columns-new, org-columns-compute) + (org-columns-number-to-string, org-columns-uncompile-format) + (org-columns-compile-format): Implement new operators. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-plist-vars): Add :xml-declaration. + + * org-list.el (org-update-checkbox-count): Make property + dependent. + + * org.el (org-hierarchical-todo-statistics): New option. + (org-update-parent-todo-statistics): Modified to handle recursive + statistics. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish): Make this function behave + correctly in interactive use when called with a prefix argument. + + * org.el (org-todo-statistics-hook): New hook. + (org-update-parent-todo-statistics): Use new hook. + (org-log-into-drawer): New function. + (org-add-log-setup): Use the new `org-log-into-drawer' function to + determine if we should be logging into a drawer. + (org-log-into-drawer): Update docstring. + (org-default-properties): Add LOG_INTO_DRAWER as a property. + + * org-list.el (org-checkbox-statistics-hook): New hook. + (org-update-checkbox-count-maybe): Use new hook. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-edit-src-code, org-edit-fixed-width-region): Use a + better bufer-generating mechanism. + (org-edit-src-find-buffer): New function. + + * org-icalendar.el (org-print-icalendar-entries): Don't check for + archive tag, this is already done by `org-agenda-skip'. + data while constructing lost of tags. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-preprocess-apply-macros): Use semicolon + as argument separator in macros. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-after-sorting-entries-or-items-hook): New hook. + (org-sort-entries-or-items): Run the new hook. + (org-after-refile-insert-hook): New hook. + (org-refile): Run `org-after-refile-insert-hook'. + + * org-agenda.el (org-agenda-get-progress): Never take time of day + from headline when displaying progress. + + * org-latex.el (org-export-latex-complex-heading-re): New variable. + (org-export-as-latex): Force the correct regexp in the + preprocessor buffer. + (org-export-latex-set-initial-vars): Set + `org-export-latex-complex-heading-re'. + + * org-agenda.el (org-agenda-start-with-log-mode): New option. + (org-agenda-mode): Use `org-agenda-start-with-log-mode'. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-tables-centered): New option. + (org-export-latex-tables): Use `org-export-latex-tables-centered'. + + * org-exp.el (org-export-as-org): New command. + (org-export-as-org): New command. + + * org-publish.el (org-publish-org-to-org): New function. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-yank): Just call `org-yank-generic'. + (org-yank-generic): New function, containing the formaer + functionality of `org-yank'. + + * org-latex.el (org-export-latex-not-done-keywords) + (org-export-latex-done-keywords): New variables. + (org-export-latex-todo-keyword-markup): New option. + (org-export-latex-set-initial-vars): Remember the TODO keywords. + (org-export-latex-keywords-maybe): Apply the TODO markup. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-infile-export-plist): Add more default macros. + (org-export-preprocess-apply-macros): Process macro arguments. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-icalendar.el (org-icalendar-include-todo): New allowedvalue + `unblocked'. + (org-print-icalendar-entries): Respect the new value of + `org-icalendar-include-todo'. + + * org.el (org-link-try-special-completion) + (org-file-complete-link): New functions. + (org-insert-link): Add special completion support for some link + types. + + * org-bbdb.el (org-bbdb-complete-link): New function. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-update-checkbox-count): Allow recursive + statistics. + (org-hierarchical-checkbox-statistics): New option. + + * org.el (org-cycle): Remove erraneous space character. + + * org-icalendar.el (org-icalendar-timezone): Initialize from + environment. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-autoload): Fix autoloading of ascii export + functions. + (org-modules): Add org-special-blocks. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-icalendar.el (org-start-icalendar-file): Use the new option. + (org-ical-timezone): New option. + + * org-exp.el (org-export-get-coderef-format): Use the description + is present. + + * org.el (org-sort-entries-or-items): Improve docstring, and make + better implementation for time sorting. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-edit-src-persistent-message): New option. + (org-edit-src-code, org-edit-fixed-width-region): Use the new + option. + + * org-clock.el (org-clock-insert-selection-line): Fix prefious + patch. + + * org.el (org-edit-src-code, org-edit-fixed-width-region): Use + separate buffer instead of indirect buffer to edit source code. + (org-edit-src-exit): Make this function work with the new setup. + + * org-clock.el (org-clock-insert-selection-line): Make sure tasks + are properly fontified before shown in the selection menu. + + * org.el (org-fontify-like-in-org-mode): New function. + + * org-latex.el (org-export-latex-links): Use the property list to + retrieve the default image attributes. + + * org-exp.el (org-export-plist-vars): Add a new option. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export, org-export-visible): Support ASCII + export to buffer + (org-export-normalize-links): Do not protect the description if it + is explicitly given. + + * org-list.el (org-reset-checkbox-state-subtree): Moved here from + org-checklist.el. + (org-reset-checkbox-state-subtree): Call + `org-reset-checkbox-state-subtree'. + + * org-remember.el (org-select-remember-template): For the + selection of a valid template. + + * org-latex.el (org-export-region-as-latex): Supply the + force-no-subtree argument. + (org-export-as-latex): Provide better limits when exporting the + first line. When exporting to string, we still want the first + lines. + (org-export-latex-first-lines): New argument END, to force the end + of the region. + (org-export-region-as-latex): Use the property list. + (org-export-as-latex): + + * org-colview-xemacs.el (org-columns-remove-overlays) + (org-columns): Fix call to `local-variable-p'. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-after-blockquotes-hook): New hook. + (org-export-latex-preprocess): Run the new hook. + + * org-exp.el (org-export-preprocess-after-blockquote-hook): New hook. + (org-export-preprocess-string): Run the new hook. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-macs.el (org-check-external-command): New defsubst. + + * org.el (org-mode-map): New key for reload. + (org-format-latex): Better error message when external programs + are not available. + + * org-agenda.el (org-agenda-mode-map): Bind `org-reload'. + + * org.el (org-sort-entries-or-items): Explicit sorting function + for priorities, needed for XEmacs compatibility. + + * org-remember.el (org-remember-apply-template): Improve auto-save + behavior. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-preprocess): Also protect + environments ending in a star. + + * org-list.el (org-at-item-p): Fix regular expression. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-end-of-subtree): Improve speed. + + * org-agenda.el (org-agenda-get-timestamps) + (org-agenda-get-progress, org-agenda-get-deadlines) + (org-agenda-get-scheduled, org-agenda-get-blocks): Optimizations, + in particular, wait as long as possible to collect the tags. + (org-stuck-projects): Improve docstring. + + * org.el (org-store-link): No errors when getting custom id before + first headline. + (org-get-tags-at): Use `org-up-heading-safe' when getting tags. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-prepare-agenda-buffers): Catch a throw to nextfile. + + * org-protocol.el: Remove dependency on url.el. + (org-protocol-unhex-compound, org-protocol-open-source): Remove + dependency on url.el. + + * org-latex.el (org-export-as-pdf): Use + `org-latex-to-pdf-process'. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-latex-to-pdf-process): New option. + + * org-agenda.el (org-agenda-skip-additional-timestamps-same-entry): + New option. + (org-agenda-get-timestamps): Honor + `org-agenda-skip-additional-timestamps-same-entry'. + + * org-clock.el (org-clock-goto-may-find-recent-task): New option. + (org-clock-goto): Find recent task only if + `org-clock-goto-may-find-recent-task' allows it. + + * org-exp.el (org-export-remove-or-extract-drawers): Handle empty + drawers, and drawers that are missing the :END: line. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-goto): Go to recently clocked task if no + clock is running. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-update-parent-todo-statistics): Check for + STATISTICS_FROM property. + + * org-list.el (org-update-checkbox-count): Check for + STATISTICS_FROM property. + + * org.el (org-tab-first-hook) + (org-tab-after-check-for-table-hook) + (org-tab-after-check-for-cycling-hook): New hooks. + (org-cycle-internal-global, org-cycle-internal-local): New + functions, split out from `org-cycle'. + (org-cycle): Call the new hooks. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-preprocess-string): Reset the list of + preferred targets for each run of the preprocessor. + + * org.el (org-refile-target-verify-function): Improve + documentation. + (org-get-refile-targets): Respect point being moved by the + verification function. + + * org-latex.el (org-export-latex-timestamp-keyword-markup): New + option. + (org-export-latex-keywords): Use new option. + + * org.el (org-rear-nonsticky-at): New defsubst. + (org-activate-plain-links, org-activate-angle-links) + (org-activate-footnote-links, org-activate-bracket-links) + (org-activate-dates, org-activate-target-links) + (org-activate-tags): Place the rear-nonsticky properties at the + correct location. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-protocol.el (server-edit): Declare `server-edit'. + (org-protocol-unhex-string, org-protocol-unhex-compound): New + functions. + (org-protocol-check-filename-for-protocol): Call `server-edit'. + + * org.el (org-default-properties): New default properteis for + completion. + + * org-exp.el (org-export-add-subtree-options): Add new properties + for subtree export. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-id.el (org-id-get-with-outline-path-completion): Turn off + org-refile-target-verify-function for the duration of the command. + + * org.el (org-link-to-org-use-id): New possible value + `create-if-interactive-and-no-custom-id'. + (org-store-link): Use custom IDs. + (org-link-search): Find custom ID properties from #link. + (org-default-properties): Add CUSTOM_ID for property completion. + (org-refile-target-verify-function): New option. + (org-goto): Turn off org-refile-target-verify-function + for the duration of the command. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-preferred-target-alist): New variable. + (org-export-define-heading-targets): Find the new CUSTOM_ID + property. + (org-export-target-internal-links): Target the custom ids when + possible. + + * org-latex.el (org-export-latex-preprocess): Better regexp for + matching latex macros with arguments. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-remember.el (org-remember-handler): Allow filing to non-org + files. + +2009-08-06 Magnus Henoch <magnus.henoch@gmail.com> + + * org-table.el (org-table-fix-formulas): Do not change references + to remote tables. + (org-table-get-remote-range): Convert standard coordinates to RC + format. + + * org-latex.el (org-export-latex-keywords): Fix regexp bug. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-compat.el (org-sha1-string): Function removed. + + * org.el (org-refile-allow-creating-parent-nodes): New option. + (org-refile-get-location): New argument NEW-NODES. + (org-refile): Call `org-refile-get-location' with the new + argument. + (org-refile-get-location): Arrange for adding a new child. + (org-refile-new-child): New function. + + * org-clock.el: Fix a number of docstrings. + (org-clock-find-position): New argument + FIND-UNCLOSED to make the function find an unclosed clock in the + entry. + (org-clock-in): Call `org-clock-find-position' with the new + argument if we might be resuming a clock. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-display-custom-times): New variable. + (org-export-latex-timestamp-markup): New option. + (org-export-latex-set-initial-vars): Remember the local value of + `org-display-custom-times'. + (org-export-latex-content): Process time stamps. + (org-export-latex-time-stamps): New function. + + * org-macs.el (org-maybe-intangible): Add intangible property + again to invisible text. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-default-export-plist): Handle undefined + variables. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-sort-entries-or-items): Match TODO keywrds + case-sensitively, when sorting. + (org-priority): Do not match TODO keywords with wrong case. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-todo): Honor the NOBLOCKING property. + + * org-agenda.el (org-agenda-dim-blocked-tasks): Honor the + NOBLOCKING property. + + * org.el (org-scan-tags): Fix bug in tag scanner + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-modules): Mark obsolete packages. + + * org-html.el: New file, split out from org-exp.el. + + * org-icalendar.el: New file, split out from org-exp.el. + + * org-xoxo.el: New file, split out from org-exp.el. + + * org-ascii.el: New file, split out from org-exp.el. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-compat.el (org-find-library-name): New function. + + * org.el (org-pre-cycle-hook): New hook. + (org-cycle): Call the new hook in appropriate places. + (org-reload): Only reload files that have been loaded before. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-set-font-lock-defaults): Enforxe space or line end + after todo keyword. + (org-todo): When changing TODO state, do matching + case-sensitively. + (org-map-continue-from): New variable. + (org-scan-tags): Respect values in `org-map-continue-from'. + (org-reload): Make XEmacs compatible. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-protocol.el (org-protocol-flatten-greedy): New function. + (org-protocol-flatten): New function. + + * org.el (org-open-link-from-string): Pass reference buffer to + `org-open-at-point'. + (org-open-at-point): New optional argument `reference-buffer'. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-scan-tags): Make tag scan find headline in first + line, 2nd attempt. + (org-get-refile-targets): Add the naked file name. + (org-refile): Store as top-level entry when only file name was + given. + + * org-agenda.el (org-agenda-get-progress): Fix regexp bug. + + * org.el (org-block-todo-from-children-or-siblings-or-parent): + Renamed from org-block-todo-from-children-or-siblings, and + enhanced to look for the parent's status as well. + + * org-agenda.el (org-agenda-log-mode-add-notes): New option. + (org-agenda-get-progress): Add first notes line to log entry if so + desired. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-cleanup-fancy-diary-hook): New hook. + (org-agenda-cleanup-fancy-diary): Call the new hook. + + * org-remember.el (org-remember-apply-template): Take the default + for the annotation from the :annotation property. + + * org-mac-message.el (org-mac-message-get-link): Remove the + quotes. + (org-mac-message-get-link): Return the result. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-refile-get-location): Add file name only if not + already included in outline path. + + * org-faces.el (org-n-level-faces): Fix customization type from + number to integer. + + * org-exp.el (org-export-headline-levels): Fix customization type + from number to integer. + + * org-agenda.el (org-agenda-confirm-kill) + (org-agenda-custom-commands-local-options) + (org-timeline-show-empty-dates, org-agenda-ndays) + (org-agenda-start-on-weekday, org-scheduled-past-days): Fix + customization type from number to integer. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-protocol.el: Declare some functions. + + * org-agenda.el (org-agenda-compare-effort): Honor + `org-sort-agenda-noeffort-is-high'. + (org-agenda-filter-by-tag, org-agenda-filter-make-matcher) + (org-agenda-compare-effort): Implement the "?" operator for + finding entries without effort setting. + + * org.el (org-extract-attributes-from-string): New function. + + * org-exp.el (org-export-splice-attributes): New function. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mouse.el: XEmacs compatibility fixes + + * org.el (org-modules): Add org-inlinetasks.el + (org-cycle): Implement limiting level on cycling. + (org-move-subtree-down): Fix bug with swapping subtrees at end of + buffer. + + * org-inlinetask.el: New file. + + * org-protocol.el: New file. + + * org.el (org-emphasis-regexp-components): Allow braces in + emphasis pre and post match. + + * org-footnote.el (org-footnote-normalize): When only dorting, do + not insert inline notes at the end. + + * org.el (org-require-autoloaded-modules): Add org-docbook.el. + + * org-docbook.el: New file. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-reftex-citation): New command. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-cmp-user-defined): New option. + (org-sorting-choice, org-agenda-sorting-strategy): Add the new + sorting options. + (org-entries-lessp): Apply the new sorting option. + + * org.el (org-block-todo-from-children-or-siblings): Fix bug in + blocker code, when an older sibling has children. + + * org-mac-message.el (org-mac-message-get-link): Improve getting + links from multiple selected messages. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-remember.el (org-remember-finalize): Do not set buffer file + name to nil. + (org-remember-handler): Mark buffer as unmodified. + (org-remember-handler): Delete backup file and show message about + remaining backup files. + (org-remember-auto-remove-backup-files): New option. + + * org.el (org-store-link): Use buffer name as link description in + w3-mode buffers. + (org-ido-switchb): Fix argument bug for completion. + + * org-remember.el (org-remember-apply-template): Set local + variable `auto-save-visited-file-name' instead of global one. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-get-todos): Fix bug with match-data. + (org-agenda-get-todos): Mark file tags as inherited. + (org-agenda-list): Always search diary lines for a time. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-feed.el: New file. + + * org-exp.el (org-export-as-html): Close local lists depending on + indentation, also when starting a table. + + * org-remember.el (org-remember-backup-directory) + (org-remember-backup-name): New internal variable. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clock-out-if-current): Make buffer detection + work in indirect buffers as well. + + * org.el (org-emphasis-regexp-components): Add the exxclamation + mark to the post-emphasis characters. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-read-date-minibiffer-septup-hook): New hook. + (org-read-date): Run the new hook. + + * org-mac-message.el (org-mac-flagged-mail): New group. + (org-mac-mail-account): New variable. + (org-mac-create-flagged-mail, org-mac-insert-flagged-mail): New + commands. + + * org-remember.el (org-remember-backup-directory): New variable. + (org-remember-apply-template): Write file to backup directory. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-mouse.el (org-mouse-todo-menu): New function. + (org-mouse-todo-keywords): Function removed. + (org-mouse-context-menu): Use `org-mouse-todo-menu'. + + * org-table.el (org-table-beginning-of-field) + (org-table-end-of-field): New commands + (org-table-previous-field, org-table-beginning-of-field): Better + error messages. + (orgtbl-setup): Include `M-a' and `M-e'. + + * org.el (org-backward-sentence, org-forward-sentence): New + commands. + + * org-colview.el (org-colview-initial-truncate-line-value): New + variable. + (org-columns-remove-overlays): Restore the value of `truncate-lines'. + (org-columns): Remember the value of `truncate-lines'. + + * org-colview-xemacs.el (org-colview-initial-truncate-line-value): + New variable. + (org-columns-remove-overlays): Restore the value of + `truncate-lines'. + (org-columns): Remember the value of `truncate-lines'. + + * org.el (org-columns-skip-arrchived-trees): New option. + + * org-agenda.el (org-agenda-export-html-style): Define color for + org-agenda-done face. + (org-search-view, org-agenda-get-todos, org-agenda-get-progress) + (org-agenda-get-deadlines, org-agenda-get-scheduled): Use new face. + + * org.el (org-scan-tags): Use the new face. + + * org-faces.el (org-agenda-done): New face. + + * org.el (org-scan-tags): Test the value org + `org-tags-match-list-sublevels'. + (org-tags-match-list-sublevels): New allowed value: indented. + + * org-latex.el (org-export-latex-make-header): Apply macros + in header. + + * org-exp.el (org-export-apply-macros-in-string): New function. + + * org-latex.el (org-export-latex-list-parameters): Fix bug + with the definition of a checked box. + + * org-clock.el (org-clock-find-position): Fix drawer indentations. + + * org-latex.el (org-export-latex-low-levels): More options + for how to process lower levels in LaTeX. + (org-export-latex-subcontent): Better treatment for lists as a + means of publishing lower levels. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-set-font-lock-defaults): Use new checkbox face. + + * org-faces.el (org-checkbox): New face. + + * org-exp.el (org-export-html-preprocess): Only create LaTeX + fragement images if there is an export file. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-stuck-projects): Document that the subtree of + projects that are not stuck will now be searched for stuck + sub-projects. + (org-agenda-skip-entry-when-regexp-matches) + (org-agenda-skip-entry-when-regexp-matches-in-subtree): New functions. + (org-agenda-list-stuck-projects): Use + `org-agenda-skip-entry-when-regexp-matches-in-subtree'. + + * org-latex.el (org-export-latex-preprocess): Improve + export of verses. + + * org-exp.el (org-export-as-html): Implement centering as a div + rather than a paragraph. Do a better job with line-end in verse + environments. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-open-at-point): Fix tags searches by mouse click. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-preprocess): Implement the + centering markup. + + * org-exp.el (org-export-mark-blockquote-verse-center): Renamed + from `org-export-mark-blockquote-and-verse'. + (org-export-as-html): Implement the centering markup. + + * org-latex.el (org-export-latex-tables): Fix vertical + lines in tables. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-read-date-history): New variable. + (org-read-date): Use new history variable. + (org-toggle-heading): Fix bug when used before first headline. + (org-store-log-note): Remove drawer if empty while note is + aborted. + (org-remove-empty-drawer-at): New function. + (org-check-after-date): New command. + (org-sparse-tree): New sparse tree command "a". + + * org-exp.el (org-export-as-ascii): Improve export of plain lists. + +2009-08-06 Bastien Guerry <bzg@altern.org> + + * org.el (org-toggle-fixed-width-section): Bug fix: insert a + column and a space, not only a column. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-latex-emphasis-alist): Better + defaults for verbose emphasis. + (org-export-latex-emph-format): New function. + (org-export-latex-fontify): Call `org-export-latex-emph-format'. + + * org-agenda.el (org-agenda-menu): Add new commands to menu. + (org-agenda-do-date-later, org-agenda-do-date-earlier) + (org-agenda-date-later-minutes, org-agenda-date-earlier-minutes) + (org-agenda-date-later-hours, org-agenda-date-earlier-hours): New + commands. + + * org.el (org-timestamp-change): Move end-time along with start + time. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-target-internal-links) + (org-export-as-html): Protect links specified as #name. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-clone-subtree-with-time-shift): New command. + + * org-latex.el (org-export-latex-special-chars) + (org-export-latex-treat-sub-super-char): Fix subscript export. + + * org-exp.el (org-create-multibrace-regexp): Do not add + backslashes to the class. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-colview.el (org-columns-map): Better functions for moving up + and down a row, even if `truncate-line' is nil. + + * org.el (org-insert-todo-heading): Make sure the keyword is + inserted at the correct position. + + * org-publish.el (org-publish-project-alist) + (org-publish-projects, org-publish-org-index): Change default anme + for the index of file names to "sitemap.org". + + * org-latex.el (org-export-latex-tables): Use + `org-split-string', for Emacs 21 compatibility. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-log-mode-items): Improve docstring. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-page-description) + (org-export-page-keywords): New variables. + (org-export-plist-vars): Add entries for :keywords and + :description. + (org-infile-export-plist): Parse for new keywords. + (org-get-current-options): Add new keywords + (org-export-as-html): Publish description and keywords. + + * org-agenda.el (org-agenda-add-entry-text-descriptive-links): New + option. + (org-agenda-add-entry-text): Honor + `org-agenda-add-entry-text-descriptive-links'. + + * org-latex.el (org-export-latex-preprocess): Make all + external preprocess functions use a PARAMETER arg. + + * org-exp.el (org-export-preprocess-string) + (org-export-select-backend-specific-text) + (org-export-format-source-code-or-example) + (org-format-org-table-html): Support docbook export. + (org-export-preprocess-string): Make all external preprocess + functions use a PARAMETER arg. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-html-style-include-scripts): New option. + (org-export-plist-vars): Add new option + `org-export-html-style-include-scripts'. + (org-export-as-html): Honor new option + `org-export-html-style-include-scripts'. + (org-export-html-scripts, org-export-html-style-default): Fix + xml issues with the Safari browser. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-publish.el (org-publish-attachment): Only copy file when the + directories differ. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-clock.el (org-clocktable-steps): Use inactive time stamps + for clocktable steps. + + * org.el (org-additional-option-like-keywords): Add two more + keywords. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-format-source-code-or-example): Mark + temporary buffer unmodified, so that it will be killed even if + mode like message mode has decided to assign a file name. + + * org.el (org-scan-tags): Improve tag inheritance. + (org-scan-tags, org-make-tags-matcher): Make tag comparison + case-sensitive. + (org-scan-tags): Use the internal tags list instead of creating it + from scratch. + (org-trust-scanner-tags, org-scanner-tags): New variables. + (org-scan-tags): Set `org-scanner-tags'. + (org-get-tags-at): Take advantage of `org-trust-scanner-tags'. + (org-map-entries): Document the possible speedup using scanner + tags. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-add-planning-info): Fix bug with looking for keyword + only at column 0. + + * org-agenda.el (org-agenda-custom-commands-local-options): Add + option for tags filter preset. + (org-prepare-agenda): Store filter preset as a property on the + filter variable. + (org-finalize-agenda): Call the filter, if there is a preset. + (org-agenda-filter-by-tag): Filter again after clearing the + filter, when there still is a preset. + (org-agenda-filter-make-matcher, org-agenda-set-mode-name): + Include the preset filter. + (org-agenda-redo): Apply the filter again, also the preset filter. + + * org-exp.el (org-export-as-html): Use IDs in the correct way. + + * org.el (org-uuidgen-p): New funtion. + + * org-agenda.el (org-agenda-fontify-priorities): New default value + `cookies'. + (org-agenda-fontify-priorities): Renamed from + org-fontify-priorities. + + * org.el (org-set-font-lock-defaults): Call + `org-font-lock-add-priority-faces'. + (org-font-lock-add-priority-faces): New function. + + * org-faces.el: (org-set-tag-faces): New option. + (org-priority-faces): New variable. + + * org-exp.el (org-export-as-html): Add a "content" div around the + entire content of the body tag. + (org-export-html-get-bibliography): New function. + (org-export-html-validation-link): New variable. + (org-export-as-html): Add validation link to exported page. + + * org.el (org-match-sparse-tree): Renamed from + `org-tags-sparse-tree'. + (org-tags-sparse-tree): New alias. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-get-valid-level): Catch the case where the level + change is nil. + + * org-clock.el (org-clock-find-position): Better indentation of + new clock drawers. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda-quit): Delete window only when the + frame-setup was not `current-window'. + + * org.el (org-tag-persistent-alist): New option. + (org-startup-options): Add keyword `noptag'. + (org-fast-todo-selection): Handle :newline correctly. + (org-set-tags): Handle :newline correctly. + (org-fast-tag-selection): Handle :newline correctly. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-as-ascii): Reverse link buffer before + outputting it. + (org-export-ascii-push-links): Fix bug with pussing links into the + export buffer. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-archive.el (org-archive-subtree): Do not add 1 to level if + pasting at top level. + + * org-bbdb.el: Improve documentation. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-list.el (org-insert-item): Only consider insert empty lines + is `org-empty-line-terminates-plain-lists' is not nil. + + * org.el (org-blank-before-new-entry): Mention the dependence on + `org-empty-line-terminates-plain-lists' in the docstring. + + * org-publish.el (org-publish-get-project-from-filename): New + optional argument UP. Only find the top project if UP is set. + (org-publish-current-project): Find the top encloding project. + + * org-agenda.el (org-agenda-before-write-hook) + (org-agenda-add-entry-text-maxlines): New options. + (org-write-agenda): Run the new hook in the temporary buffer. + (org-agenda-add-entry-text): New function. + (org-write-agenda): Implement PDF export, using ps2pdf. + + * org.el (org-global-properties-fixed, org-global-properties): + Improve documentation string. + + * org-exp.el (org-export-ascii-links-to-notes): New option. + (org-export-as-ascii): Handle links better. + (org-export-ascii-wrap, org-export-ascii-push-links): New + functions. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-agenda.el (org-agenda): Make prefix arg optional. + (org-agenda-search-headline-for-time): New option. + (org-format-agenda-item): Honor + `org-agenda-search-headline-for-time'. + + * org-table.el (orgtbl-self-insert-command): Cluster undo for 20 + characters. + + * org.el (org-self-insert-cluster-for-undo): New option. + (org-self-insert-command): Cluster undo for 20 characters. + (org-self-insert-command-undo-counter): New variable. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-exp.el (org-export-as-html): Fix problem with closing colone + example. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org-latex.el (org-export-as-latex) + (org-export-latex-first-lines): Avoid modification flag when + adding or removing text properties. + (org-export-latex-fontify): Catch error when org-emph-alist has + entries that are not defined for LaTeX export. + + * org-export-latex.el: renamed to org-latex.el + + * org-latex.el: renamed from org-export-latex.el + + * org.el (orgstruct++-mode): New function. + (turn-on-orgstruct++): Call `orgstruct++-mode'. + (org-context-p): Allow detecting item context after the first line + of an item. + (orgstruct-make-binding): Detect if item-body context should be + seen. + (orgstruct-is-++): New variable. + (org-add-planning-info): Catch the case when there is no planning + info yet and the call does not want to add anything, only maybe + tries to remove something. + (org-special-ctrl-a/e): All value to be a cons cell with separate + settings for `C-a. and `C-e'. + (org-beginning-of-line, org-end-of-line): Honor separate values + for `C-a' and `C-e'. + +2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> + + * org.el (org-reload): New command. + 2009-06-05 Tassilo Horn <tassilo@member.fsf.org> * org-gnus.el (org-gnus-store-link): Fix bug where diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 6180264d073..29f708b8af2 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -73,7 +73,7 @@ only needed when the text to be killed contains more than N non-white lines." :type '(choice (const :tag "Never" nil) (const :tag "Always" t) - (number :tag "When more than N lines"))) + (integer :tag "When more than N lines"))) (defcustom org-agenda-compact-blocks nil "Non-nil means, make the block agenda more compact. @@ -102,13 +102,44 @@ If it is a character, it will be repeated to fill the window width." (defcustom org-agenda-exporter-settings nil "Alist of variable/value pairs that should be active during agenda export. -This is a good place to set options for ps-print and for htmlize." +This is a good place to set options for ps-print and for htmlize. +Note that the way this is implemented, the values will be evaluated +before assigned to the variables. So make sure to quote values you do +*not* want evaluated, for example + + (setq org-agenda-exporter-settings + '((ps-print-color-p 'black-white)))" :group 'org-agenda-export :type '(repeat (list (variable) (sexp :tag "Value")))) +(defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text) + "Hook run in temporary buffer before writing it to an export file. +A useful function is `org-agenda-add-entry-text'." + :group 'org-agenda-export + :type 'hook + :options '(org-agenda-add-entry-text)) + +(defcustom org-agenda-add-entry-text-maxlines 0 + "Maximum number of entry text lines to be added to agenda. +This is only relevant when `org-agenda-add-entry-text' is part of +`org-agenda-before-write-hook', which it is by default. +When this is 0, nothing will happen. When it is greater than 0, it +specifies the maximum number of lines that will be added for each entry +that is listed in the agenda view." + :group 'org-agenda + :type 'integer) + +(defcustom org-agenda-add-entry-text-descriptive-links t + "Non-nil means, export org-links as descriptive links in agenda added text. +This variable applies to the text added to the agenda when +`org-agenda-add-entry-text-maxlines' is larger than 0. +When this variable nil, the URL will (also) be shown." + :group 'org-agenda + :type 'boolean) + (defcustom org-agenda-export-html-style "" "The style specification for exported HTML Agenda files. If this variable contains a string, it will replace the default <style> @@ -129,6 +160,9 @@ the fonts used by the agenda, here is an example: color: #cc6666; font-weight: bold; } + .org-agenda-done { + color: #339933; + } .org-done { color: #339933; } @@ -160,21 +194,21 @@ you can \"misuse\" it to also add other text to the header. However, (const tag-down) (const tag-up) (const priority-up) (const priority-down) (const todo-state-up) (const todo-state-down) - (const effort-up) (const effort-down)) + (const effort-up) (const effort-down) + (const user-defined-up) (const user-defined-down)) "Sorting choices.") (defconst org-agenda-custom-commands-local-options `(repeat :tag "Local settings for this command. Remember to quote values" (choice :tag "Setting" - (list :tag "Any variable" - (variable :tag "Variable") - (sexp :tag "Value")) + (list :tag "Heading for this block" + (const org-agenda-overriding-header) + (string :tag "Headline")) (list :tag "Files to be searched" (const org-agenda-files) (list (const :format "" quote) - (repeat - (file)))) + (repeat (file)))) (list :tag "Sorting strategy" (const org-agenda-sorting-strategy) (list @@ -194,13 +228,19 @@ you can \"misuse\" it to also add other text to the header. However, (const org-agenda-start-on-weekday) (choice :value 1 (const :tag "Today" nil) - (number :tag "Weekday No."))) + (integer :tag "Weekday No."))) (list :tag "Include data from diary" (const org-agenda-include-diary) (boolean)) (list :tag "Deadline Warning days" (const org-deadline-warning-days) (integer :value 1)) + (list :tag "Tags filter preset" + (const org-agenda-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+tag or -tag")))) (list :tag "Standard skipping condition" :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) (const org-agenda-skip-function) @@ -219,11 +259,16 @@ you can \"misuse\" it to also add other text to the header. However, (const :tag "scheduled" 'scheduled) (const :tag "not scheduled" 'notscheduled) (const :tag "deadline" 'deadline) - (const :tag "no deadline" 'notdeadline)))))) + (const :tag "no deadline" 'notdeadline) + (const :tag "timestamp" 'timestamp) + (const :tag "no timestamp" 'nottimestamp)))))) (list :tag "Non-standard skipping condition" :value (org-agenda-skip-function) (const org-agenda-skip-function) - (sexp :tag "Function or form (quoted!)")))) + (sexp :tag "Function or form (quoted!)")) + (list :tag "Any variable" + (variable :tag "Variable") + (sexp :tag "Value (sexp)")))) "Selection of examples for agenda command settings. This will be spliced into the custom type of `org-agenda-custom-commands'.") @@ -308,8 +353,8 @@ should provide a description for the prefix, like (const :tag "TODO list" alltodo) (const :tag "Search words" search) (const :tag "Stuck projects" stuck) - (const :tag "Tags search (all agenda files)" tags) - (const :tag "Tags search of TODO entries (all agenda files)" tags-todo) + (const :tag "Tags/Property match (all agenda files)" tags) + (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo) (const :tag "TODO keyword search (all agenda files)" todo) (const :tag "Tags sparse tree (current buffer)" tags-tree) (const :tag "TODO keyword tree (current buffer)" todo-tree) @@ -375,7 +420,8 @@ you can then use it to define a custom command." '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") "How to identify stuck projects. This is a list of four items: -1. A tags/todo matcher string that is used to identify a project. +1. A tags/todo/property matcher string that is used to identify a project. + See the manual for a description of tag and property searches. The entire tree below a headline matched by this is considered one project. 2. A list of TODO keywords identifying non-stuck projects. If the project subtree contains any headline with one of these todo @@ -384,9 +430,18 @@ This is a list of four items: 3. A list of tags identifying non-stuck projects. If the project subtree contains any headline with one of these tags, the project is considered to be not stuck. If you specify \"*\" as - a tag, any tag will mark the project unstuck. + a tag, any tag will mark the project unstuck. Note that this is about + the explicit presence of a tag somewhere in the subtree, inherited + tags to not count here. If inherited tags make a project not stuck, + use \"-TAG\" in the tags part of the matcher under (1.) above. 4. An arbitrary regular expression matching non-stuck projects. +If the project turns out to be not stuck, search continues also in the +subtree to see if any of the subtasks have project status. + +See also the variable `org-tags-match-list-sublevels' which applies +to projects matched by this search as well. + After defining this variable, you may use \\[org-agenda-list-stuck-projects] or `C-c a #' to produce the list." :group 'org-agenda-custom-commands @@ -394,7 +449,7 @@ or `C-c a #' to produce the list." (string :tag "Tags/TODO match to identify a project") (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) - (regexp :tag "Projects are *not* stuck if this regexp matches\ninside the subtree"))) + (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree"))) (defcustom org-agenda-filter-effort-default-operator "<" "The default operator for effort estimate filtering. @@ -449,7 +504,8 @@ You can use this if you prefer to mark mere appointments with a TODO keyword, but don't want them to show up in the TODO list. When this is set, it also covers deadlines and scheduled items, the settings of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' -will be ignored." +will be ignored. +See also the variable `org-agenda-tags-todo-honor-ignore-options'." :group 'org-agenda-skip :group 'org-agenda-todo-list :type 'boolean) @@ -458,7 +514,8 @@ will be ignored." "Non-nil means, don't show scheduled entries in the global todo list. The idea behind this is that by scheduling it, you have already taken care of this item. -See also `org-agenda-todo-ignore-with-date'." +See also `org-agenda-todo-ignore-with-date'. +See also the variable `org-agenda-tags-todo-honor-ignore-options'." :group 'org-agenda-skip :group 'org-agenda-todo-list :type 'boolean) @@ -467,7 +524,8 @@ See also `org-agenda-todo-ignore-with-date'." "Non-nil means, don't show near deadline entries in the global todo list. Near means closer than `org-deadline-warning-days' days. The idea behind this is that such items will appear in the agenda anyway. -See also `org-agenda-todo-ignore-with-date'." +See also `org-agenda-todo-ignore-with-date'. +See also the variable `org-agenda-tags-todo-honor-ignore-options'." :group 'org-agenda-skip :group 'org-agenda-todo-list :type 'boolean) @@ -476,7 +534,7 @@ See also `org-agenda-todo-ignore-with-date'." "Non-nil means, honor todo-list ...ignore options also in tags-todo search. The variables `org-agenda-todo-ignore-with-date', - `org-agenda-todo-ignore-scheduled' + `org-agenda-todo-ignore-scheduled' `org-agenda-todo-ignore-deadlines' make the global TODO list skip entries that have time stamps of certain kinds. If this option is set, the same options will also apply for the @@ -507,6 +565,13 @@ deadlines are always turned off when the item is DONE." :group 'org-agenda-daily/weekly :type 'boolean) +(defcustom org-agenda-skip-additional-timestamps-same-entry t + "When nil, multiple same-day timestamps in entry make multiple agenda lines. +When non-nil, after the search for timestamps has matched once in an +entry, the rest of the entry will not be searched." + :group 'org-agenda-skip + :type 'boolean) + (defcustom org-agenda-skip-timestamp-if-done nil "Non-nil means don't select item by timestamp or -range if it is DONE." :group 'org-agenda-skip @@ -515,12 +580,19 @@ deadlines are always turned off when the item is DONE." (defcustom org-agenda-dim-blocked-tasks t "Non-nil means, dim blocked tasks in the agenda display. -This causes some overhead during agenda construction, but if you have turned -on `org-enforce-todo-dependencies' or any other blocking mechanism, this -will create useful feedback in the agenda. -Instead ot t, this variable can also have the value `invisible'. Then -blocked tasks will be invisible and only become visible when they -become unblocked." +This causes some overhead during agenda construction, but if you +have turned on `org-enforce-todo-dependencies', +`org-enforce-todo-checkbox-dependencies', or any other blocking +mechanism, this will create useful feedback in the agenda. + +Instead ot t, this variable can also have the value `invisible'. +Then blocked tasks will be invisible and only become visible when +they become unblocked. An exemption to this behavior is when a task is +blocked because of unchecked checkboxes below it. Since checkboxes do +not show up in the agenda views, making this task invisible you remove any +trace from agenda views that there is something to do. Therefore, a task +that is blocked because of checkboxes will never be made invisible, it +will only be dimmed." :group 'org-agenda-daily/weekly :group 'org-agenda-todo-list :type '(choice @@ -538,7 +610,7 @@ N days, just insert a special line indicating the size of the gap." :type '(choice (const :tag "None" nil) (const :tag "All" t) - (number :tag "at most"))) + (integer :tag "at most"))) (defgroup org-agenda-startup nil "Options concerning initial settings in the Agenda in Org Mode." @@ -606,17 +678,19 @@ option will be ignored.." (defcustom org-agenda-ndays 7 "Number of days to include in overview display. -Should be 1 or 7." +Should be 1 or 7. +Custom commands can set this variable in the options section." :group 'org-agenda-daily/weekly - :type 'number) + :type 'integer) (defcustom org-agenda-start-on-weekday 1 "Non-nil means, start the overview always on the specified weekday. 0 denotes Sunday, 1 denotes Monday etc. -When nil, always start on the current day." +When nil, always start on the current day. +Custom commands can set this variable in the options section." :group 'org-agenda-daily/weekly :type '(choice (const :tag "Today" nil) - (number :tag "Weekday No."))) + (integer :tag "Weekday No."))) (defcustom org-agenda-show-all-dates t "Non-nil means, `org-agenda' shows every day in the selected range. @@ -673,7 +747,8 @@ and timeline buffers." (const :tag "Sunday" 0))) (defcustom org-agenda-include-diary nil - "If non-nil, include in the agenda entries from the Emacs Calendar's diary." + "If non-nil, include in the agenda entries from the Emacs Calendar's diary. +Custom commands can set this variable in the options section." :group 'org-agenda-daily/weekly :type 'boolean) @@ -698,7 +773,7 @@ When an item is scheduled on a date, it shows up in the agenda on this day and will be listed until it is marked done for the number of days given here." :group 'org-agenda-daily/weekly - :type 'number) + :type 'integer) (defcustom org-agenda-log-mode-items '(closed clock) "List of items that should be shown in agenda log mode. @@ -706,10 +781,26 @@ This list may contain the following symbols: closed Show entries that have been closed on that day. clock Show entries that have received clocked time on that day. - state Show all logged state changes." + state Show all logged state changes. +Note that instead of changing this variable, you can also press `C-u l' in +the agenda to display all available LOG items temporarily." :group 'org-agenda-daily/weekly :type '(set :greedy t (const closed) (const clock) (const state))) +(defcustom org-agenda-log-mode-add-notes t + "Non-nil means, add first line of notes to log entries in agenda views. +If a log item like a state change or a clock entry is associated with +notes, the first line of these notes will be added to the entry in the +agenda display." + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-start-with-log-mode nil + "The initial value of log-mode in a newly created agenda window." + :group 'org-agenda-startup + :group 'org-agenda-daily/weekly + :type 'boolean) + (defcustom org-agenda-start-with-clockreport-mode nil "The initial value of clockreport-mode in a newly created agenda window." :group 'org-agenda-startup @@ -733,6 +824,17 @@ current display in the agenda." :tag "Org Agenda Time Grid" :group 'org-agenda) +(defcustom org-agenda-search-headline-for-time t + "Non-nil means, search headline for a time-of-day. +If the headline contains a time-of-day in one format or another, it will +be used to sort the entry into the time sequence of items for a day. +Some people have time stamps in the headline that refer to the creation +time or so, and then this produces an unwanted side effect. If this is +the case for your, use this variable to turn off searching the headline +for a time." + :group 'org-agenda-time-grid + :type 'boolean) + (defcustom org-agenda-use-time-grid t "Non-nil means, show a time grid in the agenda schedule. A time grid is a set of lines for specific times (like every two hours between @@ -790,20 +892,22 @@ This is a list of symbols which will be used in sequence to determine if an entry should be listed before another entry. The following symbols are recognized: -time-up Put entries with time-of-day indications first, early first -time-down Put entries with time-of-day indications first, late first -category-keep Keep the default order of categories, corresponding to the - sequence in `org-agenda-files'. -category-up Sort alphabetically by category, A-Z. -category-down Sort alphabetically by category, Z-A. -tag-up Sort alphabetically by last tag, A-Z. -tag-down Sort alphabetically by last tag, Z-A. -priority-up Sort numerically by priority, high priority last. -priority-down Sort numerically by priority, high priority first. -todo-state-up Sort by todo state, tasks that are done last. -todo-state-down Sort by todo state, tasks that are done first. -effort-up Sort numerically by estimated effort, high effort last. -effort-down Sort numerically by estimated effort, high effort first. +time-up Put entries with time-of-day indications first, early first +time-down Put entries with time-of-day indications first, late first +category-keep Keep the default order of categories, corresponding to the + sequence in `org-agenda-files'. +category-up Sort alphabetically by category, A-Z. +category-down Sort alphabetically by category, Z-A. +tag-up Sort alphabetically by last tag, A-Z. +tag-down Sort alphabetically by last tag, Z-A. +priority-up Sort numerically by priority, high priority last. +priority-down Sort numerically by priority, high priority first. +todo-state-up Sort by todo state, tasks that are done last. +todo-state-down Sort by todo state, tasks that are done first. +effort-up Sort numerically by estimated effort, high effort last. +effort-down Sort numerically by estimated effort, high effort first. +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. The different possibilities will be tried in sequence, and testing stops if one comparison returns a \"not-equal\". For example, the default @@ -820,7 +924,9 @@ categories by priority. Instead of a single list, this can also be a set of list for specific contents, with a context symbol in the car of the list, any of -`agenda', `todo', `tags' for the corresponding agenda views." +`agenda', `todo', `tags' for the corresponding agenda views. + +Custom commands can bind this variable in the options section." :group 'org-agenda-sorting :type `(choice (repeat :tag "General" ,org-sorting-choice) @@ -832,6 +938,16 @@ contents, with a context symbol in the car of the list, any of (cons (const :tag "Strategy for Tags matches" tags) (repeat ,org-sorting-choice))))) +(defcustom org-agenda-cmp-user-defined nil + "A function to define the comparison `user-defined'. +This function must receive two arguments, agenda entry a and b. +If a>b, return +1. If a<b, return -1. If they are equal as seen by +the user comparison, return nil. +When this is defined, you can make `user-defined-up' and `user-defined-down' +part of an agenda sorting strategy." + :group 'org-agenda-sorting + :type 'symbol) + (defcustom org-sort-agenda-notime-is-late t "Non-nil means, items without time are considered late. This is only relevant for sorting. When t, items which have no explicit @@ -844,6 +960,9 @@ agenda entries." (defcustom org-sort-agenda-noeffort-is-high t "Non-nil means, items without effort estimate are sorted as high effort. +This also applies when filtering an agenda view with respect to the +< or > effort operator. Then, tasks with no effort defined will be treated +as tasks with high effort. When nil, such items are sorted as 0 minutes effort." :group 'org-agenda-sorting :type 'boolean) @@ -906,7 +1025,9 @@ the prefix, you could use: (setq org-agenda-prefix-format \" %-11:c% s\") See also the variables `org-agenda-remove-times-when-in-prefix' and -`org-agenda-remove-tags'." +`org-agenda-remove-tags'. + +Custom commands can set this variable in the options section." :type '(choice (string :tag "General format") (list :greedy t :tag "View dependent" @@ -1025,18 +1146,22 @@ it means that the tags should be flushright to that column. For example, (if (fboundp 'defvaralias) (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)) -(defcustom org-agenda-fontify-priorities t +(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. +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 keys are the character values of `org-highest-priority', `org-default-priority', and `org-lowest-priority' (the default values -are ?A, ?B, and ?C, respectively). The face may be a names face, +are ?A, ?B, and ?C, respectively). The face may be a named face, or a list like `(:background \"Red\")'." :group 'org-agenda-line-format :type '(choice (const :tag "Never" nil) (const :tag "Defaults" t) + (const :tag "Cookies only" cookies) (repeat :tag "Specify" (list (character :tag "Priority" :value ?A) (sexp :tag "face"))))) @@ -1101,6 +1226,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good." "Keymap for `org-agenda-mode'.") (defvar org-agenda-menu) ; defined later in this file. +(defvar org-agenda-restrict) ; defined later in this file. (defvar org-agenda-follow-mode nil) (defvar org-agenda-clockreport-mode nil) (defvar org-agenda-show-log nil) @@ -1110,6 +1236,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good." "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 (defun org-agenda-mode () "Mode for time-sorted view on action items in Org-mode files. @@ -1120,7 +1247,8 @@ The following commands are available: (interactive) (kill-all-local-variables) (setq org-agenda-undo-list nil - org-agenda-pending-undo-list nil) + org-agenda-pending-undo-list nil + org-agenda-bulk-marked-entries nil) (setq major-mode 'org-agenda-mode) ;; Keep global-font-lock-mode from turning on font-lock-mode (org-set-local 'font-lock-global-modes (list 'not major-mode)) @@ -1139,7 +1267,8 @@ The following commands are available: (unless org-agenda-keep-modes (setq org-agenda-follow-mode org-agenda-start-with-follow-mode org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode - org-agenda-show-log nil)) + org-agenda-show-log org-agenda-start-with-log-mode)) + (easy-menu-change '("Agenda") "Agenda Files" (append @@ -1165,6 +1294,12 @@ The following commands are available: (org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) (org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive) (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive) +(org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile) +(org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark) +(org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark) +(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-remove-all-marks) +(org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action) +(org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload) (org-defkey org-agenda-mode-map "$" 'org-agenda-archive) (org-defkey org-agenda-mode-map "A" 'org-agenda-archive-to-archive-sibling) (org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link) @@ -1184,16 +1319,15 @@ The following commands are available: (org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date) (org-defkey org-agenda-mode-map "d" 'org-agenda-day-view) (org-defkey org-agenda-mode-map "w" 'org-agenda-week-view) -(org-defkey org-agenda-mode-map "m" 'org-agenda-month-view) (org-defkey org-agenda-mode-map "y" 'org-agenda-year-view) (org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note) (org-defkey org-agenda-mode-map "z" 'org-agenda-add-note) (org-defkey org-agenda-mode-map "k" 'org-agenda-action) (org-defkey org-agenda-mode-map "\C-c\C-x\C-k" 'org-agenda-action) -(org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-date-later) -(org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-date-earlier) -(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-date-later) -(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-date-earlier) +(org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later) +(org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-do-date-earlier) (org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt) (org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule) @@ -1205,7 +1339,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "f" 'org-agenda-follow-mode) (org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode) (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) -(org-defkey org-agenda-mode-map "v" 'org-agenda-archives-mode) +(org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch) (org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) (org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) (org-defkey org-agenda-mode-map "r" 'org-agenda-redo) @@ -1214,8 +1348,8 @@ The following commands are available: (org-defkey org-agenda-mode-map "q" 'org-agenda-quit) (org-defkey org-agenda-mode-map "x" 'org-agenda-exit) (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-write-agenda) -(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers) (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers) +(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers) (org-defkey org-agenda-mode-map "P" 'org-agenda-show-priority) (org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags) (org-defkey org-agenda-mode-map "n" 'next-line) @@ -1249,6 +1383,7 @@ The following commands are available: (org-defkey org-agenda-mode-map [(right)] 'org-agenda-later) (org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier) (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) +(org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) (org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add) (org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract) @@ -1256,6 +1391,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re) (org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag) (org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine) +(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer) (defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) "Local keymap for agenda entries from Org-mode.") @@ -1278,11 +1414,17 @@ The following commands are available: ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] "--" ["Cycle TODO" org-agenda-todo t] - ("Archive" + ("Archive and Refile" ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t] ["Move to archive sibling" org-agenda-archive-to-archive-sibling t] - ["Archive subtree" org-agenda-archive t]) + ["Archive subtree" org-agenda-archive t] + ["Refile" org-agenda-refile t]) ["Delete subtree" org-agenda-kill t] + ("Bulk action" + ["Toggle mark entry" org-agenda-bulk-mark t] + ["Act on all marked" org-agenda-bulk-action t] + ["Unmark all entries" org-agenda-bulk-remove-all-marks :active t :keys "C-u s"]) + "--" ["Add note" org-agenda-add-note t] "--" ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)] @@ -1307,6 +1449,10 @@ The following commands are available: "--" ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] + ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"] + ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"] + ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"] + ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"] ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) ("Clock" ["Clock in" org-agenda-clock-in t] @@ -1329,14 +1475,22 @@ The following commands are available: ["Create iCalendar file" org-export-icalendar-combine-agenda-files t]) "--" ("View" - ["Day View" org-agenda-day-view :active (org-agenda-check-type nil 'agenda) - :style radio :selected (equal org-agenda-ndays 1)] - ["Week View" org-agenda-week-view :active (org-agenda-check-type nil 'agenda) - :style radio :selected (equal org-agenda-ndays 7)] - ["Month View" org-agenda-month-view :active (org-agenda-check-type nil 'agenda) - :style radio :selected (member org-agenda-ndays '(28 29 30 31))] - ["Year View" org-agenda-year-view :active (org-agenda-check-type nil 'agenda) - :style radio :selected (member org-agenda-ndays '(365 366))] + ["Day View" org-agenda-day-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (equal org-agenda-ndays 1) + :keys "v d (or just d)"] + ["Week View" org-agenda-week-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (equal org-agenda-ndays 7) + :keys "v w (or just w)"] + ["Month View" org-agenda-month-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (member org-agenda-ndays '(28 29 30 31)) + :keys "v m"] + ["Year View" org-agenda-year-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (member org-agenda-ndays '(365 366)) + :keys "v y"] "--" ["Include Diary" org-agenda-toggle-diary :style toggle :selected org-agenda-include-diary @@ -1351,12 +1505,16 @@ The following commands are available: "--" ["Show Logbook entries" org-agenda-log-mode :style toggle :selected org-agenda-show-log - :active (org-agenda-check-type nil 'agenda 'timeline)] + :active (org-agenda-check-type nil 'agenda 'timeline) + :keys "v l (or just l)"] ["Include archived trees" org-agenda-archives-mode - :style toggle :selected org-agenda-archives-mode :active t] + :style toggle :selected org-agenda-archives-mode :active t + :keys "v a"] ["Include archive files" (org-agenda-archives-mode t) :style toggle :selected (eq org-agenda-archives-mode t) :active t - :keys "C-u v"]) + :keys "v A"] + "--" + ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict]) ["Write view to file" org-write-agenda t] ["Rebuild buffer" org-agenda-redo t] ["Save all Org-mode Buffers" org-save-all-org-buffers t] @@ -1428,7 +1586,7 @@ that have been changed along." (defvar org-agenda-overriding-restriction nil) ;;;###autoload -(defun org-agenda (arg &optional keys restriction) +(defun org-agenda (&optional arg keys restriction) "Dispatch agenda commands to collect entries to the agenda buffer. Prompts for a command to execute. Any prefix arg will be passed on to the selected command. The default selections are: @@ -1442,6 +1600,15 @@ m Call `org-tags-view' to display headlines with tags matching M Like `m', but select only TODO entries, no ordinary headlines. L Create a timeline for the current buffer. e Export views to associated files. +s Search entries for keywords. +/ Multi occur accros all agenda files and also files listed + in `org-agenda-text-search-extra-files'. +< Restrict agenda commands to buffer, subtree, or region. + Press several times to get the desired effect. +> Remove a previous restriction. +# List \"stuck\" projects. +! Configure what \"stuck\" means. +C Configure custom agenda commands. More commands can be added by configuring the variable `org-agenda-custom-commands'. In particular, specific tags and TODO keyword @@ -1527,7 +1694,7 @@ Pressing `<' twice means to restrict to the current subtree or region (org-let lprops '(org-todo-list match))) ((eq type 'tags-tree) (org-check-for-org-mode) - (org-let lprops '(org-tags-sparse-tree current-prefix-arg match))) + (org-let lprops '(org-match-sparse-tree current-prefix-arg match))) ((eq type 'todo-tree) (org-check-for-org-mode) (org-let lprops @@ -1724,7 +1891,7 @@ s Search for keywords C Configure custom agenda commands (t (error "Invalid key %c" c)))))))) (defun org-run-agenda-series (name series) - (org-prepare-agenda name) + (org-let (nth 1 series) '(org-prepare-agenda name)) (let* ((org-agenda-multi t) (redo (list 'org-run-agenda-series name (list 'quote series))) (cmds (car series)) @@ -1762,6 +1929,7 @@ s Search for keywords C Configure custom agenda commands (widen) (setq org-agenda-redo-command redo) (goto-char (point-min))) + (org-fit-agenda-window) (org-let (nth 1 series) '(org-finalize-agenda))) ;;;###autoload @@ -1923,22 +2091,23 @@ so the export commands can easily use it." (while files (eval (list 'let (append org-agenda-exporter-settings opts pars) (list 'org-write-agenda - (expand-file-name (pop files) dir) t)))) + (expand-file-name (pop files) dir) nil t)))) (and (get-buffer org-agenda-buffer-name) (kill-buffer org-agenda-buffer-name))))))) -(defun org-write-agenda (file &optional nosettings) +(defun org-write-agenda (file &optional open nosettings) "Write the current buffer (an agenda view) as a file. Depending on the extension of the file name, plain text (.txt), HTML (.html or .htm) or Postscript (.ps) is produced. If the extension is .ics, run icalendar export over all files used to construct the agenda and limit the export to entries listed in the agenda now. +With prefic argument OPEN, open the new file immediately. If NOSETTINGS is given, do not scope the settings of `org-agenda-exporter-settings' into the export commands. This is used when the settings have already been scoped and we do not wish to overrule other, higher priority settings." - (interactive "FWrite agenda to file: ") + (interactive "FWrite agenda to file: \nP") (if (not (file-writable-p file)) (error "Cannot write agenda to file %s" file)) (cond @@ -1958,6 +2127,7 @@ higher priority settings." (delete-region beg (or (next-single-property-change beg 'org-filtered) (point-max)))) + (run-hooks 'org-agenda-before-write-hook) (cond ((string-match "\\.html?\\'" file) (set-buffer (htmlize-buffer (current-buffer))) @@ -1973,9 +2143,22 @@ higher priority settings." (kill-buffer (current-buffer)) (message "HTML written to %s" file)) ((string-match "\\.ps\\'" file) - (ps-print-buffer-with-faces file) + (require 'ps-print) + (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"))) + (call-process "ps2pdf" nil nil nil + (expand-file-name + (concat (file-name-sans-extension file) ".ps")) + (expand-file-name file)) + (message "PDF written to %s" file)) ((string-match "\\.ics\\'" file) + (require 'org-icalendar) (let ((org-agenda-marker-table (org-create-marker-find-array (org-agenda-collect-markers))) @@ -1991,7 +2174,9 @@ higher priority settings." (save-buffer 0) (kill-buffer (current-buffer)) (message "Plain text written to %s" file)))))))) - (set-buffer org-agenda-buffer-name))) + (set-buffer org-agenda-buffer-name)) + (when open (org-open-file file))) + (defvar org-agenda-filter-overlays nil) (defun org-agenda-mark-filtered-text () @@ -2021,6 +2206,84 @@ VALUE defaults to t." beg (or (next-single-property-change beg 'org-filtered) (point-max)))))) +(defun org-agenda-add-entry-text () + "Add entry text to agenda lines. +This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the +entry text following headings shown in the agenda. +Drawers will be excluded, also the line with scheduling/deadline info." + (when (> org-agenda-add-entry-text-maxlines 0) + (let (m txt drawer-re kwd-time-re ind) + (goto-char (point-min)) + (while (not (eobp)) + (if (not (setq m (get-text-property (point) 'org-hd-marker))) + (beginning-of-line 2) + (save-excursion + (with-current-buffer (marker-buffer m) + (if (not (org-mode-p)) + (setq txt "") + (save-excursion + (save-restriction + (widen) + (goto-char m) + (beginning-of-line 2) + (setq txt (buffer-substring + (point) + (progn (outline-next-heading) (point))) + drawer-re org-drawer-regexp + kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp + ".*\n?")) + (with-temp-buffer + (insert txt) + (when org-agenda-add-entry-text-descriptive-links + (goto-char (point-min)) + (while (org-activate-bracket-links (point-max)) + (add-text-properties (match-beginning 0) (match-end 0) + '(face org-link)))) + (goto-char (point-min)) + (while (re-search-forward org-bracket-link-regexp (point-max) t) + (set-text-properties (match-beginning 0) (match-end 0) + nil)) + (goto-char (point-min)) + (while (re-search-forward drawer-re nil t) + (delete-region + (match-beginning 0) + (progn (re-search-forward + "^[ \t]*:END:.*\n?" nil 'move) + (point)))) + (goto-char (point-min)) + (while (re-search-forward kwd-time-re nil t) + (replace-match "")) + (if (re-search-forward "[ \t\n]+\\'" nil t) + (replace-match "")) + (goto-char (point-min)) + ;; find min indentation + (goto-char (point-min)) + (untabify (point-min) (point-max)) + (setq ind (org-get-indentation)) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (setq ind (min ind (org-get-indentation)))) + (beginning-of-line 2)) + (goto-char (point-min)) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (move-to-column ind) + (delete-region (point-at-bol) (point))) + (beginning-of-line 2)) + (goto-char (point-min)) + (while (and (not (eobp)) (re-search-forward "^" nil t)) + (replace-match " > ")) + (goto-char (point-min)) + (while (looking-at "[ \t]*\n") (replace-match "")) + (goto-char (point-max)) + (when (> (org-current-line) + (1+ org-agenda-add-entry-text-maxlines)) + (goto-line (1+ org-agenda-add-entry-text-maxlines)) + (backward-char 1)) + (setq txt (buffer-substring (point-min) (point))))))))) + (end-of-line 1) + (if (string-match "\\S-" txt) (insert "\n" txt))))))) + (defun org-agenda-collect-markers () "Collect the markers pointing to entries in the agenda buffer." (let (m markers) @@ -2081,10 +2344,18 @@ VALUE defaults to t." (defvar org-agenda-columns-active nil) (defvar org-agenda-name nil) (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 +by \"+\" or \"-\". +This variable should not be set directly, but agenda custom commands can +bind it in the options section.") + (defun org-prepare-agenda (&optional name) (setq org-todo-keywords-for-agenda nil) (setq org-done-keywords-for-agenda nil) (setq org-agenda-filter nil) + (put 'org-agenda-filter :preset-filter org-agenda-filter-preset) (if org-agenda-multi (progn (setq buffer-read-only nil) @@ -2146,14 +2417,16 @@ VALUE defaults to t." org-agenda-view-columns-initially) (org-agenda-columns)) (when org-agenda-fontify-priorities - (org-fontify-priorities)) + (org-agenda-fontify-priorities)) (when (and org-agenda-dim-blocked-tasks org-blocker-hook) (org-agenda-dim-blocked-tasks)) (run-hooks 'org-finalize-agenda-hook) (setq org-agenda-type (get-text-property (point) 'org-agenda-type)) + (when (get 'org-agenda-filter :preset-filter) + (org-agenda-filter-apply org-agenda-filter)) ))) -(defun org-fontify-priorities () +(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) @@ -2169,12 +2442,16 @@ VALUE defaults to t." l (or (get-char-property (point) 'org-lowest-priority) org-lowest-priority) p (string-to-char (match-string 1)) - b (match-beginning 0) e (point-at-eol) + b (match-beginning 0) + e (if (eq org-agenda-fontify-priorities 'cookies) + (match-end 0) + (point-at-eol)) ov (org-make-overlay b e)) (org-overlay-put ov 'face - (cond ((listp org-agenda-fontify-priorities) - (cdr (assoc p org-agenda-fontify-priorities))) + (cond ((cdr (assoc p org-priority-faces))) + ((and (listp org-agenda-fontify-priorities) + (cdr (assoc p org-agenda-fontify-priorities)))) ((equal p l) 'italic) ((equal p h) 'bold))) (org-overlay-put ov 'org-type 'org-priority))))) @@ -2188,25 +2465,30 @@ VALUE defaults to t." (let ((inhibit-read-only t) (org-depend-tag-blocked nil) (invis (eq org-agenda-dim-blocked-tasks 'invisible)) - b e p ov h l) + org-blocked-by-checkboxes + invis1 b e p ov h l) (goto-char (point-min)) (while (let ((pos (next-single-property-change (point) 'todo-state))) (and pos (goto-char (1+ pos)))) + (setq org-blocked-by-checkboxes nil invis1 invis) (let ((marker (get-text-property (point) 'org-hd-marker))) (when (and marker (not (with-current-buffer (marker-buffer marker) (save-excursion (goto-char marker) - (run-hook-with-args-until-failure - 'org-blocker-hook - (list :type 'todo-state-change - :position marker - :from 'todo - :to 'done)))))) - (setq b (if invis (max (point-min) (1- (point))) (point)) + (if (org-entry-get nil "NOBLOCKING") + t ;; Never block this entry + (run-hook-with-args-until-failure + 'org-blocker-hook + (list :type 'todo-state-change + :position marker + :from 'todo + :to 'done))))))) + (if org-blocked-by-checkboxes (setq invis1 nil)) + (setq b (if invis1 (max (point-min) (1- (point))) (point)) e (point-at-eol) ov (org-make-overlay b e)) - (if invis + (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))))))) @@ -2406,7 +2688,8 @@ When EMPTY is non-nil, also include days without any entries." ;;; Agenda Daily/Weekly (defvar org-agenda-overriding-arguments nil) ; dynamically scoped parameter -(defvar org-agenda-start-day nil) ; dynamically scoped parameter +(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") (defvar org-starting-day nil) ; local variable in the agenda buffer @@ -2507,14 +2790,17 @@ given in `org-agenda-start-on-weekday'." (w1 (org-days-to-iso-week d1)) (w2 (org-days-to-iso-week d2))) (setq s (point)) - (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd))) - "-agenda" - (if (< (- d2 d1) 350) - (if (= w1 w2) - (format " (W%02d)" w1) - (format " (W%02d-W%02d)" w1 w2)) - "") - ":\n")) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert (capitalize (symbol-name (org-agenda-ndays-to-span nd))) + "-agenda" + (if (< (- d2 d1) 350) + (if (= w1 w2) + (format " (W%02d)" w1) + (format " (W%02d-W%02d)" w1 w2)) + "") + ":\n"))) (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure 'org-date-line t))) (while (setq d (pop day-numbers)) @@ -2545,7 +2831,7 @@ given in `org-agenda-start-on-weekday'." :deadline :scheduled :sexp :timestamp)))) (setq rtnall (append rtnall rtn)))) (if org-agenda-include-diary - (progn + (let ((org-agenda-search-headline-for-time t)) (require 'diary-lib) (setq rtn (org-get-entries-from-diary date)) (setq rtnall (append rtnall rtn)))) @@ -2564,7 +2850,9 @@ given in `org-agenda-start-on-weekday'." 'org-agenda-date)) (put-text-property s (1- (point)) 'org-date-line t) (put-text-property s (1- (point)) 'org-day-cnt day-cnt) - (if todayp (put-text-property s (1- (point)) 'org-today t)) + (when todayp + (put-text-property s (1- (point)) 'org-today t) + (put-text-property s (1- (point)) 'face 'org-agenda-date-today)) (if rtnall (insert (org-finalize-agenda-entries (org-agenda-add-time-grid-maybe @@ -2584,7 +2872,7 @@ given in `org-agenda-start-on-weekday'." (setq tbl (apply 'org-get-clocktable p)) (insert tbl))) (goto-char (point-min)) - (org-fit-agenda-window) + (or org-agenda-multi (org-fit-agenda-window)) (unless (and (pos-visible-in-window-p (point-min)) (pos-visible-in-window-p (point-max))) (goto-char (1- (point-max))) @@ -2652,7 +2940,7 @@ in `org-agenda-text-search-extra-files'." (org-set-sorting-strategy 'search) (org-prepare-agenda "SEARCH") (let* ((props (list 'face nil - 'done-face 'org-done + 'done-face 'org-agenda-done 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp @@ -2794,7 +3082,7 @@ in `org-agenda-text-search-extra-files'." (when rtnall (insert (org-finalize-agenda-entries rtnall) "\n")) (goto-char (point-min)) - (org-fit-agenda-window) + (or org-agenda-multi (org-fit-agenda-window)) (add-text-properties (point-min) (point-max) '(org-agenda-type search)) (org-finalize-agenda) (setq buffer-read-only t))) @@ -2864,7 +3152,7 @@ for a keyword. A numeric prefix directly selects the Nth keyword in (when rtnall (insert (org-finalize-agenda-entries rtnall) "\n")) (goto-char (point-min)) - (org-fit-agenda-window) + (or org-agenda-multi (org-fit-agenda-window)) (add-text-properties (point-min) (point-max) '(org-agenda-type todo)) (org-finalize-agenda) (setq buffer-read-only t))) @@ -2879,7 +3167,8 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (org-compile-prefix-format 'tags) (org-set-sorting-strategy 'tags) (let* ((org-tags-match-list-sublevels - (if todo-only t org-tags-match-list-sublevels)) +;?????? (if todo-only t org-tags-match-list-sublevels)) + org-tags-match-list-sublevels) (completion-ignore-case t) rtn rtnall files file pos matcher buffer) @@ -2930,7 +3219,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (when rtnall (insert (org-finalize-agenda-entries rtnall) "\n")) (goto-char (point-min)) - (org-fit-agenda-window) + (or org-agenda-multi (org-fit-agenda-window)) (add-text-properties (point-min) (point-max) '(org-agenda-type tags)) (org-finalize-agenda) (setq buffer-read-only t))) @@ -2943,7 +3232,21 @@ This is basically a temporary global variable that can be set and then used by user-defined selections using `org-agenda-skip-function'.") (defvar org-agenda-overriding-header nil - "When this is set during todo and tags searches, will replace header.") + "When this is set during todo and tags searches, will replace header. +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'. +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 +of a command." + (let ((end (save-excursion (org-end-of-subtree t))) + skip) + (save-excursion + (setq skip (re-search-forward org-agenda-skip-regexp end t))) + (and skip end))) (defun org-agenda-skip-subtree-when-regexp-matches () "Checks if the current subtree contains match for `org-agenda-skip-regexp'. @@ -2956,6 +3259,20 @@ to skip this subtree. This is a function that can be put into (setq skip (re-search-forward org-agenda-skip-regexp end t))) (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'. +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 +`org-agenda-skip-function' for the duration of a command. An important +use of this function is for the stuck project list." + (let ((end (save-excursion (org-end-of-subtree t))) + (entry-end (save-excursion (outline-next-heading) (1- (point)))) + skip) + (save-excursion + (setq skip (re-search-forward org-agenda-skip-regexp end t))) + (and skip entry-end))) + (defun org-agenda-skip-entry-if (&rest conditions) "Skip entry if any of CONDITIONS is true. See `org-agenda-skip-if' for details." @@ -2978,6 +3295,8 @@ scheduled Check if there is a scheduled cookie notscheduled Check if there is no scheduled cookie deadline Check if there is a deadline notdeadline Check if there is no deadline +timestamp Check if there is a timestamp (also deadline or scheduled) +nottimestamp Check if there is no timestamp (also deadline or scheduled) regexp Check if regexp matches notregexp Check if regexp does not match. @@ -3004,6 +3323,10 @@ that can be put into `org-agenda-skip-function' for the duration of a command." (re-search-forward org-deadline-time-regexp end t)) (and (memq 'notdeadline conditions) (not (re-search-forward org-deadline-time-regexp end t))) + (and (memq 'timestamp conditions) + (re-search-forward org-ts-regexp end t)) + (and (memq 'nottimestamp conditions) + (not (re-search-forward org-ts-regexp end t))) (and (setq m (memq 'regexp conditions)) (stringp (nth 1 m)) (re-search-forward (nth 1 m) end t)) @@ -3020,9 +3343,11 @@ of what a project is and how to check if it stuck, customize the variable `org-stuck-projects'. MATCH is being ignored." (interactive) - (let* ((org-agenda-skip-function 'org-agenda-skip-subtree-when-regexp-matches) + (let* ((org-agenda-skip-function + 'org-agenda-skip-entry-when-regexp-matches-in-subtree) ;; We could have used org-agenda-skip-if here. - (org-agenda-overriding-header "List of stuck projects: ") + (org-agenda-overriding-header + (or org-agenda-overriding-header "List of stuck projects: ")) (matcher (nth 0 org-stuck-projects)) (todo (nth 1 org-stuck-projects)) (todo-wds (if (member "*" todo) @@ -3039,9 +3364,10 @@ MATCH is being ignored." (tags (nth 2 org-stuck-projects)) (tags-re (if (member "*" tags) (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$") - (concat "^\\*+ .*:\\(" - (mapconcat 'identity tags "\\|") - (org-re "\\):[[:alnum:]_@:]*[ \t]*$")))) + (if tags + (concat "^\\*+ .*:\\(" + (mapconcat 'identity tags "\\|") + (org-re "\\):[[:alnum:]_@:]*[ \t]*$"))))) (gen-re (nth 3 org-stuck-projects)) (re-list (delq nil @@ -3110,6 +3436,9 @@ MATCH is being ignored." 'type "diary" 'date date)) entries))))) +(defvar org-agenda-cleanup-fancy-diary-hook nil + "Hook run when the fancy diary buffer is cleaned up.") + (defun org-agenda-cleanup-fancy-diary () "Remove unwanted stuff in buffer created by `fancy-diary-display'. This gets rid of the date, the underline under the date, and @@ -3129,7 +3458,8 @@ date. It also removes lines that contain only whitespace." (replace-match "")) (goto-char (point-min)) (if (re-search-forward "^Org-mode dummy\n?" nil t) - (replace-match ""))) + (replace-match "")) + (run-hooks 'org-agenda-cleanup-fancy-diary-hook)) ;; Make sure entries from the diary have the right text properties. (eval-after-load "diary-lib" @@ -3295,7 +3625,7 @@ the documentation of `org-diary'." (defun org-agenda-get-todos () "Return the TODO information for agenda display." (let* ((props (list 'face nil - 'done-face 'org-done + 'done-face 'org-agenda-done 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp @@ -3330,8 +3660,9 @@ the documentation of `org-diary'." (goto-char (match-beginning 1)) (setq marker (org-agenda-new-marker (match-beginning 0)) category (org-get-category) + txt (match-string 1) tags (org-get-tags-at (point)) - txt (org-format-agenda-item "" (match-string 1) category tags) + txt (org-format-agenda-item "" txt category tags) priority (1+ (org-get-priority txt)) todo-state (org-get-todo-state)) (org-add-props txt props @@ -3396,9 +3727,9 @@ the documentation of `org-diary'." "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) marker hdmarker deadlinep scheduledp clockp closedp inactivep donep tmp priority category ee txt timestr tags b0 b3 e3 head - todo-state) + todo-state end-of-match) (goto-char (point-min)) - (while (re-search-forward regexp nil t) + (while (setq end-of-match (re-search-forward regexp nil t)) (setq b0 (match-beginning 0) b3 (match-beginning 3) e3 (match-end 3)) (catch :skip @@ -3412,9 +3743,7 @@ the documentation of `org-diary'." (if (and e3 (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date))) (throw :skip nil)) - (setq marker (org-agenda-new-marker b0) - category (org-get-category b0) - tmp (buffer-substring (max (point-min) + (setq tmp (buffer-substring (max (point-min) (- b0 org-ds-keyword-length)) b0) timestr (if b3 "" (buffer-substring b0 (point-at-eol))) @@ -3428,25 +3757,26 @@ the documentation of `org-diary'." (string-match "]-+\\'" tmp))) todo-state (org-get-todo-state) donep (member todo-state org-done-keywords)) - (if (or scheduledp deadlinep closedp clockp) + (if (or scheduledp deadlinep closedp clockp + (and donep org-agenda-skip-timestamp-if-done)) (throw :skip t)) (if (string-match ">" timestr) ;; substring should only run to end of time stamp (setq timestr (substring timestr 0 (match-end 0)))) + (setq marker (org-agenda-new-marker b0) + category (org-get-category b0)) (save-excursion - (if (re-search-backward "^\\*+ " nil t) - (progn - (goto-char (match-beginning 0)) - (setq hdmarker (org-agenda-new-marker) - tags (org-get-tags-at)) - (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") - (setq head (match-string 1)) - (and org-agenda-skip-timestamp-if-done donep (throw :skip t)) - (setq txt (org-format-agenda-item - (if inactivep "[" nil) - head category tags timestr nil - remove-re))) - (setq txt org-agenda-no-heading-message)) + (if (not (re-search-backward "^\\*+ " nil t)) + (setq txt org-agenda-no-heading-message) + (goto-char (match-beginning 0)) + (setq hdmarker (org-agenda-new-marker) + tags (org-get-tags-at)) + (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") + (setq head (match-string 1)) + (setq txt (org-format-agenda-item + (if inactivep "[" nil) + head category tags timestr nil + remove-re))) (setq priority (org-get-priority txt)) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker) @@ -3455,7 +3785,9 @@ the documentation of `org-diary'." 'todo-state todo-state 'type "timestamp") (push txt ee)) - (outline-next-heading))) + (if org-agenda-skip-additional-timestamps-same-entry + (outline-next-heading) + (goto-char end-of-match)))) (nreverse ee))) (defun org-agenda-get-sexps () @@ -3468,7 +3800,8 @@ the documentation of `org-diary'." (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) (regexp "^&?%%(") - marker category ee txt tags entry result beg b sexp sexp-entry) + marker category ee txt tags entry result beg b sexp sexp-entry + todo-state) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -3484,7 +3817,8 @@ the documentation of `org-diary'." (setq result (org-diary-sexp-entry sexp sexp-entry date)) (when result (setq marker (org-agenda-new-marker beg) - category (org-get-category beg)) + category (org-get-category beg) + todo-state (org-get-todo-state)) (if (string-match "\\S-" result) (setq txt result) @@ -3494,7 +3828,7 @@ the documentation of `org-diary'." "" txt category tags 'time)) (org-add-props txt props 'org-marker marker) (org-add-props txt nil - 'org-category category 'date date + 'org-category category 'date date 'todo-state todo-state 'type "sexp") (push txt ee)))) (nreverse ee))) @@ -3518,7 +3852,7 @@ the documentation of `org-diary'." (list (if (memq 'closed items) (concat "\\<" org-closed-string)) (if (memq 'clock items) (concat "\\<" org-clock-string)) - (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\"")))) + (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?")))) (parts-re (if parts (mapconcat 'identity parts "\\|") (error "`org-agenda-log-mode-items' is empty"))) (regexp (concat @@ -3531,8 +3865,9 @@ the documentation of `org-diary'." (apply 'encode-time ; DATE bound by calendar (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 1 11)))) - marker hdmarker priority category tags closedp statep state - ee txt timestr rest clocked) + (org-agenda-search-headline-for-time nil) + marker hdmarker priority category tags closedp statep clockp state + ee txt extra timestr rest clocked) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -3540,41 +3875,55 @@ the documentation of `org-diary'." (setq marker (org-agenda-new-marker (match-beginning 0)) closedp (equal (match-string 1) org-closed-string) statep (equal (string-to-char (match-string 1)) ?-) + clockp (not (or closedp statep)) state (and statep (match-string 2)) category (org-get-category (match-beginning 0)) timestr (buffer-substring (match-beginning 0) (point-at-eol)) - ;; donep (org-entry-is-done-p) ) (when (string-match "\\]" timestr) ;; substring should only run to end of time stamp (setq rest (substring timestr (match-end 0)) timestr (substring timestr 0 (match-end 0))) (if (and (not closedp) (not statep) - (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" rest)) + (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" rest)) (progn (setq timestr (concat (substring timestr 0 -1) "-" (match-string 1 rest) "]")) (setq clocked (match-string 2 rest))) (setq clocked "-"))) (save-excursion - (if (re-search-backward "^\\*+ " nil t) - (progn - (goto-char (match-beginning 0)) - (setq hdmarker (org-agenda-new-marker) - tags (org-get-tags-at)) - (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") - (setq txt (org-format-agenda-item - (cond - (closedp "Closed: ") + (cond + ((not org-agenda-log-mode-add-notes) (setq extra nil)) + (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))) + (if (not (re-search-backward "^\\*+ " nil t)) + (setq txt org-agenda-no-heading-message) + (goto-char (match-beginning 0)) + (setq hdmarker (org-agenda-new-marker) + tags (org-get-tags-at)) + (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") + (setq txt (match-string 1)) + (when extra + (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt) + (setq txt (concat (substring txt 0 (match-beginning 1)) + " - " extra " " (match-string 2 txt))) + (setq txt (concat txt " - " extra)))) + (setq txt (org-format-agenda-item + (cond + (closedp "Closed: ") (statep (concat "State: (" state ")")) (t (concat "Clocked: (" clocked ")"))) - (match-string 1) category tags timestr))) - (setq txt org-agenda-no-heading-message)) + txt category tags timestr))) (setq priority 100000) (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker 'face 'org-done + 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done 'priority priority 'org-category category 'type "closed" 'date date - 'undone-face 'org-warning 'done-face 'org-done) + 'undone-face 'org-warning 'done-face 'org-agenda-done) (push txt ee)) (goto-char (point-at-eol)))) (nreverse ee))) @@ -3599,6 +3948,7 @@ the documentation of `org-diary'." (catch :skip (org-agenda-skip) (setq s (match-string 1) + txt nil pos (1- (match-beginning 1)) d2 (org-time-string-to-absolute (match-string 1) d1 'past @@ -3614,36 +3964,38 @@ the documentation of `org-diary'." (and todayp (not org-agenda-only-exact-dates))) (= diff 0)) (save-excursion - (setq category (org-get-category)) (setq todo-state (org-get-todo-state)) - (if (re-search-backward "^\\*+[ \t]+" nil t) - (progn - (goto-char (match-end 0)) - (setq pos1 (match-beginning 0)) - (setq tags (org-get-tags-at pos1)) - (setq head (buffer-substring-no-properties - (point) - (progn (skip-chars-forward "^\r\n") - (point)))) - (setq donep (member todo-state org-done-keywords)) - (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) - (setq timestr - (concat (substring s (match-beginning 1)) " ")) - (setq timestr 'time)) - (if (and donep - (or org-agenda-skip-deadline-if-done - (not (= diff 0)))) - (setq txt nil) - (setq txt (org-format-agenda-item - (if (= diff 0) - (car org-agenda-deadline-leaders) - (if (functionp (nth 1 org-agenda-deadline-leaders)) - (funcall (nth 1 org-agenda-deadline-leaders) diff date) - (format (nth 1 org-agenda-deadline-leaders) - diff))) - head category tags - (if (not (= diff 0)) nil timestr))))) - (setq txt org-agenda-no-heading-message)) + (setq donep (member todo-state org-done-keywords)) + (if (and donep + (or org-agenda-skip-deadline-if-done + (not (= diff 0)))) + (setq txt nil) + (setq category (org-get-category)) + (if (not (re-search-backward "^\\*+[ \t]+" nil t)) + (setq txt org-agenda-no-heading-message) + (goto-char (match-end 0)) + (setq pos1 (match-beginning 0)) + (setq tags (org-get-tags-at pos1)) + (setq head (buffer-substring-no-properties + (point) + (progn (skip-chars-forward "^\r\n") + (point)))) + (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (setq timestr + (concat (substring s (match-beginning 1)) " ")) + (setq timestr 'time)) + (setq txt (org-format-agenda-item + (if (= diff 0) + (car org-agenda-deadline-leaders) + (if (functionp + (nth 1 org-agenda-deadline-leaders)) + (funcall + (nth 1 org-agenda-deadline-leaders) + diff date) + (format (nth 1 org-agenda-deadline-leaders) + diff))) + head category tags + (if (not (= diff 0)) nil timestr))))) (when txt (setq face (org-agenda-deadline-face dfrac wdays)) (org-add-props txt props @@ -3655,8 +4007,8 @@ the documentation of `org-diary'." 'todo-state todo-state 'type (if upcomingp "upcoming-deadline" "deadline") 'date (if upcomingp date d2) - 'face (if donep 'org-done face) - 'undone-face face 'done-face 'org-done) + 'face (if donep 'org-agenda-done face) + 'undone-face face 'done-face 'org-agenda-done) (push txt ee)))))) (nreverse ee))) @@ -3674,7 +4026,7 @@ FRACTION is what fraction of the head-warning time has passed." (let* ((props (list 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp - 'done-face 'org-done + 'done-face 'org-agenda-done 'mouse-face 'highlight 'keymap org-agenda-keymap 'help-echo @@ -3690,6 +4042,7 @@ FRACTION is what fraction of the head-warning time has passed." (catch :skip (org-agenda-skip) (setq s (match-string 1) + txt nil pos (1- (match-beginning 1)) d2 (org-time-string-to-absolute (match-string 1) d1 'past @@ -3703,33 +4056,32 @@ FRACTION is what fraction of the head-warning time has passed." (and todayp (not org-agenda-only-exact-dates))) (= diff 0)) (save-excursion - (setq category (org-get-category)) (setq todo-state (org-get-todo-state)) - (if (re-search-backward "^\\*+[ \t]+" nil t) - (progn - (goto-char (match-end 0)) - (setq pos1 (match-beginning 0)) - (setq tags (org-get-tags-at)) - (setq head (buffer-substring-no-properties - (point) - (progn (skip-chars-forward "^\r\n") (point)))) - (setq donep (member todo-state org-done-keywords)) - (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) - (setq timestr - (concat (substring s (match-beginning 1)) " ")) - (setq timestr 'time)) - (if (and donep - (or org-agenda-skip-scheduled-if-done - (not (= diff 0)))) - (setq txt nil) - (setq txt (org-format-agenda-item - (if (= diff 0) - (car org-agenda-scheduled-leaders) - (format (nth 1 org-agenda-scheduled-leaders) - (- 1 diff))) - head category tags - (if (not (= diff 0)) nil timestr))))) - (setq txt org-agenda-no-heading-message)) + (setq donep (member todo-state org-done-keywords)) + (if (and donep + (or org-agenda-skip-scheduled-if-done + (not (= diff 0)))) + (setq txt nil) + (setq category (org-get-category)) + (if (not (re-search-backward "^\\*+[ \t]+" nil t)) + (setq txt org-agenda-no-heading-message) + (goto-char (match-end 0)) + (setq pos1 (match-beginning 0)) + (setq tags (org-get-tags-at)) + (setq head (buffer-substring-no-properties + (point) + (progn (skip-chars-forward "^\r\n") (point)))) + (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (setq timestr + (concat (substring s (match-beginning 1)) " ")) + (setq timestr 'time)) + (setq txt (org-format-agenda-item + (if (= diff 0) + (car org-agenda-scheduled-leaders) + (format (nth 1 org-agenda-scheduled-leaders) + (- 1 diff))) + head category tags + (if (not (= diff 0)) nil timestr))))) (when txt (setq face (cond @@ -3738,7 +4090,7 @@ FRACTION is what fraction of the head-warning time has passed." (t 'org-scheduled))) (org-add-props txt props 'undone-face face - 'face (if donep 'org-done face) + 'face (if donep 'org-agenda-done face) 'org-marker (org-agenda-new-marker pos) 'org-hd-marker (org-agenda-new-marker pos1) 'type (if pastschedp "past-scheduled" "scheduled") @@ -3763,7 +4115,7 @@ FRACTION is what fraction of the head-warning time has passed." (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) marker hdmarker ee txt d1 d2 s1 s2 timestr category todo-state tags pos - head) + head donep) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip @@ -3778,27 +4130,26 @@ FRACTION is what fraction of the head-warning time has passed." ;; Only allow days between the limits, because the normal ;; date stamps will catch the limits. (save-excursion + (setq todo-state (org-get-todo-state)) + (setq donep (member todo-state org-done-keywords)) + (if (and donep org-agenda-skip-timestamp-if-done) + (throw :skip t)) (setq marker (org-agenda-new-marker (point))) (setq category (org-get-category)) - (setq todo-state (org-get-todo-state)) - (if (re-search-backward "^\\*+ " nil t) - (progn - (goto-char (match-beginning 0)) - (setq hdmarker (org-agenda-new-marker (point))) - (setq tags (org-get-tags-at)) - (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") - (setq head (match-string 1)) - (and org-agenda-skip-timestamp-if-done - (org-entry-is-done-p) - (throw :skip t)) - (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 - (if (= d0 d1) timestr)))) - (setq txt org-agenda-no-heading-message)) + (if (not (re-search-backward "^\\*+ " nil t)) + (setq txt org-agenda-no-heading-message) + (goto-char (match-beginning 0)) + (setq hdmarker (org-agenda-new-marker (point))) + (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 + (if (= d0 d1) timestr)))) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'type "block" 'date date @@ -3850,7 +4201,9 @@ Any match of REMOVE-RE will be removed from TXT." ;; time, tag, effort are needed for the eval of the prefix format (tag (if tags (nth (1- (length tags)) tags) "")) time effort neffort - (ts (if dotime (concat (if (stringp dotime) dotime "") txt))) + (ts (if dotime (concat + (if (stringp dotime) dotime "") + (and org-agenda-search-headline-for-time txt)))) (time-of-day (and dotime (org-get-time-of-day ts))) stamp plain s0 s1 s2 t1 t2 rtn srp duration) @@ -3939,6 +4292,7 @@ Any match of REMOVE-RE will be removed from TXT." (setq rtn (concat (eval org-prefix-format-compiled) txt))) ;; And finally add the text properties + (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) (org-add-props rtn nil 'org-category (downcase category) 'tags (mapcar 'org-downcase-keep-props tags) @@ -4104,7 +4458,7 @@ HH:MM." (setq re (get-text-property (point) 'org-todo-regexp)) (goto-char (+ (point) (or (get-text-property (point) 'prefix-length) 0))) (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) - (add-text-properties (match-beginning 0) (match-end 0) + (add-text-properties (match-beginning 0) (match-end 1) (list 'face (org-get-todo-face 1))) (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) (delete-region (match-beginning 1) (1- (match-end 0))) @@ -4153,10 +4507,19 @@ HH:MM." (defsubst org-cmp-todo-state (a b) "Compare the todo states of strings A and B." - (let* ((ta (or (get-text-property 1 'todo-state a) "")) + (let* ((ma (or (get-text-property 1 'org-marker a) + (get-text-property 1 'org-hd-marker a))) + (mb (or (get-text-property 1 'org-marker b) + (get-text-property 1 'org-hd-marker b))) + (fa (and ma (marker-buffer ma))) + (fb (and mb (marker-buffer mb))) + (todo-kwds + (or (and fa (with-current-buffer fa org-todo-keywords-1)) + (and fb (with-current-buffer fb org-todo-keywords-1)))) + (ta (or (get-text-property 1 'todo-state a) "")) (tb (or (get-text-property 1 'todo-state b) "")) - (la (- (length (member ta org-todo-keywords-for-agenda)))) - (lb (- (length (member tb org-todo-keywords-for-agenda)))) + (la (- (length (member ta todo-kwds)))) + (lb (- (length (member tb todo-kwds)))) (donepa (member ta org-done-keywords-for-agenda)) (donepb (member tb org-done-keywords-for-agenda))) (cond ((and donepa (not donepb)) -1) @@ -4200,7 +4563,13 @@ HH:MM." (tag-up (org-cmp-tag a b)) (tag-down (if tag-up (- tag-up) nil)) (todo-state-up (org-cmp-todo-state a b)) - (todo-state-down (if todo-state-up (- todo-state-up) nil))) + (todo-state-down (if todo-state-up (- todo-state-up) nil)) + user-defined-up user-defined-down) + (if (and org-agenda-cmp-user-defined + (functionp org-agenda-cmp-user-defined)) + (setq user-defined-up + (funcall org-agenda-cmp-user-defined a b) + user-defined-down (if user-defined-up (- user-defined-up) nil))) (cdr (assoc (eval (cons 'or org-agenda-sorting-strategy-selected)) '((-1 . t) (1 . nil) (nil . nil)))))) @@ -4294,7 +4663,9 @@ If ERROR is non-nil, throw an error, otherwise just return nil." (if org-agenda-columns-active (org-columns-quit) (let ((buf (current-buffer))) - (if (not (one-window-p)) (delete-window)) + (and (not (eq org-agenda-window-setup 'current-window)) + (not (one-window-p)) + (delete-window)) (kill-buffer buf) (org-agenda-reset-markers) (org-columns-remove-overlays) @@ -4321,30 +4692,26 @@ So this is just a shortcut for `\\[org-agenda]', available in the agenda." (let ((org-agenda-window-setup 'current-window)) (org-agenda arg))) -(defun org-save-all-org-buffers () - "Save all Org-mode buffers without user confirmation." - (interactive) - (message "Saving all Org-mode buffers...") - (save-some-buffers t 'org-mode-p) - (message "Saving all Org-mode buffers... done")) - (defun org-agenda-redo () "Rebuild Agenda. When this is the global TODO list, a prefix argument will be interpreted." (interactive) (let* ((org-agenda-keep-modes t) (filter org-agenda-filter) + (preset (get 'org-agenda-filter :preset-filter)) (cols org-agenda-columns-active) (line (org-current-line)) (window-line (- line (org-current-line (window-start)))) (lprops (get 'org-agenda-redo-command 'org-lprops))) + (put 'org-agenda-filter :preset-filter nil) (and cols (org-columns-quit)) (message "Rebuilding agenda buffer...") (org-let lprops '(eval org-agenda-redo-command)) (setq org-agenda-undo-list nil org-agenda-pending-undo-list nil) (message "Rebuilding agenda buffer...done") - (and filter (org-agenda-filter-apply filter)) + (put 'org-agenda-filter :preset-filter preset) + (and (or filter preset) (org-agenda-filter-apply filter)) (and cols (interactive-p) (org-agenda-columns)) (goto-line line) (recenter window-line))) @@ -4375,7 +4742,7 @@ to switch to narrowing." char a n tag) (unless char (message - "%s by tag [%s ], [TAB], [/]:off, [+-]:narrow, [>=<]:effort: " + "%s by tag [%s ], [TAB], [/]:off, [+-]:narrow, [>=<?]:effort: " (if narrow "Narrow" "Filter") tag-chars) (setq char (read-char))) (when (member char '(?+ ?-)) @@ -4385,20 +4752,21 @@ to switch to narrowing." (message "Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars) (setq char (read-char))) - (when (member char '(?< ?> ?=)) + (when (member char '(?< ?> ?= ??)) ;; An effort operator (setq effort-op (char-to-string char)) - (loop for i from 0 to 9 do - (setq effort-prompt - (concat - effort-prompt " [" - (if (= i 9) "0" (int-to-string (1+ i))) - "]" (nth i efforts)))) (setq alist nil) ; to make sure it will be interpreted as effort. - (message "Effort%s: %s " effort-op effort-prompt) - (setq char (read-char)) - (when (or (< char ?0) (> char ?9)) - (error "Need 1-9,0 to select effort" ))) + (unless (equal char ??) + (loop for i from 0 to 9 do + (setq effort-prompt + (concat + effort-prompt " [" + (if (= i 9) "0" (int-to-string (1+ i))) + "]" (nth i efforts)))) + (message "Effort%s: %s " effort-op effort-prompt) + (setq char (read-char)) + (when (or (< char ?0) (> char ?9)) + (error "Need 1-9,0 to select effort" )))) (when (equal char ?\t) (unless (local-variable-p 'org-global-tags-completion-table (current-buffer)) (org-set-local 'org-global-tags-completion-table @@ -4407,13 +4775,19 @@ to switch to narrowing." (setq tag (org-ido-completing-read "Tag: " org-global-tags-completion-table)))) (cond - ((equal char ?/) (org-agenda-filter-by-tag-show-all)) + ((equal char ?/) + (org-agenda-filter-by-tag-show-all) + (when (get 'org-agenda-filter :preset-filter) + (org-agenda-filter-apply org-agenda-filter))) ((or (equal char ?\ ) (setq a (rassoc char alist)) (and (>= char ?0) (<= char ?9) (setq n (if (= char ?0) 9 (- char ?0 1)) tag (concat effort-op (nth n efforts)) a (cons tag nil))) + (and (= char ??) + (setq tag "?eff") + a (cons tag nil)) (and tag (setq a (cons tag nil)))) (org-agenda-filter-by-tag-show-all) (setq tag (car a)) @@ -4431,10 +4805,11 @@ to switch to narrowing." (defun org-agenda-filter-make-matcher () "Create the form that tests a line for the agenda filter." (let (f f1) - (dolist (x org-agenda-filter) + (dolist (x (append (get 'org-agenda-filter :preset-filter) + org-agenda-filter)) (if (member x '("-" "+")) (setq f1 '(not tags)) - (if (string-match "[<=>]" x) + (if (string-match "[<=>?]" x) (setq f1 (org-agenda-filter-effort-form x)) (setq f1 (list 'member (downcase (substring x 1)) 'tags))) (if (equal (string-to-char x) ?-) @@ -4448,7 +4823,10 @@ E looks line \"+<2:25\"." (let (op) (setq e (substring e 1)) (setq op (string-to-char e) e (substring e 1)) - (setq op (if (equal op ?<) '<= (if (equal op ?>) '>= '=))) + (setq op (cond ((equal op ?<) '<=) + ((equal op ?>) '>=) + ((equal op ??) op) + (t '=))) (list 'org-agenda-compare-effort (list 'quote op) (org-hh:mm-string-to-minutes e)))) @@ -4456,9 +4834,10 @@ E looks line \"+<2:25\"." "Compare the effort of the current line with VALUE, using OP. If the line does not have an effort defined, return nil." (let ((eff (get-text-property (point) 'effort-minutes))) - (if (not eff) - 0 ; we don't have an effort defined, treat as 0 - (funcall op eff value)))) + (if (equal op ??) + (not eff) + (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0)) + value)))) (defun org-agenda-filter-apply (filter) "Set FILTER as the new agenda filter and apply it." @@ -4616,6 +4995,26 @@ With prefix ARG, go backward that many times the current span." (interactive "p") (org-agenda-later (- arg))) +(defun org-agenda-view-mode-dispatch () + "Call one of the view mode commands." + (interactive) + (message "View: [d]ay [w]eek [m]onth [y]ear [l]og [L]og-all [a]rch-trees [A]rch-files + clock[R]eport time[G]rid include[D]iary") + (let ((a (read-char-exclusive))) + (case a + (?d (call-interactively 'org-agenda-day-view)) + (?w (call-interactively 'org-agenda-week-view)) + (?m (call-interactively 'org-agenda-month-view)) + (?y (call-interactively 'org-agenda-year-view)) + (?l (call-interactively 'org-agenda-log-mode)) + (?a (call-interactively 'org-agenda-archives-mode)) + (?A (org-agenda-archives-mode 'files)) + (?R (call-interactively 'org-agenda-clockreport-mode)) + (?G (call-interactively 'org-agenda-toggle-time-grid)) + (?D (call-interactively 'org-agenda-toggle-diary)) + (?q (message "Abort")) + (otherwise (error "Invalid key" ))))) + (defun org-agenda-day-view (&optional day-of-year) "Switch to daily view for agenda. With argument DAY-OF-YEAR, switch to that day of the year." @@ -4800,7 +5199,8 @@ With a double `C-u' prefix arg, show *only* log items, nothing else." (if org-agenda-show-log "on" "off"))) (defun org-agenda-archives-mode (&optional with-files) - "Toggle log mode in an agenda buffer." + "Toggle inclusion of items in trees marked with :ARCHIVE:. +When called with a prefix argument, include all archive files as well." (interactive "P") (setq org-agenda-archives-mode (if with-files t (if org-agenda-archives-mode nil 'trees))) @@ -4848,8 +5248,13 @@ With a double `C-u' prefix arg, show *only* log items, nothing else." (if org-agenda-use-time-grid " Grid" "") (if (consp org-agenda-show-log) " LogAll" (if org-agenda-show-log " Log" "")) - (if org-agenda-filter - (concat " {" (mapconcat 'identity org-agenda-filter "") "}") + (if (or org-agenda-filter (get 'org-agenda-filter + :preset-filter)) + (concat " {" (mapconcat + 'identity + (append (get 'org-agenda-filter + :preset-filter) + org-agenda-filter) "") "}") "") (if org-agenda-archives-mode (if (eq org-agenda-archives-mode t) @@ -4998,11 +5403,33 @@ If this information is not given, the function uses the tree at point." (equal buf (marker-buffer m)) (setq p (marker-position m)) (>= p beg) - (<= p end)) + (< p end)) (let ((inhibit-read-only t)) (delete-region (point-at-bol) (1+ (point-at-eol))))) (beginning-of-line 0)))))) +(defun org-agenda-refile (&optional goto rfloc) + "Refile the item at point." + (interactive "P") + (let* ((marker (or (get-text-property (point) 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (rfloc (or rfloc + (org-refile-get-location + (if goto "Goto: " "Refile to: ") buffer + org-refile-allow-creating-parent-nodes)))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char marker) + (org-remove-subtree-entries-from-agenda) + (org-refile goto buffer rfloc)))))) + + + + (defun org-agenda-open-link () "Follow the link in the current line, if any." (interactive) @@ -5054,6 +5481,78 @@ if it was hidden in the outline." (org-agenda-goto t)) (select-window win))) +(defun org-agenda-show-1 (&optional more) + "Display the Org-mode file which contains the item at point. +The prefix arg causes further revieling: + +0 hide the subtree +1 just show the entry according to defaults. +2 show the text below the heading +3 show the entire subtree +4 show the entire subtree and any LOGBOOK drawers +5 show the entire subtree and any drawers +With prefix argument FULL-ENTRY, make the entire entry visible +if it was hidden in the outline." + (interactive "p") + (let ((win (selected-window))) + (org-agenda-goto t) + (org-recenter-heading 1) + (cond + ((= more 0) + (hide-subtree) + (message "Remote: hide subtree")) + ((and (interactive-p) (= more 1)) + (message "Remote: show with default settings")) + ((= more 2) + (show-entry) + (save-excursion + (org-back-to-heading) + (org-cycle-hide-drawers 'children)) + (message "Remote: show entry")) + ((= more 3) + (show-subtree) + (save-excursion + (org-back-to-heading) + (org-cycle-hide-drawers 'subtree)) + (message "Remote: show subtree")) + ((= more 4) + (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers))) + (org-drawer-regexp + (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$"))) + (show-subtree) + (save-excursion + (org-back-to-heading) + (org-cycle-hide-drawers 'subtree))) + (message "Remote: show subtree and LOGBOOK")) + ((> more 4) + (show-subtree) + (message "Remote: show subtree and LOGBOOK"))) + (select-window win))) + +(defun org-recenter-heading (n) + (save-excursion + (org-back-to-heading) + (recenter n))) + +(defvar org-agenda-cycle-counter nil) +(defun org-agenda-cycle-show (n) + "Show the current entry in another window, with default settings. +Default settings are taken from `org-show-hierarchy-above' and siblings. +When use repeadedly in immediate succession, the remote entry will cycle +through visibility + +entry -> subtree -> subtree with logbook" + (interactive "p") + (when (and (= n 1) + (not (eq last-command this-command))) + (setq org-agenda-cycle-counter 0)) + (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter)) + (if (> org-agenda-cycle-counter 4) + (setq org-agenda-cycle-counter 0)) + (org-agenda-show-1 org-agenda-cycle-counter)) + (defun org-agenda-recenter (arg) "Display the Org-mode file which contains the item at point and recenter." (interactive "P") @@ -5266,6 +5765,8 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." This changes the line at point, all other lines in the agenda referring to the same tree node, and the headline of the tree node in the Org-mode file." (interactive) + (unless org-enable-priority-commands + (error "Priority commands are disabled")) (org-agenda-check-no-diary) (let* ((marker (or (get-text-property (point) 'org-marker) (org-agenda-error))) @@ -5289,7 +5790,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (beginning-of-line 1)))) ;; FIXME: should fix the tags property of the agenda line. -(defun org-agenda-set-tags () +(defun org-agenda-set-tags (&optional tag onoff) "Set tags for the current headline." (interactive) (org-agenda-check-no-diary) @@ -5312,7 +5813,9 @@ the same tree node, and the headline of the tree node in the Org-mode file." (and (outline-next-heading) (org-flag-heading nil))) ; show the next heading (goto-char pos) - (call-interactively 'org-set-tags) + (if tag + (org-toggle-tag tag onoff) + (call-interactively 'org-set-tags)) (end-of-line 1) (setq newhead (org-get-heading))) (org-agenda-change-all-lines newhead hdmarker) @@ -5343,6 +5846,38 @@ the same tree node, and the headline of the tree node in the Org-mode file." (org-agenda-change-all-lines newhead hdmarker) (beginning-of-line 1)))) +(defun org-agenda-do-date-later (arg) + (interactive "P") + (cond + ((or (equal arg '(16)) + (memq last-command + '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) + (setq this-command 'org-agenda-date-later-minutes) + (org-agenda-date-later-minutes 1)) + ((or (equal arg '(4)) + (memq last-command + '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) + (setq this-command 'org-agenda-date-later-hours) + (org-agenda-date-later-hours 1)) + (t + (org-agenda-date-later (prefix-numeric-value arg))))) + +(defun org-agenda-do-date-earlier (arg) + (interactive "P") + (cond + ((or (equal arg '(16)) + (memq last-command + '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) + (setq this-command 'org-agenda-date-earlier-minutes) + (org-agenda-date-earlier-minutes 1)) + ((or (equal arg '(4)) + (memq last-command + '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) + (setq this-command 'org-agenda-date-earlier-hours) + (org-agenda-date-earlier-hours 1)) + (t + (org-agenda-date-earlier (prefix-numeric-value arg))))) + (defun org-agenda-date-later (arg &optional what) "Change the date of this item to one day later." (interactive "p") @@ -5367,6 +5902,28 @@ the same tree node, and the headline of the tree node in the Org-mode file." (interactive "p") (org-agenda-date-later (- arg) what)) +(defun org-agenda-date-later-minutes (arg) + "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." + (interactive "p") + (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) + (org-agenda-date-later arg 'minute)) + +(defun org-agenda-date-earlier-minutes (arg) + "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." + (interactive "p") + (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) + (org-agenda-date-earlier arg 'minute)) + +(defun org-agenda-date-later-hours (arg) + "Change the time of this item, in hour steps." + (interactive "p") + (org-agenda-date-later arg 'hour)) + +(defun org-agenda-date-earlier-hours (arg) + "Change the time of this item, in hour steps." + (interactive "p") + (org-agenda-date-earlier arg 'hour)) + (defun org-agenda-show-new-time (marker stamp &optional prefix) "Show new date stamp via text properties." ;; We use text properties to make this undoable @@ -5426,7 +5983,6 @@ be used to request time specification in the time stamp." (pos (marker-position marker)) (org-insert-labeled-timestamps-at-point nil) ts) - (when type (message "%s" type) (sit-for 3)) (set-marker-insertion-type marker t) (org-with-remote-undo buffer (with-current-buffer buffer @@ -5539,15 +6095,26 @@ The cursor may be at a date in the calendar, or in the Org agenda." (org-cycle-hide-drawers 'children) (org-clock-in arg) (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker t))))) + (org-agenda-change-all-lines newhead hdmarker))))) (defun org-agenda-clock-out (&optional arg) "Stop the currently running clock." (interactive "P") (unless (marker-buffer org-clock-marker) (error "No running clock")) - (org-with-remote-undo (marker-buffer org-clock-marker) - (org-clock-out))) + (let ((marker (make-marker)) newhead) + (org-with-remote-undo (marker-buffer org-clock-marker) + (with-current-buffer (marker-buffer org-clock-marker) + (save-excursion + (save-restriction + (widen) + (goto-char org-clock-marker) + (org-back-to-heading t) + (move-marker marker (point)) + (org-clock-out) + (setq newhead (org-get-heading)))))) + (org-agenda-change-all-lines newhead marker) + (move-marker marker nil))) (defun org-agenda-clock-cancel (&optional arg) "Cancel the currently running clock." @@ -5701,6 +6268,159 @@ This is a command that has to be installed in `calendar-mode-map'." (princ s)) (org-fit-window-to-buffer (get-buffer-window "*Dates*")))) +;;; Bulk commands + +(defvar org-agenda-bulk-marked-entries nil + "List of markers that refer to marked entries in the agenda.") + +(defun org-agenda-bulk-mark () + "Mark the entry at point for future bulk action." + (interactive) + (org-agenda-check-no-diary) + (let* ((m (get-text-property (point) 'org-hd-marker)) + ov) + (unless (eq (get-char-property (point-at-bol) 'type) + 'org-marked-entry-overlay) + (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)))) + (org-overlay-display ov ">>" + (org-get-todo-face "TODO") + 'evaporate) + (org-overlay-put ov 'type 'org-marked-entry-overlay)) + (beginning-of-line 2) + (message "%d entries marked for bulk action" + (length org-agenda-bulk-marked-entries)))) + +(defun org-agenda-bulk-unmark () + "Unmark the entry at point for future bulk action." + (interactive) + (when (eq (get-char-property (point-at-bol) 'type) + 'org-marked-entry-overlay) + (org-agenda-bulk-remove-overlays + (point-at-bol) (+ 2 (point-at-bol))) + (setq org-agenda-bulk-marked-entries + (delete (get-text-property (point-at-bol) 'org-hd-marker) + org-agenda-bulk-marked-entries))) + (beginning-of-line 2) + (message "%d entries marked for bulk action" + (length org-agenda-bulk-marked-entries))) + + +(defun org-agenda-bulk-remove-overlays (&optional beg end) + "Remove the mark overlays between BEG and END in the agenda buffer. +BEG and END default to the buffer limits. + +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))))) + +(defun org-agenda-bulk-remove-all-marks () + "Remove all marks in the agenda buffer. +This will remove the markers, and the overlays." + (interactive) + (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries) + (setq org-agenda-bulk-marked-entries nil) + (org-agenda-bulk-remove-overlays (point-min) (point-max))) + +(defun org-agenda-bulk-action () + "Execute an remote-editing action on all marked entries." + (interactive) + (unless org-agenda-bulk-marked-entries + (error "No entries are marked")) + (message "Bulk: [r]efile [$]archive [A]rch->sib [t]odo [+/-]tag [s]chedule [d]eadline") + (let* ((action (read-char-exclusive)) + (entries (reverse org-agenda-bulk-marked-entries)) + cmd rfloc state e tag pos (cnt 0) (cntskip 0)) + (cond + ((equal action ?$) + (setq cmd '(org-agenda-archive))) + + ((equal action ?A) + (setq cmd '(org-agenda-archive-to-archive-sibling))) + + ((member action '(?r ?w)) + (setq rfloc (org-refile-get-location + "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")))) + + (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc)))) + + ((equal action ?t) + (setq state (org-ido-completing-read + "Todo state: " + (with-current-buffer (marker-buffer (car entries)) + (mapcar 'list org-todo-keywords-1)))) + (setq cmd `(let ((org-inhibit-blocking t) + (org-inhibit-logging 'note)) + (org-agenda-todo ,state)))) + + ((memq action '(?- ?+)) + (setq tag (org-ido-completing-read + (format "Tag to %s: " (if (eq action ?+) "add" "remove")) + (with-current-buffer (marker-buffer (car entries)) + (delq nil + (mapcar (lambda (x) + (if (stringp (car x)) x)) org-tag-alist))))) + (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off)))) + + ((memq action '(?s ?d)) + (let* ((date (org-read-date + nil nil nil + (if (eq action ?s) "(Re)Schedule to" "Set Deadline to"))) + (ans org-read-date-final-answer) + (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline))) + (setq cmd `(let* ((bound (fboundp 'read-string)) + (old (and bound (symbol-function 'read-string)))) + (unwind-protect + (progn + (fset 'read-string (lambda (&rest ignore) ,ans)) + (call-interactively ',c1)) + (if bound + (fset 'read-string old) + (fmakunbound 'read-string))))))) + (t (error "Invalid bulk action"))) + + ;; Sort the markers, to make sure that parents are handled before children + (setq entries (sort entries + (lambda (a b) + (cond + ((equal (marker-buffer a) (marker-buffer b)) + (< (marker-position a) (marker-position b))) + (t + (string< (buffer-name (marker-buffer a)) + (buffer-name (marker-buffer b)))))))) + + ;; Now loop over all markers and apply cmd + (while (setq e (pop entries)) + (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e)) + (if (not pos) + (progn (message "Skipping removed entry at %s" e) + (setq cntskip (1+ cntskip))) + (goto-char pos) + (eval cmd) + (setq org-agenda-bulk-marked-entries + (delete e org-agenda-bulk-marked-entries)) + (setq cnt (1+ cnt)))) + (setq org-agenda-bulk-marked-entries nil) + (org-agenda-bulk-remove-all-marks) + (message "Acted on %d entries%s" + cnt + (if (= cntskip 0) + "" + (format ", skipped %d (disappeared before their turn)" + cntskip))))) + ;;; Appointment reminders (defvar appt-time-msg-list) @@ -5735,6 +6455,7 @@ belonging to the \"Work\" category." (org-deadline-warning-days 0) (today (org-date-to-gregorian (time-to-days (current-time)))) + (org-agenda-restrict nil) (files (org-agenda-files 'unrestricted)) entries file) ;; Get all entries which may contain an appt (org-prepare-agenda-buffers files) @@ -5788,4 +6509,3 @@ belonging to the \"Work\" category." ;; arch-tag: 77f7565d-7c4b-44af-a2df-9f6f7070cff1 ;;; org-agenda.el ends here - diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index a3ac5c88d43..26d3278183c 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -32,6 +32,8 @@ (require 'org) +(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) + (defcustom org-archive-sibling-heading "Archive" "Name of the local archive sibling that is used to archive entries locally. Locally means: in the tree, under a sibling. @@ -270,7 +272,7 @@ this heading." ;; No specific heading, just go to end of file. (goto-char (point-max)) (insert "\n")) ;; Paste - (org-paste-subtree (org-get-valid-level level 1)) + (org-paste-subtree (org-get-valid-level level (and heading 1))) ;; Mark the entry as done (when (and org-archive-mark-done @@ -303,12 +305,16 @@ this heading." ;; Here we are back in the original buffer. Everything seems to have ;; worked. So now cut the tree and finish up. (let (this-command) (org-cut-subtree)) + (when (featurep 'org-inlinetask) + (org-inlinetask-remove-END-maybe)) (setq org-markers-to-move nil) (message "Subtree archived %s" (if (eq this-buffer buffer) (concat "under heading: " heading) (concat "in file: " (abbreviate-file-name afile)))))) - (org-reveal)) + (org-reveal) + (if (looking-at "^[ \t]*$") + (outline-next-visible-heading 1))) (defun org-archive-to-archive-sibling () "Archive the current heading by moving it under the archive sibling. @@ -360,7 +366,9 @@ sibling does not exist, it will be created at the end of the subtree." (hide-subtree) (org-cycle-show-empty-lines 'folded) (goto-char pos))) - (org-reveal)) + (org-reveal) + (if (looking-at "^[ \t]*$") + (outline-next-visible-heading 1))) (defun org-archive-all-done (&optional tag) "Archive sublevels of the current tree without open TODO items. diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el new file mode 100644 index 00000000000..9e5fd6dda69 --- /dev/null +++ b/lisp/org/org-ascii.el @@ -0,0 +1,606 @@ +;;; org-ascii.el --- ASCII export for Org-mode + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.29c +;; +;; 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: + +(require 'org-exp) + +(defgroup org-export-ascii nil + "Options specific for ASCII export of Org-mode files." + :tag "Org Export ASCII" + :group 'org-export) + +(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) + "Characters for underlining headings in ASCII export. +In the given sequence, these characters will be used for level 1, 2, ..." + :group 'org-export-ascii + :type '(repeat character)) + +(defcustom org-export-ascii-bullets '(?* ?+ ?-) + "Bullet characters for headlines converted to lists in ASCII export. +The first character is used for the first lest level generated in this +way, and so on. If there are more levels than characters given here, +the list will be repeated. +Note that plain lists will keep the same bullets as the have in the +Org-mode file." + :group 'org-export-ascii + :type '(repeat character)) + +(defcustom org-export-ascii-links-to-notes t + "Non-nil means, convert links to notes before the next headline. +When nil, the link will be exported in place. If the line becomes long +in this way, it will be wrapped." + :group 'org-export-ascii + :type 'boolean) + +;;; ASCII export + +(defvar org-ascii-current-indentation nil) ; For communication + +;;;###autoload +(defun org-export-as-ascii-to-buffer (arg) + "Call `org-export-as-ascii` with output to a temporary buffer. +No file is created. The prefix ARG is passed through to `org-export-as-ascii'." + (interactive "P") + (org-export-as-ascii arg nil nil "*Org ASCII Export*") + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window "*Org ASCII Export*"))) + +;;;###autoload +(defun org-replace-region-by-ascii (beg end) + "Assume the current region has org-mode syntax, and convert it to plain ASCII. +This can be used in any buffer. For example, you could write an +itemized list in org-mode syntax in a Mail buffer and then use this +command to convert it." + (interactive "r") + (let (reg ascii buf pop-up-frames) + (save-window-excursion + (if (org-mode-p) + (setq ascii (org-export-region-as-ascii + beg end t 'string)) + (setq reg (buffer-substring beg end) + buf (get-buffer-create "*Org tmp*")) + (with-current-buffer buf + (erase-buffer) + (insert reg) + (org-mode) + (setq ascii (org-export-region-as-ascii + (point-min) (point-max) t 'string))) + (kill-buffer buf))) + (delete-region beg end) + (insert ascii))) + +;;;###autoload +(defun org-export-region-as-ascii (beg end &optional body-only buffer) + "Convert region from BEG to END in org-mode buffer to plain ASCII. +If prefix arg BODY-ONLY is set, omit file header, footer, and table of +contents, and only produce the region of converted text, useful for +cut-and-paste operations. +If BUFFER is a buffer or a string, use/create that buffer as a target +of the converted ASCII. If BUFFER is the symbol `string', return the +produced ASCII as a string and leave not buffer behind. For example, +a Lisp program could call this function in the following way: + + (setq ascii (org-export-region-as-ascii beg end t 'string)) + +When called interactively, the output buffer is selected, and shown +in a window. A non-interactive call will only return the buffer." + (interactive "r\nP") + (when (interactive-p) + (setq buffer "*Org ASCII Export*")) + (let ((transient-mark-mode t) (zmacs-regions t) + ext-plist rtn) + (setq ext-plist (plist-put ext-plist :ignore-subree-p t)) + (goto-char end) + (set-mark (point)) ;; to activate the region + (goto-char beg) + (setq rtn (org-export-as-ascii + nil nil ext-plist + buffer body-only)) + (if (fboundp 'deactivate-mark) (deactivate-mark)) + (if (and (interactive-p) (bufferp rtn)) + (switch-to-buffer-other-window rtn) + rtn))) + +;;;###autoload +(defun org-export-as-ascii (arg &optional hidden ext-plist + to-buffer body-only pub-dir) + "Export the outline as a pretty ASCII file. +If there is an active region, export only the region. +The prefix ARG specifies how many levels of the outline should become +underlined headlines, default is 3. Lower levels will become bulleted +lists. When HIDDEN is non-nil, don't display the ASCII buffer. +EXT-PLIST is a property list with external parameters overriding +org-mode's default settings, but still inferior to file-local +settings. When TO-BUFFER is non-nil, create a buffer with that +name and export to that buffer. If TO-BUFFER is the symbol +`string', don't leave any buffer behind but just return the +resulting ASCII as a string. When BODY-ONLY is set, don't produce +the file header and footer. When PUB-DIR is set, use this as the +publishing directory." + (interactive "P") + (setq-default org-todo-line-regexp org-todo-line-regexp) + (let* ((opt-plist (org-combine-plists (org-default-export-plist) + ext-plist + (org-infile-export-plist))) + (region-p (org-region-active-p)) + (rbeg (and region-p (region-beginning))) + (rend (and region-p (region-end))) + (subtree-p + (if (plist-get opt-plist :ignore-subree-p) + nil + (when region-p + (save-excursion + (goto-char rbeg) + (and (org-at-heading-p) + (>= (org-end-of-subtree t t) rend)))))) + (level-offset (if subtree-p + (save-excursion + (goto-char rbeg) + (+ (funcall outline-level) + (if org-odd-levels-only 1 0))) + 0)) + (opt-plist (setq org-export-opt-plist + (if subtree-p + (org-export-add-subtree-options opt-plist rbeg) + opt-plist))) + (custom-times org-display-custom-times) + (org-ascii-current-indentation '(0 . 0)) + (level 0) line txt + (umax nil) + (umax-toc nil) + (case-fold-search nil) + (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) + (filename (if to-buffer + nil + (concat (file-name-as-directory + (or pub-dir + (org-export-directory :ascii opt-plist))) + (file-name-sans-extension + (or (and subtree-p + (org-entry-get (region-beginning) + "EXPORT_FILE_NAME" t)) + (file-name-nondirectory bfname))) + ".txt"))) + (filename (and filename + (if (equal (file-truename filename) + (file-truename bfname)) + (concat filename ".txt") + filename))) + (buffer (if to-buffer + (cond + ((eq to-buffer 'string) + (get-buffer-create "*Org ASCII Export*")) + (t (get-buffer-create to-buffer))) + (find-file-noselect filename))) + (org-levels-open (make-vector org-level-max nil)) + (odd org-odd-levels-only) + (date (plist-get opt-plist :date)) + (author (plist-get opt-plist :author)) + (title (or (and subtree-p (org-export-get-title-from-subtree)) + (plist-get opt-plist :title) + (and (not + (plist-get opt-plist :skip-before-1st-heading)) + (org-export-grab-title-from-buffer)) + (file-name-sans-extension + (file-name-nondirectory bfname)))) + (email (plist-get opt-plist :email)) + (language (plist-get opt-plist :language)) + (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) + (todo nil) + (lang-words nil) + (region + (buffer-substring + (if (org-region-active-p) (region-beginning) (point-min)) + (if (org-region-active-p) (region-end) (point-max)))) + (lines (org-split-string + (org-export-preprocess-string + region + :for-ascii t + :skip-before-1st-heading + (plist-get opt-plist :skip-before-1st-heading) + :drawers (plist-get opt-plist :drawers) + :tags (plist-get opt-plist :tags) + :priority (plist-get opt-plist :priority) + :footnotes (plist-get opt-plist :footnotes) + :timestamps (plist-get opt-plist :timestamps) + :todo-keywords (plist-get opt-plist :todo-keywords) + :verbatim-multiline t + :select-tags (plist-get opt-plist :select-tags) + :exclude-tags (plist-get opt-plist :exclude-tags) + :archived-trees + (plist-get opt-plist :archived-trees) + :add-text (plist-get opt-plist :text)) + "\n")) + thetoc have-headings first-heading-pos + table-open table-buffer link-buffer link desc desc0 rpl wrap) + (let ((inhibit-read-only t)) + (org-unmodified + (remove-text-properties (point-min) (point-max) + '(:org-license-to-kill t)))) + + (setq org-min-level (org-get-min-level lines level-offset)) + (setq org-last-level org-min-level) + (org-init-section-numbers) + (setq lang-words (or (assoc language org-export-language-setup) + (assoc "en" org-export-language-setup))) + (set-buffer buffer) + (erase-buffer) + (fundamental-mode) + (org-install-letbind) + ;; create local variables for all options, to make sure all called + ;; functions get the correct information + (mapc (lambda (x) + (set (make-local-variable (nth 2 x)) + (plist-get opt-plist (car x)))) + org-export-plist-vars) + (org-set-local 'org-odd-levels-only odd) + (setq umax (if arg (prefix-numeric-value arg) + org-export-headline-levels)) + (setq umax-toc (if (integerp org-export-with-toc) + (min org-export-with-toc umax) + umax)) + + ;; File header + (unless body-only + (if title (org-insert-centered title ?=)) + (insert "\n") + (if (and (or author email) + org-export-author-info) + (insert (concat (nth 1 lang-words) ": " (or author "") + (if email (concat " <" email ">") "") + "\n"))) + + (cond + ((and date (string-match "%" date)) + (setq date (format-time-string date))) + (date) + (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) + + (if (and date org-export-time-stamp-file) + (insert (concat (nth 2 lang-words) ": " date"\n"))) + + (insert "\n\n")) + + (if (and org-export-with-toc (not body-only)) + (progn + (push (concat (nth 3 lang-words) "\n") thetoc) + (push (concat (make-string (string-width (nth 3 lang-words)) ?=) + "\n") thetoc) + (mapc '(lambda (line) + (if (string-match org-todo-line-regexp + line) + ;; This is a headline + (progn + (setq have-headings t) + (setq level (- (match-end 1) (match-beginning 1) + level-offset) + level (org-tr-level level) + txt (match-string 3 line) + todo + (or (and org-export-mark-todo-in-toc + (match-beginning 2) + (not (member (match-string 2 line) + org-done-keywords))) + ; TODO, not DONE + (and org-export-mark-todo-in-toc + (= level umax-toc) + (org-search-todo-below + line lines level)))) + (setq txt (org-html-expand-for-ascii txt)) + + (while (string-match org-bracket-link-regexp txt) + (setq txt + (replace-match + (match-string (if (match-end 2) 3 1) txt) + t t txt))) + + (if (and (memq org-export-with-tags '(not-in-toc nil)) + (string-match + (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") + txt)) + (setq txt (replace-match "" t t txt))) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) + + (if org-export-with-section-numbers + (setq txt (concat (org-section-number level) + " " txt))) + (if (<= level umax-toc) + (progn + (push + (concat + (make-string + (* (max 0 (- level org-min-level)) 4) ?\ ) + (format (if todo "%s (*)\n" "%s\n") txt)) + thetoc) + (setq org-last-level level)) + )))) + lines) + (setq thetoc (if have-headings (nreverse thetoc) nil)))) + + (org-init-section-numbers) + (while (setq line (pop lines)) + (when (and link-buffer (string-match "^\\*+ " line)) + (org-export-ascii-push-links (nreverse link-buffer)) + (setq link-buffer nil)) + (setq wrap nil) + ;; Remove the quoted HTML tags. + (setq line (org-html-expand-for-ascii line)) + ;; Replace links with the description when possible + (while (string-match org-bracket-link-regexp line) + (setq link (match-string 1 line) + desc0 (match-string 3 line) + desc (or desc0 (match-string 1 line))) + (if (and (> (length link) 8) + (equal (substring link 0 8) "coderef:")) + (setq line (replace-match + (format (org-export-get-coderef-format (substring link 8) desc) + (cdr (assoc + (substring link 8) + org-export-code-refs))) + t t line)) + (setq rpl (concat "[" + (or (match-string 3 line) (match-string 1 line)) + "]")) + (when (and desc0 (not (equal desc0 link))) + (if org-export-ascii-links-to-notes + (push (cons desc0 link) link-buffer) + (setq rpl (concat rpl " (" link ")") + wrap (+ (length line) (- (length (match-string 0 line))) + (length desc))))) + (setq line (replace-match rpl t t line)))) + (when custom-times + (setq line (org-translate-time line))) + (cond + ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) + ;; a Headline + (setq first-heading-pos (or first-heading-pos (point))) + (setq level (org-tr-level (- (match-end 1) (match-beginning 1) + level-offset)) + txt (match-string 2 line)) + (org-ascii-level-start level txt umax lines)) + + ((and org-export-with-tables + (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) + (if (not table-open) + ;; New table starts + (setq table-open t table-buffer nil)) + ;; Accumulate lines + (setq table-buffer (cons line table-buffer)) + (when (or (not lines) + (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" + (car lines)))) + (setq table-open nil + table-buffer (nreverse table-buffer)) + (insert (mapconcat + (lambda (x) + (org-fix-indentation x org-ascii-current-indentation)) + (org-format-table-ascii table-buffer) + "\n") "\n"))) + (t + (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line) + (setq line (replace-match "\\1\\3:" t nil line))) + (setq line (org-fix-indentation line org-ascii-current-indentation)) + ;; Remove forced line breaks + (if (string-match "\\\\\\\\[ \t]*$" line) + (setq line (replace-match "" t t line))) + (if (and org-export-with-fixed-width + (string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line)) + (setq line (replace-match "\\1" nil nil line)) + (if wrap (setq line (org-export-ascii-wrap line wrap)))) + (insert line "\n")))) + + (org-export-ascii-push-links (nreverse link-buffer)) + + (normal-mode) + + ;; insert the table of contents + (when thetoc + (goto-char (point-min)) + (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t) + (progn + (goto-char (match-beginning 0)) + (replace-match "")) + (goto-char first-heading-pos)) + (mapc 'insert thetoc) + (or (looking-at "[ \t]*\n[ \t]*\n") + (insert "\n\n"))) + + ;; Convert whitespace place holders + (goto-char (point-min)) + (let (beg end) + (while (setq beg (next-single-property-change (point) 'org-whitespace)) + (setq end (next-single-property-change beg 'org-whitespace)) + (goto-char beg) + (delete-region beg end) + (insert (make-string (- end beg) ?\ )))) + + ;; remove display and invisible chars + (let (beg end) + (goto-char (point-min)) + (while (setq beg (next-single-property-change (point) 'display)) + (setq end (next-single-property-change beg 'display)) + (delete-region beg end) + (goto-char beg) + (insert "=>")) + (goto-char (point-min)) + (while (setq beg (next-single-property-change (point) 'org-cwidth)) + (setq end (next-single-property-change beg 'org-cwidth)) + (delete-region beg end) + (goto-char beg))) + (or to-buffer (save-buffer)) + (goto-char (point-min)) + (or (org-export-push-to-kill-ring "ASCII") + (message "Exporting... done")) + ;; Return the buffer or a string, according to how this function was called + (if (eq to-buffer 'string) + (prog1 (buffer-substring (point-min) (point-max)) + (kill-buffer (current-buffer))) + (current-buffer)))) + +(defun org-export-ascii-preprocess (parameters) + "Do extra work for ASCII export" + ;; Put quotes around verbatim text + (goto-char (point-min)) + (while (re-search-forward org-verbatim-re nil t) + (goto-char (match-end 2)) + (backward-delete-char 1) (insert "'") + (goto-char (match-beginning 2)) + (delete-char 1) (insert "`") + (goto-char (match-end 2))) + ;; Remove target markers + (goto-char (point-min)) + (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t) + (replace-match "\\1\\2"))) + +(defun org-html-expand-for-ascii (line) + "Handle quoted HTML for ASCII export." + (if org-export-html-expand + (while (string-match "@<[^<>\n]*>" line) + ;; We just remove the tags for now. + (setq line (replace-match "" nil nil line)))) + line) + +(defun org-export-ascii-wrap (line where) + "Wrap LINE at or before WHERE." + (let ((ind (org-get-indentation line)) + pos) + (catch 'found + (loop for i from where downto (/ where 2) do + (and (equal (aref line i) ?\ ) + (setq pos i) + (throw 'found t)))) + (if pos + (concat (substring line 0 pos) "\n" + (make-string ind ?\ ) + (substring line (1+ pos))) + line))) + +(defun org-export-ascii-push-links (link-buffer) + "Push out links in the buffer." + (when link-buffer + ;; We still have links to push out. + (insert "\n") + (let ((ind "")) + (save-match-data + (if (save-excursion + (re-search-backward + "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t)) + (setq ind (or (match-string 2) + (make-string (length (match-string 3)) ?\ ))))) + (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n")) + link-buffer)) + (insert "\n"))) + +(defun org-ascii-level-start (level title umax &optional lines) + "Insert a new level in ASCII export." + (let (char (n (- level umax 1)) (ind 0)) + (if (> level umax) + (progn + (insert (make-string (* 2 n) ?\ ) + (char-to-string (nth (% n (length org-export-ascii-bullets)) + org-export-ascii-bullets)) + " " title "\n") + ;; find the indentation of the next non-empty line + (catch 'stop + (while lines + (if (string-match "^\\* " (car lines)) (throw 'stop nil)) + (if (string-match "^\\([ \t]*\\)\\S-" (car lines)) + (throw 'stop (setq ind (org-get-indentation (car lines))))) + (pop lines))) + (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind))) + (if (or (not (equal (char-before) ?\n)) + (not (equal (char-before (1- (point))) ?\n))) + (insert "\n")) + (setq char (nth (- umax level) (reverse org-export-ascii-underline))) + (unless org-export-with-tags + (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (setq title (replace-match "" t t title)))) + (if org-export-with-section-numbers + (setq title (concat (org-section-number level) " " title))) + (insert title "\n" (make-string (string-width title) char) "\n") + (setq org-ascii-current-indentation '(0 . 0))))) + +(defun org-insert-centered (s &optional underline) + "Insert the string S centered and underline it with character UNDERLINE." + (let ((ind (max (/ (- fill-column (string-width s)) 2) 0))) + (insert (make-string ind ?\ ) s "\n") + (if underline + (insert (make-string ind ?\ ) + (make-string (string-width s) underline) + "\n")))) + +(defvar org-table-colgroup-info nil) +(defun org-format-table-ascii (lines) + "Format a table for ascii export." + (if (stringp lines) + (setq lines (org-split-string lines "\n"))) + (if (not (string-match "^[ \t]*|" (car lines))) + ;; Table made by table.el - test for spanning + lines + + ;; A normal org table + ;; Get rid of hlines at beginning and end + (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) + (setq lines (nreverse lines)) + (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) + (setq lines (nreverse lines)) + (when org-export-table-remove-special-lines + ;; Check if the table has a marking column. If yes remove the + ;; column and the special lines + (setq lines (org-table-clean-before-export lines))) + ;; Get rid of the vertical lines except for grouping + (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info)) + rtn line vl1 start) + (while (setq line (pop lines)) + (if (string-match org-table-hline-regexp line) + (and (string-match "|\\(.*\\)|" line) + (setq line (replace-match " \\1" t nil line))) + (setq start 0 vl1 vl) + (while (string-match "|" line start) + (setq start (match-end 0)) + (or (pop vl1) (setq line (replace-match " " t t line))))) + (push line rtn)) + (nreverse rtn)))) + +(defun org-colgroup-info-to-vline-list (info) + (let (vl new last) + (while info + (setq last new new (pop info)) + (if (or (memq last '(:end :startend)) + (memq new '(:start :startend))) + (push t vl) + (push nil vl))) + (setq vl (nreverse vl)) + (and vl (setcar vl nil)) + vl)) + +(provide 'org-ascii) + +;; arch-tag: aa96f882-f477-4e13-86f5-70d43e7adf3c + +;;; org-ascii.el ends here diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index 92988b5e60c..05228c22c0f 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.21b +;; Version: 6.29c ;; This file is part of GNU Emacs. ;; @@ -26,7 +26,7 @@ ;; See the Org-mode manual for information on how to use it. ;; ;; Attachments are managed in a special directory called "data", which -;; lives in the directory given by `org-directory'. If this data +;; lives in the same directory as the org file itself. If this data ;; directory is initialized as a Git repository, then org-attach will ;; automatically commit changes when it sees them. ;; @@ -95,7 +95,7 @@ ln create a hard link. Note that this is not supported "Non-nil means, allow attachment directories be inherited." :group 'org-attach :type 'boolean) - + (defvar org-attach-inherited nil "Indicates if the last access to the attachment directory was inherited.") diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el index f9fe216082f..8b2470d82bf 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -49,25 +49,37 @@ ;; %%(org-bbdb-anniversaries) ;; ;; -;; The anniversaries are stored in BBDB in the field `anniversary' -;; in the format +;; To add an anniversary to a BBDB record, press `C-o' in the record. +;; You will be prompted for the field name, in this case it must be +;; "anniversary". If this is the first time you are using this field, +;; you need to confirm that it should be created. ;; -;; YYYY-MM-DD{ CLASS-OR-FORMAT-STRING}* -;; {\nYYYY-MM-DD CLASS-OR-FORMAT-STRING}* +;; The format of an anniversary field stored in BBDB is the following +;; (items in {} are optional): +;; +;; YYYY-MM-DD{ CLASS-OR-FORMAT-STRING} +;; {\nYYYY-MM-DD CLASS-OR-FORMAT-STRING}... ;; ;; CLASS-OR-FORMAT-STRING is one of two things: ;; -;; * an identifier for a class of anniversaries (eg. birthday or -;; wedding) from `org-bbdb-anniversary-format-alist'. -;; * the (format) string displayed in the diary. +;; - an identifier for a class of anniversaries (eg. birthday or +;; wedding) from `org-bbdb-anniversary-format-alist' which then +;; defines the format tring for this class +;; - the (format) string displayed in the diary. +;; +;; You can enter multiple anniversaries for a single BBDB record by +;; separating them with a newline character. At the BBDB prompt for +;; the field value, type `C-q C-j' to enter a newline between two +;; anniversaries. ;; -;; It defaults to the value of `org-bbdb-default-anniversary-format' -;; ("birthday" by default). +;; If you omit the CLASS-OR-FORMAT-STRING entirely, it defaults to the +;; value of `org-bbdb-default-anniversary-format' ("birthday" by +;; default). ;; ;; The substitutions in the format string are (in order): -;; * the name of the record containing this anniversary -;; * the number of years -;; * an ordinal suffix (st, nd, rd, th) for the year +;; - the name of the record containing this anniversary +;; - the number of years +;; - an ordinal suffix (st, nd, rd, th) for the year ;; ;; See the documentation of `org-bbdb-anniversary-format-alist' for ;; further options. @@ -94,12 +106,15 @@ (declare-function bbdb-current-record "ext:bbdb-com" (&optional planning-on-modifying)) (declare-function bbdb-name "ext:bbdb-com" (string elidep)) +(declare-function bbdb-completing-read-record "ext:bbdb-com" + (prompt &optional omit-records)) (declare-function bbdb-record-getprop "ext:bbdb" (record property)) (declare-function bbdb-record-name "ext:bbdb" (record)) (declare-function bbdb-records "ext:bbdb" (&optional dont-check-disk already-in-db-buffer)) (declare-function bbdb-split "ext:bbdb" (string separators)) (declare-function bbdb-string-trim "ext:bbdb" (string)) + (declare-function calendar-leap-year-p "calendar" (year)) (declare-function diary-ordinal-suffix "diary-lib" (n)) @@ -326,6 +341,45 @@ This is used by Org to re-create the anniversary hash table." (when text (mapconcat 'identity text "; ")))) +(defun org-bbdb-complete-link () + "Read a bbdb link with name completion." + (require 'bbdb-com) + (concat "bbdb:" + (bbdb-record-name (car (bbdb-completing-read-record "Name: "))))) + +(defun org-bbdb-anniv-export-ical () + "Extract anniversaries from BBDB and convert them to icalendar format." + (require 'bbdb) + (require 'diary-lib) + (unless (hash-table-p org-bbdb-anniv-hash) + (setq org-bbdb-anniv-hash + (make-hash-table :test 'equal :size 366))) + (when (or org-bbdb-updated-p + (= 0 (hash-table-count org-bbdb-anniv-hash))) + (org-bbdb-make-anniv-hash)) + (maphash 'org-bbdb-format-vevent org-bbdb-anniv-hash)) + +(defun org-bbdb-format-vevent (key recs) + (let (rec categ) + (while (setq rec (pop recs)) + (setq categ (or (nth 2 rec) org-bbdb-default-anniversary-format)) + (princ (format "BEGIN:VEVENT +UID: ANNIV-%4i%02i%02i-%s +DTSTART:%4i%02i%02i +SUMMARY:%s +DESCRIPTION:%s +CATEGORIES:%s +RRULE:FREQ=YEARLY +END:VEVENT\n" + (nth 0 rec) (nth 0 key) (nth 1 key) + (mapconcat 'identity + (org-split-string (nth 1 rec) "[^a-zA-Z0-90]+") + "-") + (nth 0 rec) (nth 0 key) (nth 1 key) + (nth 1 rec) + (concat (capitalize categ) " " (nth 1 rec)) + categ))))) + (provide 'org-bbdb) ;; arch-tag: 9e4f275d-d080-48c1-b040-62247f66b5c2 diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index eb65e2a8803..6bdc1ce1236 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 0a0f8d0292a..4b96dae101b 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -41,22 +41,28 @@ :tag "Org Clock" :group 'org-progress) -(defcustom org-clock-into-drawer 2 +(defcustom org-clock-into-drawer org-log-into-drawer "Should clocking info be wrapped into a drawer? -When t, clocking info will always be inserted into a :CLOCK: drawer. +When t, clocking info will always be inserted into a :LOGBOOK: drawer. If necessary, the drawer will be created. When nil, the drawer will not be created, but used when present. When an integer and the number of clocking entries in an item -reaches or exceeds this number, a drawer will be created." +reaches or exceeds this number, a drawer will be created. +When a string, it names the drawer to be used. + +The default for this variable is the value of `org-log-into-drawer', +which see." :group 'org-todo :group 'org-clock :type '(choice (const :tag "Always" t) (const :tag "Only when drawer exists" nil) - (integer :tag "When at least N clock entries"))) + (integer :tag "When at least N clock entries") + (const :tag "Into LOGBOOK drawer" "LOGBOOK") + (string :tag "Into Drawer named..."))) (defcustom org-clock-out-when-done t - "When non-nil, the clock will be stopped when the relevant entry is marked DONE. + "When non-nil, clock will be stopped when the clocked entry is marked DONE. A nil value means, clock will keep running until stopped explicitly with `C-c C-x C-o', or until the clock is started in a different item." :group 'org-clock @@ -80,11 +86,29 @@ state to switch it to." (string :tag "State") (symbol :tag "Function"))) +(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 +parameter (the current TODO state of the item) and return the +state to switch it to." + :group 'org-clock + :group 'org-todo + :type '(choice + (const :tag "Don't force a state" nil) + (string :tag "State") + (symbol :tag "Function"))) + (defcustom org-clock-history-length 5 "Number of clock tasks to remember in history." :group 'org-clock :type 'integer) +(defcustom org-clock-goto-may-find-recent-task t + "Non-nil means, `org-clock-goto' can go to recent task if no active clock." + :group 'org-clock + :type 'boolean) + (defcustom org-clock-heading-function nil "When non-nil, should be a function to create `org-clock-heading'. This is the string shown in the mode line when a clock is running. @@ -93,26 +117,28 @@ 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) (defcustom org-clock-in-resume nil - "If non-nil, when clocking into a task with a clock entry which -has not been closed, resume the clock from that point" + "If non-nil, resume clock when clocking into task with open clock. +When clocking into a task with a clock entry which has not been closed, +the clock can be resumed from that point." :group 'org-clock :type 'boolean) (defcustom org-clock-persist nil - "When non-nil, save the running clock when emacs is closed, and - resume it next time emacs is started. + "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. When Emacs restarts with saved clock information, the file containing the running clock as well as all files mentioned in the clock history will -be visited." +be visited. +All this depends on running `org-clock-persistence-insinuate' in .emacs" :group 'org-clock :type '(choice (const :tag "Just the running clock" clock) @@ -121,21 +147,75 @@ be visited." (defcustom org-clock-persist-file (convert-standard-filename "~/.emacs.d/org-clock-save.el") - "File to save clock data to" + "File to save clock data to." :group 'org-clock :type 'string) (defcustom org-clock-persist-query-save nil - "When non-nil, ask before saving the current clock on exit" + "When non-nil, ask before saving the current clock on exit." :group 'org-clock :type 'boolean) (defcustom org-clock-persist-query-resume t - "When non-nil, ask before resuming any stored clock during -load." + "When non-nil, ask before resuming any stored clock during load." :group 'org-clock :type 'boolean) +(defcustom org-clock-sound nil + "Sound that will used for notifications. +Possible values: + +nil no sound played. +t standard Emacs beep +file name play this sound file. If not possible, fall back to beep" + :group 'org-clock + :type '(choice + (const :tag "No sound" nil) + (const :tag "Standard beep" t) + (file :tag "Play sound file"))) + +(defcustom org-clock-modeline-total 'auto + "Default setting for the time included for the modeline clock. +This can be overruled locally using the CLOCK_MODELINE_TOTAL property. +Allowed values are: + +current Only the time in the current instance of the clock +today All time clocked inot this task today +repeat All time clocked into this task since last repeat +all All time ever recorded for this task +auto Automtically, either `all', or `repeat' for repeating tasks" + :group 'org-clock + :type '(choice + (const :tag "Current clock" current) + (const :tag "Today's task time" today) + (const :tag "Since last repeat" repeat) + (const :tag "All task time" all) + (const :tag "Automatically, `all' or since `repeat'" auto))) + +(defcustom org-show-notification-handler nil + "Function or program to send notification with. +The function or program will be called with the notification +string as argument." + :group 'org-clock + :type '(choice + (string :tag "Program") + (function :tag "Function"))) + +(defvar org-clock-in-prepare-hook nil + "Hook run when preparing the clock. +This hook is run before anything happens to the task that +you want to clock in. For example, you can use this hook +to add an effort property.") +(defvar org-clock-in-hook nil + "Hook run when starting the clock.") +(defvar org-clock-out-hook nil + "Hook run when stopping the current clock.") + +(defvar org-clock-cancel-hook nil + "Hook run when cancelling the current clock.") +(defvar org-clock-goto-hook nil + "Hook run when selecting the currently clocked-in entry.") + ;;; The clock for measuring work time. (defvar org-mode-line-string "") @@ -146,6 +226,13 @@ load." (defvar org-clock-heading-for-remember "") (defvar org-clock-start-time "") +(defvar org-clock-effort "" + "Effort estimate of the currently clocking task") + +(defvar org-clock-total-time nil + "Holds total time, spent previously on currently clocked item. +This does not include the time in the currently running clock.") + (defvar org-clock-history nil "List of marker pointing to recent clocked tasks.") @@ -159,6 +246,16 @@ of a different task.") (defvar org-clock-mode-line-map (make-sparse-keymap)) (define-key org-clock-mode-line-map [mode-line mouse-2] 'org-clock-goto) +(define-key org-clock-mode-line-map [mode-line mouse-1] 'org-clock-menu) + +(defun org-clock-menu () + (interactive) + (popup-menu + '("Clock" + ["Clock out" org-clock-out t] + ["Change effort estimate" org-clock-modify-effort-estimate t] + ["Go to clock entry" org-clock-goto t] + ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"]))) (defun org-clock-history-push (&optional pos buffer) "Push a marker to the clock history." @@ -226,8 +323,11 @@ of a different task.") (t (error "Invalid task choice %c" rpl)))))) (defun org-clock-insert-selection-line (i marker) + "Insert a line for the clock selection menu. +And return a cons cell with the selection character integer and the marker +pointing to it." (when (marker-buffer marker) - (let (file cat task) + (let (file cat task heading prefix) (with-current-buffer (org-base-buffer (marker-buffer marker)) (save-excursion (save-restriction @@ -237,29 +337,148 @@ of a different task.") cat (or (org-get-category) (progn (org-refresh-category-properties) (org-get-category))) - task (org-get-heading 'notags))))) + heading (org-get-heading 'notags) + prefix (save-excursion + (org-back-to-heading t) + (looking-at "\\*+ ") + (match-string 0)) + task (substring + (org-fontify-like-in-org-mode + (concat prefix heading) + org-odd-levels-only) + (length prefix)))))) (when (and cat task) (insert (format "[%c] %-15s %s\n" i cat task)) (cons i marker))))) +(defun org-clock-get-clock-string () + "Form a clock-string, that will be show in the mode line. +If an effort estimate was defined for current item, use +01:30/01:50 format (clocked/estimated). +If not, show simply the clocked time like 01:50." + (let* ((clocked-time (org-clock-get-clocked-time)) + (h (floor clocked-time 60)) + (m (- clocked-time (* 60 h)))) + (if (and org-clock-effort) + (let* ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort)) + (effort-h (floor effort-in-minutes 60)) + (effort-m (- effort-in-minutes (* effort-h 60)))) + (format (concat "-[" org-time-clocksum-format "/" org-time-clocksum-format " (%s)]") + h m effort-h effort-m org-clock-heading)) + (format (concat "-[" org-time-clocksum-format " (%s)]") + h m org-clock-heading)))) + (defun org-clock-update-mode-line () - (let* ((delta (- (time-to-seconds (current-time)) - (time-to-seconds org-clock-start-time))) - (h (floor delta 3600)) - (m (floor (- delta (* 3600 h)) 60))) - (setq org-mode-line-string - (org-propertize - (let ((clock-string (format (concat "-[" org-time-clocksum-format " (%s)]") - h m org-clock-heading)) - (help-text "Org-mode clock is running. Mouse-2 to go there.")) - (if (and (> org-clock-string-limit 0) - (> (length clock-string) org-clock-string-limit)) - (org-propertize (substring clock-string 0 org-clock-string-limit) - 'help-echo (concat help-text ": " org-clock-heading)) - (org-propertize clock-string 'help-echo help-text))) - 'local-map org-clock-mode-line-map - 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight))) - (force-mode-line-update))) + (setq org-mode-line-string + (org-propertize + (let ((clock-string (org-clock-get-clock-string)) + (help-text "Org-mode clock is running.\nmouse-1 shows a menu\nmouse-2 will jump to task")) + (if (and (> org-clock-string-limit 0) + (> (length clock-string) org-clock-string-limit)) + (org-propertize (substring clock-string 0 org-clock-string-limit) + 'help-echo (concat help-text ": " org-clock-heading)) + (org-propertize clock-string 'help-echo help-text))) + 'local-map org-clock-mode-line-map + 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight) + 'face 'org-mode-line-clock)) + (if org-clock-effort (org-clock-notify-once-if-expired)) + (force-mode-line-update)) + +(defun org-clock-get-clocked-time () + "Get the clocked time for the current item in minutes. +The time returned includes the the time spent on this task in +previous clocking intervals." + (let ((currently-clocked-time + (floor (- (time-to-seconds (current-time)) + (time-to-seconds org-clock-start-time)) 60))) + (+ currently-clocked-time (or org-clock-total-time 0)))) + +(defun org-clock-modify-effort-estimate (&optional value) + "Add to or set the effort estimate of the item currently being clocked. +VALUE can be a number of minutes, or a string with forat hh:mm or mm. +WHen the strig starts with a + or a - sign, the current value of the effort +property will be changed by that amount. +This will update the \"Effort\" property of currently clocked item, and +the mode line." + (interactive) + (when (org-clock-is-active) + (let ((current org-clock-effort) sign) + (unless value + ;; Prompt user for a value or a change + (setq value + (read-string + (format "Set effort (hh:mm or mm%s): " + (if current + (format ", prefix + to add to %s" org-clock-effort) + ""))))) + (when (stringp value) + ;; 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 0)) + (setq value (org-hh:mm-string-to-minutes value)) + (if (equal ?- sign) + (setq value (- current value)) + (if (equal ?+ sign) (setq value (+ current value))))) + (setq value (max 0 value) + org-clock-effort (org-minutes-to-hh:mm-string value)) + (org-entry-put org-clock-marker "Effort" org-clock-effort) + (org-clock-update-mode-line)))) + +(defvar org-clock-notification-was-shown nil + "Shows if we have shown notification already.") + +(defun org-clock-notify-once-if-expired () + "Show notification if we spent more time than we estimated before. +Notification is shown only once." + (when (marker-buffer org-clock-marker) + (let ((effort-in-minutes (org-hh:mm-string-to-minutes org-clock-effort)) + (clocked-time (org-clock-get-clocked-time))) + (if (>= clocked-time effort-in-minutes) + (unless org-clock-notification-was-shown + (setq org-clock-notification-was-shown t) + (org-clock-play-sound) + (org-show-notification + (format "Task '%s' should be finished by now. (%s)" + org-clock-heading org-clock-effort))) + (setq org-clock-notification-was-shown nil))))) + +(defun org-show-notification (notification) + "Show notification. +Use `org-show-notification-handler' if defined, +use libnotify if available, or fall back on a message." + (cond ((functionp org-show-notification-handler) + (funcall org-show-notification-handler notification)) + ((stringp org-show-notification-handler) + (start-process "emacs-timer-notification" nil + org-show-notification-handler notification)) + ((org-program-exists "notify-send") + (start-process "emacs-timer-notification" nil + "notify-send" notification)) + ;; Maybe the handler will send a message, so only use message as + ;; a fall back option + (t (message notification)))) + +(defun org-clock-play-sound () + "Play sound as configured by `org-clock-sound'. +Use alsa's aplay tool if available." + (cond + ((not org-clock-sound)) + ((eq org-clock-sound t) (beep t) (beep t)) + ((stringp org-clock-sound) + (if (file-exists-p org-clock-sound) + (if (org-program-exists "aplay") + (start-process "org-clock-play-notification" nil + "aplay" org-clock-sound) + (condition-case nil + (play-sound-file org-clock-sound) + (error (beep t) (beep t)))))))) + +(defun org-program-exists (program-name) + "Checks whenever we can locate program and launch it." + (if (eq system-type 'gnu/linux) + (= 0 (call-process "which" nil nil nil program-name)))) (defvar org-clock-mode-line-entry nil "Information for the modeline about the running clock.") @@ -272,9 +491,10 @@ clock into. When SELECT is `C-u C-u', 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") + (setq org-clock-notification-was-shown nil) (catch 'abort (let ((interrupting (marker-buffer org-clock-marker)) - ts selected-task target-pos) + ts selected-task target-pos (msg-extra "")) (when (equal select '(4)) (setq selected-task (org-clock-select-task "Clock-in on task: ")) (if selected-task @@ -290,11 +510,10 @@ the clocking selection, associated with the letter `d'." (when (equal select '(16)) ;; Mark as default clocking task - (save-excursion - (org-back-to-heading t) - (move-marker org-clock-default-task (point)))) + (org-clock-mark-default-task)) (setq target-pos (point)) ;; we want to clock in at this location + (run-hooks 'org-clock-in-prepare-hook) (save-excursion (when (and selected-task (marker-buffer selected-task)) ;; There is a selected task, move to the correct buffer @@ -333,19 +552,22 @@ the clocking selection, associated with the letter `d'." (t "???"))) (setq org-clock-heading (org-propertize org-clock-heading 'face nil)) - (org-clock-find-position) + (org-clock-find-position org-clock-in-resume) (cond ((and org-clock-in-resume (looking-at - (concat "^[ \\t]* " org-clock-string + (concat "^[ \t]* " org-clock-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" - " +\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) + " +\\sw+\.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) (message "Matched %s" (match-string 1)) (setq ts (concat "[" (match-string 1) "]")) (goto-char (match-end 1)) (setq org-clock-start-time (apply 'encode-time - (org-parse-time-string (match-string 1))))) + (org-parse-time-string (match-string 1)))) + (setq org-clock-effort (org-get-effort)) + (setq org-clock-total-time (org-clock-sum-current-item + (org-clock-get-sum-start)))) ((eq org-clock-in-resume 'auto-restart) ;; called from org-clock-load during startup, ;; do not interrupt, but warn! @@ -354,11 +576,21 @@ the clocking selection, associated with the letter `d'." (sit-for 2) (throw 'abort nil)) (t - (insert "\n") (backward-char 1) + (insert-before-markers "\n") + (backward-char 1) (org-indent-line-function) + (when (and (save-excursion + (end-of-line 0) + (org-in-item-p))) + (beginning-of-line 1) + (org-indent-line-to (- (org-get-indentation) 2))) (insert org-clock-string " ") + (setq org-clock-effort (org-get-effort)) + (setq org-clock-total-time (org-clock-sum-current-item + (org-clock-get-sum-start))) (setq org-clock-start-time (current-time)) - (setq ts (org-insert-time-stamp org-clock-start-time 'with-hm 'inactive)))) + (setq ts (org-insert-time-stamp org-clock-start-time + 'with-hm 'inactive)))) (move-marker org-clock-marker (point) (buffer-base-buffer)) (or global-mode-string (setq global-mode-string '(""))) (or (memq 'org-mode-line-string global-mode-string) @@ -367,10 +599,56 @@ the clocking selection, associated with the letter `d'." (org-clock-update-mode-line) (setq org-clock-mode-line-timer (run-with-timer 60 60 'org-clock-update-mode-line)) - (message "Clock started at %s" ts))))))) + (message "Clock starts at %s - %s" ts msg-extra) + (run-hooks 'org-clock-in-hook))))))) -(defun org-clock-find-position () - "Find the location where the next clock line should be inserted." +(defun org-clock-mark-default-task () + "Mark current task as default task." + (interactive) + (save-excursion + (org-back-to-heading t) + (move-marker org-clock-default-task (point)))) + +(defvar msg-extra) +(defun org-clock-get-sum-start () + "Return the time from which clock times should be counted. +This is for the currently running clock as it is displayed +in the mode line. This function looks at the properties +LAST_REPEAT and in particular CLOCK_MODELINE_TOTAL and the +corresponding variable `org-clock-modeline-total' and then +decides which time to use." + (let ((cmt (or (org-entry-get nil "CLOCK_MODELINE_TOTAL") + (symbol-name org-clock-modeline-total))) + (lr (org-entry-get nil "LAST_REPEAT"))) + (cond + ((equal cmt "current") + (setq msg-extra "showing time in current clock instance") + (current-time)) + ((equal cmt "today") + (setq msg-extra "showing today's task time.") + (let* ((dt (decode-time (current-time)))) + (setq dt (append (list 0 0 0) (nthcdr 3 dt))) + (if org-extend-today-until + (setf (nth 2 dt) org-extend-today-until)) + (apply 'encode-time dt))) + ((or (equal cmt "all") + (and (or (not cmt) (equal cmt "auto")) + (not lr))) + (setq msg-extra "showing entire task time.") + nil) + ((or (equal cmt "repeat") + (and (or (not cmt) (equal cmt "auto")) + lr)) + (setq msg-extra "showing task time since last repeat.") + (if (not lr) + nil + (org-time-string-to-time lr))) + (t nil)))) + +(defun org-clock-find-position (find-unclosed) + "Find the location where the next clock line should be inserted. +When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock +line and position cursor in that line." (org-back-to-heading t) (catch 'exit (let ((beg (save-excursion @@ -380,12 +658,25 @@ the clocking selection, associated with the letter `d'." (end (progn (outline-next-heading) (point))) (re (concat "^[ \t]*" org-clock-string)) (cnt 0) - first last) + (drawer (if (stringp org-clock-into-drawer) + org-clock-into-drawer "LOGBOOK")) + first last ind-last) (goto-char beg) + (when (and find-unclosed + (re-search-forward + (concat "^[ \t]* " org-clock-string + " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" + " +\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$") + end t)) + (beginning-of-line 1) + (throw 'exit t)) (when (eobp) (newline) (setq end (max (point) end))) - (when (re-search-forward "^[ \t]*:CLOCK:" end t) + (when (re-search-forward (concat "^[ \t]*:" drawer ":") end t) ;; we seem to have a CLOCK drawer, so go there. (beginning-of-line 2) + (or org-log-states-order-reversed + (and (re-search-forward org-property-end-re nil t) + (goto-char (match-beginning 0)))) (throw 'exit t)) ;; Lets count the CLOCK lines (goto-char beg) @@ -394,20 +685,27 @@ the clocking selection, associated with the letter `d'." last (match-beginning 0) cnt (1+ cnt))) (when (and (integerp org-clock-into-drawer) + last (>= (1+ cnt) org-clock-into-drawer)) ;; Wrap current entries into a new drawer (goto-char last) + (setq ind-last (org-get-indentation)) (beginning-of-line 2) - (if (org-at-item-p) (org-end-of-item)) + (if (and (>= (org-get-indentation) ind-last) + (org-at-item-p)) + (org-end-of-item)) (insert ":END:\n") (beginning-of-line 0) - (org-indent-line-function) + (org-indent-line-to ind-last) (goto-char first) - (insert ":CLOCK:\n") + (insert ":" drawer ":\n") (beginning-of-line 0) (org-indent-line-function) (org-flag-drawer t) (beginning-of-line 2) + (or org-log-states-order-reversed + (and (re-search-forward org-property-end-re nil t) + (goto-char (match-beginning 0)))) (throw 'exit nil)) (goto-char beg) @@ -416,62 +714,84 @@ the clocking selection, associated with the letter `d'." ;; Planning info, skip to after it (beginning-of-line 2) (or (bolp) (newline))) - (when (eq t org-clock-into-drawer) - (insert ":CLOCK:\n:END:\n") - (beginning-of-line 0) + (when (or (eq org-clock-into-drawer t) + (stringp org-clock-into-drawer) + (and (integerp org-clock-into-drawer) + (< org-clock-into-drawer 2))) + (insert ":" drawer ":\n:END:\n") + (beginning-of-line -1) (org-indent-line-function) - (beginning-of-line 0) (org-flag-drawer t) + (beginning-of-line 2) (org-indent-line-function) - (beginning-of-line 2))))) + (beginning-of-line) + (or org-log-states-order-reversed + (and (re-search-forward org-property-end-re nil t) + (goto-char (match-beginning 0)))))))) (defun org-clock-out (&optional fail-quietly) "Stop the currently running clock. If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (interactive) (catch 'exit - (if (not (marker-buffer org-clock-marker)) - (if fail-quietly (throw 'exit t) (error "No active clock"))) - (let (ts te s h m remove) - (save-excursion - (set-buffer (marker-buffer org-clock-marker)) - (save-restriction - (widen) - (goto-char org-clock-marker) - (beginning-of-line 1) - (if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) - (equal (match-string 1) org-clock-string)) - (setq ts (match-string 2)) - (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) - (goto-char (match-end 0)) - (delete-region (point) (point-at-eol)) - (insert "--") - (setq te (org-insert-time-stamp (current-time) 'with-hm 'inactive)) - (setq s (- (time-to-seconds (apply 'encode-time (org-parse-time-string te))) - (time-to-seconds (apply 'encode-time (org-parse-time-string ts)))) - h (floor (/ s 3600)) - s (- s (* 3600 h)) - m (floor (/ s 60)) - s (- s (* 60 s))) - (insert " => " (format "%2d:%02d" h m)) - (when (setq remove (and org-clock-out-remove-zero-time-clocks - (= (+ h m) 0))) + (if (not (marker-buffer org-clock-marker)) + (if fail-quietly (throw 'exit t) (error "No active clock"))) + (let (ts te s h m remove) + (save-excursion + (set-buffer (marker-buffer org-clock-marker)) + (save-restriction + (widen) + (goto-char org-clock-marker) (beginning-of-line 1) + (if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) + (equal (match-string 1) org-clock-string)) + (setq ts (match-string 2)) + (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) + (goto-char (match-end 0)) (delete-region (point) (point-at-eol)) - (and (looking-at "\n") (> (point-max) (1+ (point))) - (delete-char 1))) - (move-marker org-clock-marker nil) - (when org-log-note-clock-out - (org-add-log-setup 'clock-out nil nil nil - (concat "# Task: " (org-get-heading t) "\n\n"))) - (when org-clock-mode-line-timer - (cancel-timer org-clock-mode-line-timer) - (setq org-clock-mode-line-timer nil)) - (setq global-mode-string - (delq 'org-mode-line-string global-mode-string)) - (force-mode-line-update) - (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m - (if remove " => LINE REMOVED" ""))))))) + (insert "--") + (setq te (org-insert-time-stamp (current-time) 'with-hm 'inactive)) + (setq s (- (time-to-seconds (apply 'encode-time (org-parse-time-string te))) + (time-to-seconds (apply 'encode-time (org-parse-time-string ts)))) + h (floor (/ s 3600)) + s (- s (* 3600 h)) + m (floor (/ s 60)) + s (- s (* 60 s))) + (insert " => " (format "%2d:%02d" h m)) + (when (setq remove (and org-clock-out-remove-zero-time-clocks + (= (+ h m) 0))) + (beginning-of-line 1) + (delete-region (point) (point-at-eol)) + (and (looking-at "\n") (> (point-max) (1+ (point))) + (delete-char 1))) + (move-marker org-clock-marker nil) + (when org-log-note-clock-out + (org-add-log-setup 'clock-out nil nil nil nil + (concat "# Task: " (org-get-heading t) "\n\n"))) + (when org-clock-mode-line-timer + (cancel-timer org-clock-mode-line-timer) + (setq org-clock-mode-line-timer nil)) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (when org-clock-out-switch-to-state + (save-excursion + (org-back-to-heading t) + (let ((org-inhibit-logging t)) + (cond + ((functionp org-clock-out-switch-to-state) + (looking-at org-complex-heading-regexp) + (let ((newstate (funcall org-clock-out-switch-to-state + (match-string 2)))) + (if newstate (org-todo newstate)))) + ((and org-clock-out-switch-to-state + (not (looking-at (concat outline-regexp "[ \t]*" + org-clock-out-switch-to-state + "\\>")))) + (org-todo org-clock-out-switch-to-state)))))) + (force-mode-line-update) + (message (concat "Clock stopped at %s after HH:MM = " org-time-clocksum-format "%s") te h m + (if remove " => LINE REMOVED" "")) + (run-hooks 'org-clock-out-hook)))))) (defun org-clock-cancel () "Cancel the running clock be removing the start timestamp." @@ -485,34 +805,44 @@ If there is no running clock, throw an error, unless FAIL-QUIETLY is set." (setq global-mode-string (delq 'org-mode-line-string global-mode-string)) (force-mode-line-update) - (message "Clock canceled")) + (message "Clock canceled") + (run-hooks 'org-clock-cancel-hook)) (defun org-clock-goto (&optional select) - "Go to the currently clocked-in entry. -With prefix arg SELECT, offer recently clocked tasks." - (interactive "P") - (let ((m (if select - (org-clock-select-task "Select task to go to: ") - org-clock-marker))) - (if (not (marker-buffer m)) - (if select - (error "No task selected") - (error "No active clock"))) + "Go to the currently clocked-in entry, or to the most recently clocked one. +With prefix arg SELECT, offer recently clocked tasks for selection." + (interactive "@P") + (let* ((recent nil) + (m (cond + (select + (or (org-clock-select-task "Select task to go to: ") + (error "No task selected"))) + ((marker-buffer org-clock-marker) org-clock-marker) + ((and org-clock-goto-may-find-recent-task + (car org-clock-history) + (marker-buffer (car org-clock-history))) + (setq recent t) + (car org-clock-history)) + (t (error "No active or recent clock task"))))) (switch-to-buffer (marker-buffer m)) (if (or (< m (point-min)) (> m (point-max))) (widen)) (goto-char m) (org-show-entry) - (org-back-to-heading) + (org-back-to-heading t) (org-cycle-hide-drawers 'children) - (recenter))) + (recenter) + (if recent + (message "No running clock, this is the most recently clocked task")) + (run-hooks 'org-clock-goto-hook))) (defvar org-clock-file-total-minutes nil "Holds the file total time in minutes, after a call to `org-clock-sum'.") - (make-variable-buffer-local 'org-clock-file-total-minutes) +(make-variable-buffer-local 'org-clock-file-total-minutes) (defun org-clock-sum (&optional tstart tend) "Sum the times for each subtree. -Puts the resulting times in minutes as a text property on each headline." +Puts the resulting times in minutes as a text property on each headline. +TSTART and TEND can mark a time range to be considered." (interactive) (let* ((bmp (buffer-modified-p)) (re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" @@ -524,6 +854,10 @@ Puts the resulting times in minutes as a text property on each headline." (level 0) ts te dt time) + (if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart))) + (if (stringp tend) (setq tend (org-time-string-to-seconds tend))) + (if (consp tstart) (setq tstart (time-to-seconds tstart))) + (if (consp tend) (setq tend (time-to-seconds tend))) (remove-text-properties (point-min) (point-max) '(:org-clock-minutes t)) (save-excursion (goto-char (point-max)) @@ -558,6 +892,14 @@ Puts the resulting times in minutes as a text property on each headline." (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" + (save-excursion + (save-restriction + (org-narrow-to-subtree) + (org-clock-sum tstart) + org-clock-file-total-minutes))) + (defun org-clock-display (&optional total-only) "Show subtree times in the entire buffer. If TOTAL-ONLY is non-nil, only show the total time for the entire file @@ -633,7 +975,10 @@ This is used to stop the clock after a TODO entry is marked DONE, and is only done if the variable `org-clock-out-when-done' is not nil." (when (and org-clock-out-when-done (member state org-done-keywords) - (equal (marker-buffer org-clock-marker) (current-buffer)) + (equal (or (buffer-base-buffer (marker-buffer org-clock-marker)) + (marker-buffer org-clock-marker)) + (or (buffer-base-buffer (current-buffer)) + (current-buffer))) (< (point) org-clock-marker) (> (save-excursion (outline-next-heading) (point)) org-clock-marker)) @@ -801,7 +1146,7 @@ the currently selected interval size." ((string-match "\\([0-9]+\\)\\(-\\([wW]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) ;; 1 1 2 3 3 4 4 5 6 6 5 2 (setq y (string-to-number (match-string 1 s)) - wp (and (match-end 3) (match-string 3 s)) + wp (and (match-end 3) (match-string 3 s)) mw (and (match-end 4) (string-to-number (match-string 4 s))) d (and (match-end 6) (string-to-number (match-string 6 s)))) (cond @@ -842,11 +1187,12 @@ the currently selected interval size." (maxlevel (or (plist-get params :maxlevel) 3)) (step (plist-get params :step)) (emph (plist-get params :emphasize)) + (timestamp (plist-get params :timestamp)) (ts (plist-get params :tstart)) (te (plist-get params :tend)) (block (plist-get params :block)) (link (plist-get params :link)) - ipos time p level hlc hdl content recalc formula pcol + 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) (when step @@ -951,10 +1297,18 @@ the currently selected interval size." (save-match-data (org-make-org-heading-search-string (match-string 2)))) - (match-string 2)))) + (match-string 2))) + tsp (when timestamp + (setq props (org-entry-properties (point))) + (or (cdr (assoc "SCHEDULED" props)) + (cdr (assoc "TIMESTAMP" props)) + (cdr (assoc "DEADLINE" props)) + (cdr (assoc "TIMESTAMP_IA" props))))) (if (and (not multifile) (= level 1)) (push "|-" tbl)) (push (concat - "| " (int-to-string level) "|" hlc hdl hlc " |" + "| " (int-to-string level) "|" + (if timestamp (concat tsp "|") "") + hlc hdl hlc " |" (make-string (1- level) ?|) hlc (org-minutes-to-hh:mm-string time) hlc " |") tbl)))))) @@ -973,12 +1327,12 @@ the currently selected interval size." (if block (concat ", for " range-text ".") "") "\n\n")) (if scope-is-list "|File" "") - "|L|Headline|Time|\n") + "|L|" (if timestamp "Timestamp|" "") "Headline|Time|\n") (setq total-time (or total-time org-clock-file-total-minutes)) (insert-before-markers "|-\n|" (if scope-is-list "|" "") - "|" + (if timestamp "|Timestamp|" "|") "*Total time*| *" (org-minutes-to-hh:mm-string (or total-time 0)) "*|\n|-\n") @@ -1009,7 +1363,7 @@ the currently selected interval size." (t (error "invalid formula in clocktable"))) ;; Should we rescue an old formula? (when (stringp (setq content (plist-get params :content))) - (when (string-match "^\\(#\\+TBLFM:.*\\)" content) + (when (string-match "^\\([ \t]*#\\+TBLFM:.*\\)" content) (setq recalc t) (insert "\n" (match-string 1 (plist-get params :content))) (beginning-of-line 0)))) @@ -1046,10 +1400,10 @@ the currently selected interval size." (while (< ts te) (or (bolp) (insert "\n")) (setq p1 (plist-put p1 :tstart (format-time-string - (car org-time-stamp-formats) + (org-time-stamp-format nil t) (seconds-to-time ts)))) (setq p1 (plist-put p1 :tend (format-time-string - (car org-time-stamp-formats) + (org-time-stamp-format nil t) (seconds-to-time (setq ts (+ ts step)))))) (insert "\n" (if (eq step0 'day) "Daily report: " "Weekly report starting on: ") (plist-get p1 :tstart) "\n") @@ -1139,8 +1493,7 @@ The details of what will be saved are regulated by the variable "Was the clock file loaded?") (defun org-clock-load () - "Load various clock-related data from disk, optionally resuming -a stored clock" + "Load clock-related data from disk, maybe resuming a stored clock." (when (and org-clock-persist (not org-clock-loaded)) (let ((filename (expand-file-name org-clock-persist-file)) (org-clock-in-resume 'auto-restart) @@ -1186,6 +1539,9 @@ a stored clock" (add-hook 'org-mode-hook 'org-clock-load) (add-hook 'kill-emacs-hook 'org-clock-save)) +;; Suggested bindings +(org-defkey org-mode-map "\C-c\C-x\C-e" 'org-clock-modify-effort-estimate) + (provide 'org-clock) ;; arch-tag: 7b42c5d4-9b36-48be-97c0-66a869daed4c diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index 5a896185590..c89de339fab 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -81,8 +81,24 @@ This is the compiled version of the format.") (org-defkey org-columns-map "\M-b" 'backward-char) (org-defkey org-columns-map "a" 'org-columns-edit-allowed) (org-defkey org-columns-map "s" 'org-columns-edit-attributes) -(org-defkey org-columns-map "\M-f" (lambda () (interactive) (goto-char (1+ (point))))) -(org-defkey org-columns-map [right] (lambda () (interactive) (goto-char (1+ (point))))) +(org-defkey org-columns-map "\M-f" + (lambda () (interactive) (goto-char (1+ (point))))) +(org-defkey org-columns-map [right] + (lambda () (interactive) (goto-char (1+ (point))))) +(org-defkey org-columns-map [down] + (lambda () (interactive) + (let ((col (current-column))) + (beginning-of-line 2) + (while (and (org-invisible-p2) (not (eobp))) + (beginning-of-line 2)) + (move-to-column col)))) +(org-defkey org-columns-map [up] + (lambda () (interactive) + (let ((col (current-column))) + (beginning-of-line 0) + (while (and (org-invisible-p2) (not (bobp))) + (beginning-of-line 0)) + (move-to-column col)))) (org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value) (org-defkey org-columns-map "n" 'org-columns-next-allowed-value) (org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value) @@ -279,6 +295,9 @@ for the duration of the command.") org-columns-previous-hscroll (window-hscroll)) (force-mode-line-update))) +(defvar org-colview-initial-truncate-line-value nil + "Remember the value of `truncate-lines' across colview.") + (defun org-columns-remove-overlays () "Remove all currently active column overlays." (interactive) @@ -296,7 +315,9 @@ for the duration of the command.") (let ((inhibit-read-only t)) (remove-text-properties (point-min) (point-max) '(read-only t)))) (when org-columns-flyspell-was-active - (flyspell-mode 1))))) + (flyspell-mode 1)) + (when (local-variable-p 'org-colview-initial-truncate-line-value) + (setq truncate-lines org-colview-initial-truncate-line-value))))) (defun org-columns-cleanup-item (item fmt) "Remove from ITEM what is a column in the format FMT." @@ -404,8 +425,9 @@ Where possible, use the standard interface for changing this line." (setq eval '(org-with-point-at pom (org-edit-headline)))) ((equal key "TODO") - (setq eval '(org-with-point-at pom - (call-interactively 'org-todo)))) + (setq eval '(org-with-point-at + pom + (call-interactively 'org-todo)))) ((equal key "PRIORITY") (setq eval '(org-with-point-at pom (call-interactively 'org-priority)))) @@ -656,7 +678,10 @@ around it." (narrow-to-region beg end) (org-clock-sum)))) (while (re-search-forward (concat "^" outline-regexp) end t) - (push (cons (org-current-line) (org-entry-properties)) cache)) + (if (and org-columns-skip-arrchived-trees + (looking-at (concat ".*:" org-archive-tag ":"))) + (org-end-of-subtree t) + (push (cons (org-current-line) (org-entry-properties)) cache))) (when cache (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) (org-set-local 'org-columns-current-maxwidths maxwidths) @@ -664,12 +689,34 @@ around it." (when (org-set-local 'org-columns-flyspell-was-active (org-bound-and-true-p flyspell-mode)) (flyspell-mode 0)) + (unless (local-variable-p 'org-colview-initial-truncate-line-value) + (org-set-local 'org-colview-initial-truncate-line-value + truncate-lines)) + (setq truncate-lines t) (mapc (lambda (x) (goto-line (car x)) (org-columns-display-here (cdr x))) cache))))) -(defun org-columns-new (&optional prop title width op fmt &rest rest) +(defvar org-columns-compile-map + '(("none" none +) + (":" add_times +) + ("+" add_numbers +) + ("$" currency +) + ("X" checkbox +) + ("X/" checkbox-n-of-m +) + ("X%" checkbox-percent +) + ("max" max_numbers max) + ("min" min_numbers min) + ("mean" mean_numbers (lambda (&rest x) (/ (apply '+ x) (float (length x))))) + (":max" max_times max) + (":min" min_times min) + (":mean" mean_times (lambda (&rest x) (/ (apply '+ x) (float (length x)))))) + "Operator <-> format,function map. +Used to compile/uncompile columns format and completing read in +interactive function org-columns-new.") + +(defun org-columns-new (&optional prop title width op fmt fun &rest rest) "Insert a new column, to the left of the current column." (interactive) (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled))) @@ -682,20 +729,21 @@ around it." (if (string-match "\\S-" width) (setq width (string-to-number width)) (setq width nil)) - (setq fmt (org-ido-completing-read "Summary [none]: " - '(("none") ("add_numbers") ("currency") ("add_times") ("checkbox") ("checkbox-n-of-m") ("checkbox-percent")) - nil t)) - (if (string-match "\\S-" fmt) - (setq fmt (intern fmt)) - (setq fmt nil)) + (setq fmt (org-ido-completing-read + "Summary [none]: " + (mapcar (lambda (x) (list (symbol-name (cadr x)))) + org-columns-compile-map) + nil t)) + (setq fmt (intern fmt) + fun (cadr (assoc fmt (mapcar 'cdr org-columns-compile-map)))) (if (eq fmt 'none) (setq fmt nil)) (if editp (progn (setcar editp prop) - (setcdr editp (list title width nil fmt))) + (setcdr editp (list title width nil fmt nil fun))) (setq cell (nthcdr (1- (current-column)) org-columns-current-fmt-compiled)) - (setcdr cell (cons (list prop title width nil fmt) + (setcdr cell (cons (list prop title width nil fmt nil fun) (cdr cell)))) (org-columns-store-format) (org-columns-redo))) @@ -840,12 +888,13 @@ Don't set this, this is meant for dynamic scoping.") (interactive) (let* ((re (concat "^" outline-regexp)) (lmax 30) ; Does anyone use deeper levels??? - (lsum (make-vector lmax 0)) + (lvals (make-vector lmax nil)) (lflag (make-vector lmax nil)) (level 0) (ass (assoc property org-columns-current-fmt-compiled)) (format (nth 4 ass)) (printf (nth 5 ass)) + (fun (nth 6 ass)) (beg org-columns-top-level-marker) last-level val valflag flag end sumpos sum-alist sum str str1 useval) (save-excursion @@ -863,7 +912,8 @@ Don't set this, this is meant for dynamic scoping.") (cond ((< level last-level) ;; put the sum of lower levels here as a property - (setq sum (aref lsum last-level) ; current sum + (setq sum (when (aref lvals last-level) + (apply fun (aref lvals last-level))) flag (aref lflag last-level) ; any valid entries from children? str (org-columns-number-to-string sum format printf) str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) @@ -879,19 +929,20 @@ Don't set this, this is meant for dynamic scoping.") (org-entry-put nil property (if flag str val))) ;; add current to current level accumulator (when (or flag valflag) - (aset lsum level (+ (aref lsum level) - (if flag sum (org-column-string-to-number - (if flag str val) format)))) + (push (if flag sum + (org-column-string-to-number (if flag str val) format)) + (aref lvals level)) (aset lflag level t)) ;; clear accumulators for deeper levels (loop for l from (1+ level) to (1- lmax) do - (aset lsum l 0) + (aset lvals l nil) (aset lflag l nil))) ((>= level last-level) ;; add what we have here to the accumulator for this level - (aset lsum level (+ (aref lsum level) - (org-column-string-to-number (or val "0") format))) - (and valflag (aset lflag level t))) + (when valflag + (push (org-column-string-to-number val format) + (aref lvals level)) + (aset lflag level t))) (t (error "This should not happen"))))))) (defun org-columns-redo () @@ -929,7 +980,8 @@ Don't set this, this is meant for dynamic scoping.") (defun org-columns-number-to-string (n fmt &optional printf) "Convert a computed column number to a string value, according to FMT." (cond - ((eq fmt 'add_times) + ((not (numberp n)) "") + ((memq fmt '(add_times max_times min_times mean_times)) (let* ((h (floor n)) (m (floor (+ 0.5 (* 60 (- n h)))))) (format org-time-clocksum-format h m))) ((eq fmt 'checkbox) @@ -963,21 +1015,17 @@ Don't set this, this is meant for dynamic scoping.") (defun org-columns-uncompile-format (cfmt) "Turn the compiled columns format back into a string representation." - (let ((rtn "") e s prop title op width fmt printf) + (let ((rtn "") e s prop title op op-match width fmt printf) (while (setq e (pop cfmt)) (setq prop (car e) title (nth 1 e) width (nth 2 e) op (nth 3 e) fmt (nth 4 e) - printf (nth 5 e)) - (cond - ((eq fmt 'add_times) (setq op ":")) - ((eq fmt 'checkbox) (setq op "X")) - ((eq fmt 'checkbox-n-of-m) (setq op "X/")) - ((eq fmt 'checkbox-percent) (setq op "X%")) - ((eq fmt 'add_numbers) (setq op "+")) - ((eq fmt 'currency) (setq op "$"))) + printf (nth 5 e) + fun (nth 6 e)) + (when (setq op-match (rassoc (list fmt fun) org-columns-compile-map)) + (setq op (car op-match))) (if (and op printf) (setq op (concat op ";" printf))) (if (equal title prop) (setq title nil)) (setq s (concat "%" (if width (number-to-string width)) @@ -996,8 +1044,9 @@ title the title field for the columns width the column width in characters, can be nil for automatic operator the operator if any format the output format for computed results, derived from operator -printf a printf format for computed values" - (let ((start 0) width prop title op f printf) +printf a printf format for computed values +fun the lisp function to compute values, derived from operator" + (let ((start 0) width prop title op op-match f printf fun) (setq org-columns-current-fmt-compiled nil) (while (string-match (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") @@ -1008,20 +1057,16 @@ printf a printf format for computed values" title (or (match-string 3 fmt) prop) op (match-string 4 fmt) f nil - printf nil) + printf nil + fun '+) (if width (setq width (string-to-number width))) (when (and op (string-match ";" op)) (setq printf (substring op (match-end 0)) op (substring op 0 (match-beginning 0)))) - (cond - ((equal op "+") (setq f 'add_numbers)) - ((equal op "$") (setq f 'currency)) - ((equal op ":") (setq f 'add_times)) - ((equal op "X") (setq f 'checkbox)) - ((equal op "X/") (setq f 'checkbox-n-of-m)) - ((equal op "X%") (setq f 'checkbox-percent)) - ) - (push (list prop title width op f printf) org-columns-current-fmt-compiled)) + (when (setq op-match (assoc op org-columns-compile-map)) + (setq f (cadr op-match) + fun (caddr op-match))) + (push (list prop title width op f printf fun) org-columns-current-fmt-compiled)) (setq org-columns-current-fmt-compiled (nreverse org-columns-current-fmt-compiled)))) @@ -1038,25 +1083,36 @@ containing the title row and all other rows. Each row is a list of fields." (save-excursion (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled)) + (re-comment (concat "\\*+[ \t]+" org-comment-string "\\>")) + (re-archive (concat ".*:" org-archive-tag ":")) (n (length title)) row tbl) (goto-char (point-min)) (while (re-search-forward "^\\(\\*+\\) " nil t) - (when (and (or (null maxlevel) - (>= maxlevel - (if org-odd-levels-only - (/ (1+ (length (match-string 1))) 2) - (length (match-string 1))))) - (get-char-property (match-beginning 0) 'org-columns-key)) - (setq row nil) - (loop for i from 0 to (1- n) do - (push (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified) - (get-char-property (+ (match-beginning 0) i) 'org-columns-value) - "") - row)) - (setq row (nreverse row)) - (unless (and skip-empty-rows - (eq 1 (length (delete "" (delete-dups row))))) - (push row tbl)))) + (catch 'next + (when (and (or (null maxlevel) + (>= maxlevel + (if org-odd-levels-only + (/ (1+ (length (match-string 1))) 2) + (length (match-string 1))))) + (get-char-property (match-beginning 0) 'org-columns-key)) + (when (save-excursion + (goto-char (point-at-bol)) + (or (looking-at re-comment) + (looking-at re-archive))) + (org-end-of-subtree t) + (throw 'next t)) + (setq row nil) + (loop for i from 0 to (1- n) do + (push + (org-quote-vert + (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified) + (get-char-property (+ (match-beginning 0) i) 'org-columns-value) + "")) + row)) + (setq row (nreverse row)) + (unless (and skip-empty-rows + (eq 1 (length (delete "" (delete-dups (copy-sequence row)))))) + (push row tbl))))) (append (list title 'hline) (nreverse tbl))))) (defun org-dblock-write:columnview (params) @@ -1148,7 +1204,7 @@ PARAMS is a property list of parameters: (while (setq line (pop content-lines)) (when (string-match "^#" line) (insert "\n" line) - (when (string-match "^#\\+TBLFM" line) + (when (string-match "^[ \t]*#\\+TBLFM" line) (setq recalc t)))) (if recalc (progn (goto-char pos) (org-table-recalculate 'all)) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 73d3e0c4a2b..c52c5af9b6e 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -31,8 +31,13 @@ ;;; Code: +(eval-when-compile + (require 'cl)) + (require 'org-macs) +(declare-function find-library-name "find-func" (library)) + (defconst org-xemacs-p (featurep 'xemacs)) ; not used by org.el itself (defconst org-format-transports-properties-p (let ((x "a")) @@ -43,17 +48,25 @@ (defun org-compatible-face (inherits specs) "Make a compatible face specification. If INHERITS is an existing face and if the Emacs version supports it, -just inherit the face. If not, use SPECS to define the face. +just inherit the face. If INHERITS is set and the Emacs version does +not support it, copy the face specification from the inheritance face. +If INHERITS is not given and SPECS is, use SPECS to define the face. XEmacs and Emacs 21 do not know about the `min-colors' attribute. For them we convert a (min-colors 8) entry to a `tty' entry and move it to the top of the list. The `min-colors' attribute will be removed from any other entries, and any resulting duplicates will be removed entirely." + (when (and inherits (facep inherits) (not specs)) + (setq specs (or specs + (get inherits 'saved-face) + (get inherits 'face-defface-spec)))) (cond ((and inherits (facep inherits) - (not (featurep 'xemacs)) (> emacs-major-version 22)) - ;; In Emacs 23, we use inheritance where possible. - ;; We only do this in Emacs 23, because only there the outline - ;; faces have been changed to the original org-mode-level-faces. + (not (featurep 'xemacs)) + (>= emacs-major-version 22) + ;; do not inherit outline faces before Emacs 23 + (or (>= emacs-major-version 23) + (not (string-match "\\`outline-[0-9]+" + (symbol-name inherits))))) (list (list t :inherit inherits))) ((or (featurep 'xemacs) (< emacs-major-version 22)) ;; These do not understand the `min-colors' attribute. @@ -185,6 +198,11 @@ Works on both Emacs and XEmacs." (use-region-p) (and transient-mark-mode mark-active))))) ; Emacs 22 and before +(defun org-cursor-to-region-beginning () + (when (and (org-region-active-p) + (> (point) (region-beginning))) + (exchange-point-and-mark))) + ;; Invisibility compatibility (defun org-add-to-invisibility-spec (arg) @@ -290,6 +308,16 @@ that can be added." (org-no-properties (substring string (or from 0) to)) (substring-no-properties string from to))) +(defun org-find-library-name (library) + (if (fboundp 'find-library-name) + (file-name-directory (find-library-name library)) + ; XEmacs does not have `find-library-name' + (flet ((find-library-name-helper (filename ignored-codesys) + filename) + (find-library-name (library) + (find-library library nil 'find-library-name-helper))) + (file-name-directory (find-library-name library))))) + (defun org-count-lines (s) "How many lines in string S?" (let ((start 0) (n 1)) @@ -299,6 +327,11 @@ that can be added." (setq n (1- n))) n)) +(defun org-kill-new (string &rest args) + (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t) + string) + (apply 'kill-new string args)) + (provide 'org-compat) ;; arch-tag: a0a0579f-e68c-4bdf-9e55-93768b846bbe diff --git a/lisp/org/org-docbook.el b/lisp/org/org-docbook.el new file mode 100644 index 00000000000..ec787a700bf --- /dev/null +++ b/lisp/org/org-docbook.el @@ -0,0 +1,1405 @@ +;;; org-docbook.el --- DocBook exporter for org-mode +;; +;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. +;; +;; Emacs Lisp Archive Entry +;; Filename: org-docbook.el +;; Version: 6.29c +;; Author: Baoqiu Cui <cbaoqiu AT yahoo DOT com> +;; Maintainer: Baoqiu Cui <cbaoqiu AT yahoo DOT com> +;; Keywords: org, wp, docbook +;; Description: Converts an org-mode buffer into DocBook +;; $Id: org-docbook.el 35 2009-03-23 01:03:21Z baoqiu $ +;; URL: + +;; This file is NOT part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;; Commentary: +;; +;; This library implements a DocBook exporter for org-mode. The basic +;; idea and design is very similar to what `org-export-as-html' has. +;; Code prototype was also started with `org-export-as-html'. +;; +;; Put this file into your load-path and the following line into your +;; ~/.emacs: +;; +;; (require 'org-docbook) +;; +;; The interactive functions are similar to those of the HTML and LaTeX +;; exporters: +;; +;; M-x `org-export-as-docbook' +;; M-x `org-export-as-docbook-pdf' +;; M-x `org-export-as-docbook-pdf-and-open' +;; M-x `org-export-as-docbook-batch' +;; M-x `org-export-as-docbook-to-buffer' +;; M-x `org-export-region-as-docbook' +;; M-x `org-replace-region-by-docbook' +;; +;; Note that, in order to generate PDF files using the DocBook XML files +;; created by DocBook exporter, the following two variables have to be +;; set based on what DocBook tools you use for XSLT processor and XSL-FO +;; processor: +;; +;; org-export-docbook-xslt-proc-command +;; org-export-docbook-xsl-fo-proc-command +;; +;; Check the document of these two variables to see examples of how they +;; can be set. +;; +;; If the Org file to be exported contains special characters written in +;; TeX-like syntax, like \alpha and \beta, you need to include the right +;; entity file(s) in the DOCTYPE declaration for the DocBook XML file. +;; This is required to make the DocBook XML file valid. The DOCTYPE +;; declaration string can be set using the following variable: +;; +;; org-export-docbook-doctype +;; +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'footnote) +(require 'org) +(require 'org-exp) +(require 'org-html) + +;;; Variables: + +(defvar org-docbook-para-open nil) +(defvar org-export-docbook-inline-images t) +(defvar org-export-docbook-link-org-files-as-docbook nil) + +(declare-function org-id-find-id-file "org-id" (id)) + +;;; User variables: + +(defgroup org-export-docbook nil + "Options for exporting Org-mode files to DocBook." + :tag "Org Export DocBook" + :group 'org-export) + +(defcustom org-export-docbook-extension ".xml" + "Extension of DocBook XML files." + :group 'org-export-docbook + :type 'string) + +(defcustom org-export-docbook-header "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n" + "Header of DocBook XML files." + :group 'org-export-docbook + :type 'string) + +(defcustom org-export-docbook-doctype nil + "DOCTYPE declaration string for DocBook XML files. +This can be used to include entities that are needed to handle +special characters in Org files. + +For example, if the Org file to be exported contains XHTML +entities, you can set this variable to: + +\"<!DOCTYPE article [ +<!ENTITY % xhtml1-symbol PUBLIC +\"-//W3C//ENTITIES Symbol for HTML//EN//XML\" +\"http://www.w3.org/2003/entities/2007/xhtml1-symbol.ent\" +> +%xhtml1-symbol; +]> +\" + +If you want to process DocBook documents without internet +connection, it is suggested that you download the required entity +file(s) and use system identifier(s) (external files) in the +DOCTYPE declaration." + :group 'org-export-docbook + :type 'string) + +(defcustom org-export-docbook-article-header "<article xmlns=\"http://docbook.org/ns/docbook\" + xmlns:xlink=\"http://www.w3.org/1999/xlink\" version=\"5.0\" xml:lang=\"en\">" + "Article header of DocBook XML files." + :group 'org-export-docbook + :type 'string) + +(defcustom org-export-docbook-section-id-prefix "sec-" + "Prefix of section IDs used during exporting. +This can be set before exporting to avoid same set of section IDs +being used again and again, which can be a problem when multiple +people work on the same document." + :group 'org-export-docbook + :type 'string) + +(defcustom org-export-docbook-footnote-id-prefix "fn-" + "The prefix of footnote IDs used during exporting. Like +`org-export-docbook-section-id-prefix', this variable can help +avoid same set of footnote IDs being used multiple times." + :group 'org-export-docbook + :type 'string) + +(defcustom org-export-docbook-emphasis-alist + `(("*" "<emphasis role=\"bold\">" "</emphasis>") + ("/" "<emphasis>" "</emphasis>") + ("_" "<emphasis role=\"underline\">" "</emphasis>") + ("=" "<code>" "</code>") + ("~" "<literal>" "</literal>") + ("+" "<emphasis role=\"strikethrough\">" "</emphasis>")) + "Alist 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. +The third element decides whether to protect converted text from other +conversions." + :group 'org-export-docbook + :type 'alist) + +(defcustom org-export-docbook-default-image-attributes + `(("align" . "\"center\"") + ("valign". "\"middle\"")) + "Alist of default DocBook image attributes. +These attributes will be inserted into element <imagedata> by +default, but users can override them using `#+ATTR_DocBook:'." + :group 'org-export-docbook + :type 'alist) + +(defcustom org-export-docbook-inline-image-extensions + '("jpeg" "jpg" "png" "gif" "svg") + "Extensions of image files that can be inlined into DocBook." + :group 'org-export-docbook + :type '(repeat (string :tag "Extension"))) + +(defcustom org-export-docbook-coding-system nil + "Coding system for DocBook XML files." + :group 'org-export-docbook + :type 'coding-system) + +(defcustom org-export-docbook-xslt-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. + +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. + +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\" + +If you use Xalan, you can set it to + + \"java org.apache.xalan.xslt.Process -out %s -in %s -xsl /path/to/docbook.xsl\" + +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. + +You can include additional stylesheet parameters in this command. +Just make sure that they meet the syntax requirement of each +processor." + :group 'org-export-docbook + :type 'string) + +(defcustom org-export-docbook-xsl-fo-proc-command nil + "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. + +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. + +For example, if you use FOP as the XSL-FO processor, you can set +the variable to + + \"fop %s %s\"" + :group 'org-export-docbook + :type 'string) + +(defcustom org-export-docbook-keywords-markup "<literal>%s</literal>" + "A printf format string to be applied to keywords by DocBook exporter." + :group 'org-export-docbook + :type 'string) + +(defcustom org-export-docbook-timestamp-markup "<emphasis>%s</emphasis>" + "A printf format string to be applied to time stamps by DocBook exporter." + :group 'org-export-docbook + :type 'string) + +;;; Autoload functions: + +;;;###autoload +(defun org-export-as-docbook-batch () + "Call `org-export-as-docbook' in batch style. +This function can be used in batch processing. + +For example: + +$ emacs --batch + --load=$HOME/lib/emacs/org.el + --visit=MyOrgFile.org --funcall org-export-as-docbook-batch" + (org-export-as-docbook 'hidden)) + +;;;###autoload +(defun org-export-as-docbook-to-buffer () + "Call `org-export-as-docbook' with output to a temporary buffer. +No file is created." + (interactive) + (org-export-as-docbook nil nil "*Org DocBook Export*") + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window "*Org DocBook Export*"))) + +;;;###autoload +(defun org-replace-region-by-docbook (beg end) + "Replace the region from BEG to END with its DocBook export. +It assumes the region has `org-mode' syntax, and then convert it to +DocBook. This can be used in any buffer. For example, you could +write an itemized list in `org-mode' syntax in an DocBook buffer and +then use this command to convert it." + (interactive "r") + (let (reg docbook buf) + (save-window-excursion + (if (org-mode-p) + (setq docbook (org-export-region-as-docbook + beg end t 'string)) + (setq reg (buffer-substring beg end) + buf (get-buffer-create "*Org tmp*")) + (save-excursion + (set-buffer buf) + (erase-buffer) + (insert reg) + (org-mode) + (setq docbook (org-export-region-as-docbook + (point-min) (point-max) t 'string))) + (kill-buffer buf))) + (delete-region beg end) + (insert docbook))) + +;;;###autoload +(defun org-export-region-as-docbook (beg end &optional body-only buffer) + "Convert region from BEG to END in `org-mode' buffer to DocBook. +If prefix arg BODY-ONLY is set, omit file header and footer and +only produce the region of converted text, useful for +cut-and-paste operations. If BUFFER is a buffer or a string, +use/create that buffer as a target of the converted DocBook. If +BUFFER is the symbol `string', return the produced DocBook as a +string and leave not buffer behind. For example, a Lisp program +could call this function in the following way: + + (setq docbook (org-export-region-as-docbook beg end t 'string)) + +When called interactively, the output buffer is selected, and shown +in a window. A non-interactive call will only return the buffer." + (interactive "r\nP") + (when (interactive-p) + (setq buffer "*Org DocBook Export*")) + (let ((transient-mark-mode t) + (zmacs-regions t) + rtn) + (goto-char end) + (set-mark (point)) ;; To activate the region + (goto-char beg) + (setq rtn (org-export-as-docbook + nil nil + buffer body-only)) + (if (fboundp 'deactivate-mark) (deactivate-mark)) + (if (and (interactive-p) (bufferp rtn)) + (switch-to-buffer-other-window rtn) + rtn))) + +;;;###autoload +(defun org-export-as-docbook-pdf (&optional hidden ext-plist + to-buffer body-only pub-dir) + "Export as DocBook XML file, and generate PDF file." + (interactive "P") + (if (or (not org-export-docbook-xslt-proc-command) + (not (string-match "%s.+%s" 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))) + (error "XSL-FO processor command is not set correctly")) + (message "Exporting to PDF...") + (let* ((wconfig (current-window-configuration)) + (docbook-buf (org-export-as-docbook hidden ext-plist + to-buffer body-only pub-dir)) + (filename (buffer-file-name docbook-buf)) + (base (file-name-sans-extension filename)) + (fofile (concat base ".fo")) + (pdffile (concat base ".pdf"))) + (and (file-exists-p pdffile) (delete-file pdffile)) + (message "Processing DocBook XML file...") + (shell-command (format org-export-docbook-xslt-proc-command + fofile (shell-quote-argument filename))) + (shell-command (format org-export-docbook-xsl-fo-proc-command + fofile pdffile)) + (message "Processing DocBook file...done") + (if (not (file-exists-p pdffile)) + (error "PDF file was not produced") + (set-window-configuration wconfig) + (message "Exporting to PDF...done") + pdffile))) + +;;;###autoload +(defun org-export-as-docbook-pdf-and-open () + "Export as DocBook XML file, generate PDF file, and open it." + (interactive) + (let ((pdffile (org-export-as-docbook-pdf))) + (if pdffile + (org-open-file pdffile) + (error "PDF file was not produced")))) + +;;;###autoload +(defun org-export-as-docbook (&optional hidden ext-plist + to-buffer body-only pub-dir) + "Export the current buffer as a DocBook file. +If there is an active region, export only the region. When +HIDDEN is obsolete and does nothing. EXT-PLIST is a +property list with external parameters overriding org-mode's +default settings, but still inferior to file-local settings. +When TO-BUFFER is non-nil, create a buffer with that name and +export to that buffer. If TO-BUFFER is the symbol `string', +don't leave any buffer behind but just return the resulting HTML +as a string. When BODY-ONLY is set, don't produce the file +header and footer, simply return the content of the document (all +top-level sections). When PUB-DIR is set, use this as the +publishing directory." + (interactive "P") + ;; Make sure we have a file name when we need it. + (when (and (not (or to-buffer body-only)) + (not buffer-file-name)) + (if (buffer-base-buffer) + (org-set-local 'buffer-file-name + (with-current-buffer (buffer-base-buffer) + buffer-file-name)) + (error "Need a file name to be able to export."))) + + (message "Exporting...") + (setq-default org-todo-line-regexp org-todo-line-regexp) + (setq-default org-deadline-line-regexp org-deadline-line-regexp) + (setq-default org-done-keywords org-done-keywords) + (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp) + (let* ((opt-plist + (org-export-process-option-filters + (org-combine-plists (org-default-export-plist) + ext-plist + (org-infile-export-plist)))) + (link-validate (plist-get opt-plist :link-validation-function)) + valid + (odd org-odd-levels-only) + (region-p (org-region-active-p)) + (rbeg (and region-p (region-beginning))) + (rend (and region-p (region-end))) + (subtree-p + (if (plist-get opt-plist :ignore-subree-p) + nil + (when region-p + (save-excursion + (goto-char rbeg) + (and (org-at-heading-p) + (>= (org-end-of-subtree t t) rend)))))) + (level-offset (if subtree-p + (save-excursion + (goto-char rbeg) + (+ (funcall outline-level) + (if org-odd-levels-only 1 0))) + 0)) + (opt-plist (setq org-export-opt-plist + (if subtree-p + (org-export-add-subtree-options opt-plist rbeg) + opt-plist))) + ;; The following two are dynamically scoped into other + ;; routines below. + (org-current-export-dir + (or pub-dir (org-export-directory :docbook opt-plist))) + (org-current-export-file buffer-file-name) + (level 0) (line "") (origline "") txt todo + (filename (if to-buffer nil + (expand-file-name + (concat + (file-name-sans-extension + (or (and subtree-p + (org-entry-get (region-beginning) + "EXPORT_FILE_NAME" t)) + (file-name-nondirectory buffer-file-name))) + org-export-docbook-extension) + (file-name-as-directory + (or pub-dir (org-export-directory :docbook opt-plist)))))) + (current-dir (if buffer-file-name + (file-name-directory buffer-file-name) + default-directory)) + (buffer (if to-buffer + (cond + ((eq to-buffer 'string) (get-buffer-create "*Org DocBook Export*")) + (t (get-buffer-create to-buffer))) + (find-file-noselect filename))) + ;; org-levels-open is a global variable + (org-levels-open (make-vector org-level-max nil)) + (date (plist-get opt-plist :date)) + (author (or (plist-get opt-plist :author) + user-full-name)) + (email (plist-get opt-plist :email)) + firstname othername surname + (title (or (and subtree-p (org-export-get-title-from-subtree)) + (plist-get opt-plist :title) + (and (not + (plist-get opt-plist :skip-before-1st-heading)) + (org-export-grab-title-from-buffer)) + (and buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name))) + "UNTITLED")) + ;; We will use HTML table formatter to export tables to DocBook + ;; format, so need to set html-table-tag here. + (html-table-tag (plist-get opt-plist :html-table-tag)) + (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) + (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)")) + (inquote nil) + (infixed nil) + (inverse nil) + (in-local-list nil) + (local-list-type nil) + (local-list-indent nil) + (llt org-plain-list-ordered-item-terminator) + (email (plist-get opt-plist :email)) + (language (plist-get opt-plist :language)) + (lang-words nil) + cnt + (start 0) + (coding-system (and (boundp 'buffer-file-coding-system) + buffer-file-coding-system)) + (coding-system-for-write (or org-export-docbook-coding-system + coding-system)) + (save-buffer-coding-system (or org-export-docbook-coding-system + coding-system)) + (charset (and coding-system-for-write + (fboundp 'coding-system-get) + (coding-system-get coding-system-for-write + 'mime-charset))) + (region + (buffer-substring + (if region-p (region-beginning) (point-min)) + (if region-p (region-end) (point-max)))) + (lines + (org-split-string + (org-export-preprocess-string + region + :emph-multiline t + :for-docbook t + :skip-before-1st-heading + (plist-get opt-plist :skip-before-1st-heading) + :drawers (plist-get opt-plist :drawers) + :todo-keywords (plist-get opt-plist :todo-keywords) + :tags (plist-get opt-plist :tags) + :priority (plist-get opt-plist :priority) + :footnotes (plist-get opt-plist :footnotes) + :timestamps (plist-get opt-plist :timestamps) + :archived-trees + (plist-get opt-plist :archived-trees) + :select-tags (plist-get opt-plist :select-tags) + :exclude-tags (plist-get opt-plist :exclude-tags) + :add-text + (plist-get opt-plist :text) + :LaTeX-fragments + (plist-get opt-plist :LaTeX-fragments)) + "[\r\n]")) + ;; Use literal output to show check boxes. + (checkbox-start + (nth 1 (assoc "=" org-export-docbook-emphasis-alist))) + (checkbox-end + (nth 2 (assoc "=" org-export-docbook-emphasis-alist))) + table-open type + table-buffer table-orig-buffer + ind item-type starter didclose + rpl path attr caption label desc descp desc1 desc2 link + fnc item-tag + footref-seen footnote-list + id-file + ) + + ;; Fine detailed info about author name. + (if (string-match "\\([^ ]+\\) \\(.+ \\)?\\([^ ]+\\)" author) + (progn + (setq firstname (match-string 1 author) + othername (or (match-string 2 author) "") + surname (match-string 3 author)))) + + ;; Get all footnote text. + (setq footnote-list + (org-export-docbook-get-footnotes lines)) + + (let ((inhibit-read-only t)) + (org-unmodified + (remove-text-properties (point-min) (point-max) + '(:org-license-to-kill t)))) + + (setq org-min-level (org-get-min-level lines level-offset)) + (setq org-last-level org-min-level) + (org-init-section-numbers) + + ;; Get and save the date. + (cond + ((and date (string-match "%" date)) + (setq date (format-time-string date))) + (date) + (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) + + ;; Get the language-dependent settings + (setq lang-words (or (assoc language org-export-language-setup) + (assoc "en" org-export-language-setup))) + + ;; Switch to the output buffer. Use fundamental-mode for now. We + ;; could turn on nXML mode later and do some indentation. + (set-buffer buffer) + (let ((inhibit-read-only t)) (erase-buffer)) + (fundamental-mode) + (org-install-letbind) + + (and (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system coding-system-for-write)) + + ;; The main body... + (let ((case-fold-search nil) + (org-odd-levels-only odd)) + + ;; Create local variables for all options, to make sure all called + ;; functions get the correct information + (mapc (lambda (x) + (set (make-local-variable (nth 2 x)) + (plist-get opt-plist (car x)))) + org-export-plist-vars) + + ;; Insert DocBook file header, title, and author info. + (unless body-only + (insert org-export-docbook-header) + (if org-export-docbook-doctype + (insert org-export-docbook-doctype)) + (insert "<!-- Date: " date " -->\n") + (insert (format "<!-- DocBook XML file generated by Org-mode %s Emacs %s -->\n" + org-version emacs-major-version)) + (insert org-export-docbook-article-header) + (insert (format + "\n <title>%s</title> + <info> + <author> + <personname> + <firstname>%s</firstname> <othername>%s</othername> <surname>%s</surname> + </personname> + %s + </author> + </info>\n" + (org-docbook-expand title) + firstname othername surname + (if email (concat "<email>" email "</email>") "") + ))) + + (org-init-section-numbers) + + (org-export-docbook-open-para) + + ;; Loop over all the lines... + (while (setq line (pop lines) origline line) + (catch 'nextline + + ;; End of quote section? + (when (and inquote (string-match "^\\*+ " line)) + (insert "]]>\n</programlisting>\n") + (org-export-docbook-open-para) + (setq inquote nil)) + ;; Inside a quote section? + (when inquote + (insert (org-docbook-protect line) "\n") + (throw 'nextline nil)) + + ;; Fixed-width, verbatim lines (examples) + (when (and org-export-with-fixed-width + (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line)) + (when (not infixed) + (setq infixed t) + (org-export-docbook-close-para-maybe) + (insert "<programlisting><![CDATA[")) + (insert (match-string 3 line) "\n") + (when (or (not lines) + (not (string-match "^[ \t]*\\(:.*\\)" + (car lines)))) + (setq infixed nil) + (insert "]]>\n</programlisting>\n") + (org-export-docbook-open-para)) + (throw 'nextline nil)) + + (org-export-docbook-close-lists-maybe line) + + ;; Protected HTML + (when (get-text-property 0 'org-protected line) + (let (par (ind (get-text-property 0 'original-indentation line))) + (when (re-search-backward + "\\(<para>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t) + (setq par (match-string 1)) + (replace-match "\\2\n")) + (insert line "\n") + (while (and lines + (or (= (length (car lines)) 0) + (not ind) + (equal ind (get-text-property 0 'original-indentation (car lines)))) + (or (= (length (car lines)) 0) + (get-text-property 0 'org-protected (car lines)))) + (insert (pop lines) "\n")) + (and par (insert "<para>\n"))) + (throw 'nextline nil)) + + ;; Start of block quotes and verses + (when (or (equal "ORG-BLOCKQUOTE-START" line) + (and (equal "ORG-VERSE-START" line) + (setq inverse t))) + (org-export-docbook-close-para-maybe) + (insert "<blockquote>") + ;; Check whether attribution for this blockquote exists. + (let (tmp1 + attribution + (end (if inverse "ORG-VERSE-END" "ORG-BLOCKQUOTE-END")) + (quote-lines nil)) + (while (and (setq tmp1 (pop lines)) + (not (equal end tmp1))) + (push tmp1 quote-lines)) + (push tmp1 lines) ; Put back quote end mark + ;; Check the last line in the quote to see if it contains + ;; the attribution. + (setq tmp1 (pop quote-lines)) + (if (string-match "\\(^.*\\)\\(--[ \t]+\\)\\(.+\\)$" tmp1) + (progn + (setq attribution (match-string 3 tmp1)) + (when (save-match-data + (string-match "[^ \t]" (match-string 1 tmp1))) + (push (match-string 1 tmp1) lines))) + (push tmp1 lines)) + (while (setq tmp1 (pop quote-lines)) + (push tmp1 lines)) + (when attribution + (insert "<attribution>" attribution "</attribution>"))) + ;; Insert <literallayout> for verse. + (if inverse + (insert "\n<literallayout>") + (org-export-docbook-open-para)) + (throw 'nextline nil)) + + ;; End of block quotes + (when (equal "ORG-BLOCKQUOTE-END" line) + (org-export-docbook-close-para-maybe) + (insert "</blockquote>\n") + (org-export-docbook-open-para) + (throw 'nextline nil)) + + ;; End of verses + (when (equal "ORG-VERSE-END" line) + (insert "</literallayout>\n</blockquote>\n") + (org-export-docbook-open-para) + (setq inverse nil) + (throw 'nextline nil)) + + ;; Text centering. Element <para role="centered"> does not + ;; seem to work with FOP, so for now we use <informaltable> to + ;; center the text, which can contain multiple paragraphs. + (when (equal "ORG-CENTER-START" line) + (org-export-docbook-close-para-maybe) + (insert "<informaltable frame=\"none\" colsep=\"0\" rowsep=\"0\">\n" + "<tgroup align=\"center\" cols=\"1\">\n" + "<tbody><row><entry>\n") + (org-export-docbook-open-para) + (throw 'nextline nil)) + + (when (equal "ORG-CENTER-END" line) + (org-export-docbook-close-para-maybe) + (insert "</entry></row></tbody>\n" + "</tgroup>\n</informaltable>\n") + (org-export-docbook-open-para) + (throw 'nextline nil)) + + ;; Make targets to anchors. Note that currently FOP does not + ;; seem to support <anchor> tags when generating PDF output, + ;; but this can be used in DocBook --> HTML conversion. + (while (string-match "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line) + (cond + ((match-end 2) + (setq line (replace-match + (format "@<anchor xml:id=\"%s\"/>" + (org-solidify-link-text (match-string 1 line))) + t t line))) + (t + (setq line (replace-match + (format "@<anchor xml:id=\"%s\"/>" + (org-solidify-link-text (match-string 1 line))) + t t line))))) + + ;; Put time stamps and related keywords into special mark-up + ;; elements. + (setq line (org-export-docbook-handle-time-stamps line)) + + ;; Replace "&", "<" and ">" by "&", "<" and ">". + ;; Handle @<..> HTML tags (replace "@>..<" by "<..>"). + ;; Also handle sub_superscripts and check boxes. + (or (string-match org-table-hline-regexp line) + (setq line (org-docbook-expand line))) + + ;; Format the links + (setq start 0) + (while (string-match org-bracket-link-analytic-regexp++ line start) + (setq start (match-beginning 0)) + (setq path (save-match-data (org-link-unescape + (match-string 3 line)))) + (setq type (cond + ((match-end 2) (match-string 2 line)) + ((save-match-data + (or (file-name-absolute-p path) + (string-match "^\\.\\.?/" path))) + "file") + (t "internal"))) + (setq path (org-extract-attributes (org-link-unescape path))) + (setq attr (get-text-property 0 'org-attributes path) + caption (get-text-property 0 'org-caption path) + label (get-text-property 0 'org-label path)) + (setq desc1 (if (match-end 5) (match-string 5 line)) + desc2 (if (match-end 2) (concat type ":" path) path) + descp (and desc1 (not (equal desc1 desc2))) + desc (or desc1 desc2)) + ;; Make an image out of the description if that is so wanted + (when (and descp (org-file-image-p + desc org-export-docbook-inline-image-extensions)) + (save-match-data + (if (string-match "^file:" desc) + (setq desc (substring desc (match-end 0)))))) + ;; FIXME: do we need to unescape here somewhere? + (cond + ((equal type "internal") + (setq rpl (format "<link linkend=\"%s\">%s</link>" + (org-solidify-link-text + (save-match-data (org-link-unescape path)) nil) + (org-export-docbook-format-desc desc)))) + ((and (equal type "id") + (setq id-file (org-id-find-id-file path))) + ;; This is an id: link to another file (if it was the same file, + ;; it would have become an internal link...) + (save-match-data + (setq id-file (file-relative-name + id-file (file-name-directory org-current-export-file))) + (setq id-file (concat (file-name-sans-extension id-file) + org-export-docbook-extension)) + (setq rpl (format "<link xlink:href=\"%s#%s\">%s</link>" + id-file path (org-export-docbook-format-desc desc))))) + ((member type '("http" "https")) + ;; Standard URL, just check if we need to inline an image + (if (and (or (eq t org-export-docbook-inline-images) + (and org-export-docbook-inline-images (not descp))) + (org-file-image-p + path org-export-docbook-inline-image-extensions)) + (setq rpl (org-export-docbook-format-image + (concat type ":" path))) + (setq link (concat type ":" path)) + (setq rpl (format "<link xlink:href=\"%s\">%s</link>" + (org-export-html-format-href link) + (org-export-docbook-format-desc desc))) + )) + ((member type '("ftp" "mailto" "news")) + ;; Standard URL + (setq link (concat type ":" path)) + (setq rpl (format "<link xlink:href=\"%s\">%s</link>" + (org-export-html-format-href link) + (org-export-docbook-format-desc desc)))) + ((string= type "coderef") + (setq rpl (format (org-export-get-coderef-format path (and descp desc)) + (cdr (assoc path org-export-code-refs))))) + ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) + ;; The link protocol has a function for format the link + (setq rpl + (save-match-data + (funcall fnc (org-link-unescape path) desc1 'html)))) + + ((string= type "file") + ;; FILE link + (let* ((filename path) + (abs-p (file-name-absolute-p filename)) + thefile file-is-image-p search) + (save-match-data + (if (string-match "::\\(.*\\)" filename) + (setq search (match-string 1 filename) + filename (replace-match "" t nil filename))) + (setq valid + (if (functionp link-validate) + (funcall link-validate filename current-dir) + t)) + (setq file-is-image-p + (org-file-image-p + filename org-export-docbook-inline-image-extensions)) + (setq thefile (if abs-p (expand-file-name filename) filename)) + ;; Carry over the properties (expand-file-name will + ;; discard the properties of filename) + (add-text-properties 0 (1- (length thefile)) + (list 'org-caption caption + 'org-attributes attr + 'org-label label) + thefile) + (when (and org-export-docbook-link-org-files-as-docbook + (string-match "\\.org$" thefile)) + (setq thefile (concat (substring thefile 0 + (match-beginning 0)) + org-export-docbook-extension)) + (if (and search + ;; make sure this is can be used as target search + (not (string-match "^[0-9]*$" search)) + (not (string-match "^\\*" search)) + (not (string-match "^/.*/$" search))) + (setq thefile (concat thefile "#" + (org-solidify-link-text + (org-link-unescape search))))) + (when (string-match "^file:" desc) + (setq desc (replace-match "" t t desc)) + (if (string-match "\\.org$" desc) + (setq desc (replace-match "" t t desc)))))) + (setq rpl (if (and file-is-image-p + (or (eq t org-export-docbook-inline-images) + (and org-export-docbook-inline-images + (not descp)))) + (progn + (message "image %s %s" thefile org-docbook-para-open) + (org-export-docbook-format-image thefile)) + (format "<link xlink:href=\"%s\">%s</link>" + thefile (org-export-docbook-format-desc desc)))) + (if (not valid) (setq rpl desc)))) + + (t + ;; Just publish the path, as default + (setq rpl (concat "<" type ":" + (save-match-data (org-link-unescape path)) + ">")))) + (setq line (replace-match rpl t t line) + start (+ start (length rpl)))) + + ;; TODO items: can we do something better?! + (if (and (string-match org-todo-line-regexp line) + (match-beginning 2)) + (setq line + (concat (substring line 0 (match-beginning 2)) + "[" (match-string 2 line) "]" + (substring line (match-end 2))))) + + ;; Does this contain a reference to a footnote? + (when org-export-with-footnotes + (setq start 0) + (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start) + (if (get-text-property (match-beginning 2) 'org-protected line) + (setq start (match-end 2)) + (let ((num (match-string 2 line))) + (if (assoc num footref-seen) + (setq line (replace-match + (format "%s<footnoteref linkend=\"%s%s\"/>" + (match-string 1 line) + org-export-docbook-footnote-id-prefix num) + t t line)) + (setq line (replace-match + (format "%s<footnote xml:id=\"%s%s\"><para>%s</para></footnote>" + (match-string 1 line) + org-export-docbook-footnote-id-prefix + num + (save-match-data + (org-docbook-expand + (cdr (assoc num footnote-list))))) + t t line)) + (push (cons num 1) footref-seen)))))) + + (cond + ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) + ;; This is a headline + (setq level (org-tr-level (- (match-end 1) (match-beginning 1) + level-offset)) + txt (match-string 2 line)) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) + (when in-local-list + ;; Close any local lists before inserting a new header line + (while local-list-type + (let ((listtype (car local-list-type))) + (org-export-docbook-close-li listtype) + (insert (cond + ((equal listtype "o") "</orderedlist>\n") + ((equal listtype "u") "</itemizedlist>\n") + ((equal listtype "d") "</variablelist>\n")))) + (pop local-list-type)) + (setq local-list-indent nil + in-local-list nil)) + (org-export-docbook-level-start level txt) + ;; QUOTES + (when (string-match quote-re line) + (org-export-docbook-close-para-maybe) + (insert "<programlisting><![CDATA[") + (setq inquote t))) + + ;; Tables: since version 4.3 of DocBook DTD, HTML tables are + ;; supported. We can use existing HTML table exporter code + ;; here. + ((and org-export-with-tables + (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) + (if (not table-open) + ;; New table starts + (setq table-open t + table-buffer nil + table-orig-buffer nil)) + ;; Accumulate lines + (setq table-buffer (cons line table-buffer) + table-orig-buffer (cons origline table-orig-buffer)) + (when (or (not lines) + (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" + (car lines)))) + (setq table-open nil + table-buffer (nreverse table-buffer) + table-orig-buffer (nreverse table-orig-buffer)) + (org-export-docbook-close-para-maybe) + (insert (org-export-docbook-finalize-table + (org-format-table-html table-buffer table-orig-buffer))))) + (t + ;; Normal lines + (when (string-match + (cond + ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") + ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") + ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") + (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) + line) + (setq ind (or (get-text-property 0 'original-indentation line) + (org-get-string-indentation line)) + item-type (if (match-beginning 4) "o" "u") + starter (if (match-beginning 2) + (substring (match-string 2 line) 0 -1)) + line (substring line (match-beginning 5)) + item-tag nil) + (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) + (setq item-type "d" + item-tag (match-string 1 line) + line (substring line (match-end 0)))) + (when (and (not (equal item-type "d")) + (not (string-match "[^ \t]" line))) + ;; Empty line. Pretend indentation is large. + (setq ind (if org-empty-line-terminates-plain-lists + 0 + (1+ (or (car local-list-indent) 1))))) + (setq didclose nil) + (while (and in-local-list + (or (and (= ind (car local-list-indent)) + (not starter)) + (< ind (car local-list-indent)))) + (setq didclose t) + (let ((listtype (car local-list-type))) + (org-export-docbook-close-li listtype) + (insert (cond + ((equal listtype "o") "</orderedlist>\n") + ((equal listtype "u") "</itemizedlist>\n") + ((equal listtype "d") "</variablelist>\n")))) + (pop local-list-type) (pop local-list-indent) + (setq in-local-list local-list-indent)) + (cond + ((and starter + (or (not in-local-list) + (> ind (car local-list-indent)))) + ;; Start new (level of) list + (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 "d") + (format "<variablelist>\n<varlistentry><term>%s</term><listitem>\n" item-tag)))) + ;; For DocBook, we need to open a para right after tag + ;; <listitem>. + (org-export-docbook-open-para) + (push item-type local-list-type) + (push ind local-list-indent) + (setq in-local-list t)) + (starter + ;; Continue current list + (let ((listtype (car local-list-type))) + (org-export-docbook-close-li listtype) + (insert (cond + ((equal listtype "o") "<listitem>") + ((equal listtype "u") "<listitem>") + ((equal listtype "d") (format + "<varlistentry><term>%s</term><listitem>" + (or item-tag + "???")))))) + ;; For DocBook, we need to open a para right after tag + ;; <listitem>. + (org-export-docbook-open-para)) + (didclose + ;; We did close a list, normal text follows: need <para> + (org-export-docbook-open-para))) + ;; Checkboxes. + (if (string-match "^[ \t]*\\(\\[[X -]\\]\\)" line) + (setq line + (replace-match (concat checkbox-start + (match-string 1 line) + checkbox-end) + t t line)))) + + ;; Empty lines start a new paragraph. If hand-formatted lists + ;; are not fully interpreted, lines starting with "-", "+", "*" + ;; also start a new paragraph. + (if (and (string-match "^ [-+*]-\\|^[ \t]*$" line) + (not inverse)) + (org-export-docbook-open-para)) + + ;; Is this the start of a footnote? + (when org-export-with-footnotes + (when (and (boundp 'footnote-section-tag-regexp) + (string-match (concat "^" footnote-section-tag-regexp) + line)) + ;; ignore this line + (throw 'nextline nil)) + ;; These footnote lines have been read and saved before, + ;; ignore them at this time. + (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line) + (org-export-docbook-close-para-maybe) + (throw 'nextline nil))) + + ;; FIXME: It might be a good idea to add an option to + ;; support line break processing instruction <?linebreak?>. + ;; Org-mode supports line break "\\" in HTML exporter, and + ;; some DocBook users may also want to force line breaks + ;; even though DocBook only supports that in + ;; <literallayout>. + + (insert line "\n"))))) + + ;; Properly close all local lists and other lists + (when inquote + (insert "]]>\n</programlisting>\n") + (org-export-docbook-open-para)) + (when in-local-list + ;; Close any local lists before inserting a new header line + (while local-list-type + (let ((listtype (car local-list-type))) + (org-export-docbook-close-li listtype) + (insert (cond + ((equal listtype "o") "</orderedlist>\n") + ((equal listtype "u") "</itemizedlist>\n") + ((equal listtype "d") "</variablelist>\n")))) + (pop local-list-type)) + (setq local-list-indent nil + in-local-list nil)) + ;; Close all open sections. + (org-export-docbook-level-start 1 nil) + + (unless (plist-get opt-plist :buffer-will-be-killed) + (normal-mode) + (if (eq major-mode default-major-mode) + (nxml-mode))) + + ;; Remove empty paragraphs and lists. Replace them with a + ;; newline. + (goto-char (point-min)) + (while (re-search-forward + "[ \r\n\t]*\\(<para>\\)[ \r\n\t]*</para>[ \r\n\t]*" nil t) + (when (not (get-text-property (match-beginning 1) 'org-protected)) + (replace-match "\n") + (backward-char 1))) + ;; Fill empty sections with <para></para>. This is to make sure + ;; that the DocBook document generated is valid and well-formed. + (goto-char (point-min)) + (while (re-search-forward + "</title>\\([ \r\n\t]*\\)</section>" nil t) + (when (not (get-text-property (match-beginning 0) 'org-protected)) + (replace-match "\n<para></para>\n" nil nil nil 1))) + ;; Insert the last closing tag. + (goto-char (point-max)) + (unless body-only + (insert "</article>")) + (or to-buffer (save-buffer)) + (goto-char (point-min)) + (or (org-export-push-to-kill-ring "DocBook") + (message "Exporting... done")) + (if (eq to-buffer 'string) + (prog1 (buffer-substring (point-min) (point-max)) + (kill-buffer (current-buffer))) + (current-buffer))))) + +(defun org-export-docbook-open-para () + "Insert <para>, but first close previous paragraph if any." + (org-export-docbook-close-para-maybe) + (insert "\n<para>") + (setq org-docbook-para-open t)) + +(defun org-export-docbook-close-para-maybe () + "Close DocBook paragraph if there is one open." + (when org-docbook-para-open + (insert "</para>\n") + (setq org-docbook-para-open nil))) + +(defun org-export-docbook-close-li (&optional type) + "Close list if necessary." + (org-export-docbook-close-para-maybe) + (if (equal type "d") + (insert "</listitem></varlistentry>\n") + (insert "</listitem>\n"))) + +(defvar in-local-list) +(defvar local-list-indent) +(defvar local-list-type) +(defun org-export-docbook-close-lists-maybe (line) + (let ((ind (or (get-text-property 0 'original-indentation line))) +; (and (string-match "\\S-" line) +; (org-get-indentation line)))) + didclose) + (when ind + (while (and in-local-list + (<= ind (car local-list-indent))) + (setq didclose t) + (let ((listtype (car local-list-type))) + (org-export-docbook-close-li listtype) + (insert (cond + ((equal listtype "o") "</orderedlist>\n") + ((equal listtype "u") "</itemizedlist>\n") + ((equal listtype "d") "</variablelist>\n")))) + (pop local-list-type) (pop local-list-indent) + (setq in-local-list local-list-indent)) + (and didclose (org-export-docbook-open-para))))) + +(defun org-export-docbook-level-start (level title) + "Insert a new level in DocBook export. +When TITLE is nil, just close all open levels." + (org-export-docbook-close-para-maybe) + (let* ((target (and title (org-get-text-property-any 0 'target title))) + (l org-level-max) + section-number) + (while (>= l level) + (if (aref org-levels-open (1- l)) + (progn + (insert "</section>\n") + (aset org-levels-open (1- l) nil))) + (setq l (1- l))) + (when title + ;; If title is nil, this means this function is called to close + ;; all levels, so the rest is done only if title is given. + ;; + ;; Format tags: put them into a superscript like format. + (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (setq title + (replace-match + (if org-export-with-tags + (save-match-data + (concat + "<superscript>" + (match-string 1 title) + "</superscript>")) + "") + t t title))) + (aset org-levels-open (1- level) t) + (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)) + (org-export-docbook-open-para)))) + +(defun org-docbook-expand (string) + "Prepare STRING for DocBook export. +Applies all active conversions. If there are links in the +string, don't modify these." + (let* ((re (concat org-bracket-link-regexp "\\|" + (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) + m s l res) + (while (setq m (string-match re string)) + (setq s (substring string 0 m) + l (match-string 0 string) + string (substring string (match-end 0))) + (push (org-docbook-do-expand s) res) + (push l res)) + (push (org-docbook-do-expand string) res) + (apply 'concat (nreverse res)))) + +(defun org-docbook-do-expand (s) + "Apply all active conversions to translate special ASCII to DocBook." + (setq s (org-html-protect s)) + (while (string-match "@<\\([^&]*\\)>" s) + (setq s (replace-match "<\\1>" t nil s))) + (if org-export-with-emphasize + (setq s (org-export-docbook-convert-emphasize s))) + (if org-export-with-special-strings + (setq s (org-export-docbook-convert-special-strings s))) + (if org-export-with-sub-superscripts + (setq s (org-export-docbook-convert-sub-super s))) + (if org-export-with-TeX-macros + (let ((start 0) wd ass) + (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?" + s start)) + (if (get-text-property (match-beginning 0) 'org-protected s) + (setq start (match-end 0)) + (setq wd (match-string 1 s)) + (if (setq ass (assoc wd org-html-entities)) + (setq s (replace-match (or (cdr ass) + (concat "&" (car ass) ";")) + t t s)) + (setq start (+ start (length wd)))))))) + s) + +(defun org-export-docbook-format-desc (desc) + "Make sure DESC is valid as a description in a link." + (save-match-data + (org-docbook-do-expand desc))) + +(defun org-export-docbook-convert-emphasize (string) + "Apply emphasis for DocBook exporting." + (let ((s 0) rpl) + (while (string-match org-emph-re string s) + (if (not (equal + (substring string (match-beginning 3) (1+ (match-beginning 3))) + (substring string (match-beginning 4) (1+ (match-beginning 4))))) + (setq s (match-beginning 0) + rpl + (concat + (match-string 1 string) + (nth 1 (assoc (match-string 3 string) + org-export-docbook-emphasis-alist)) + (match-string 4 string) + (nth 2 (assoc (match-string 3 string) + org-export-docbook-emphasis-alist)) + (match-string 5 string)) + string (replace-match rpl t t string) + s (+ s (- (length rpl) 2))) + (setq s (1+ s)))) + string)) + +(defun org-docbook-protect (string) + (org-html-protect string)) + +;; For now, simply return string as it is. +(defun org-export-docbook-convert-special-strings (string) + "Convert special characters in STRING to DocBook." + string) + +(defun org-export-docbook-get-footnotes (lines) + "Given a list of LINES, return a list of alist footnotes." + (let ((list nil) line) + (while (setq line (pop lines)) + (if (string-match "^[ \t]*\\[\\([0-9]+\\)\\] \\(.+\\)" line) + (push (cons (match-string 1 line) (match-string 2 line)) + list))) + list)) + +(defun org-export-docbook-format-image (src) + "Create image element in DocBook." + (save-match-data + (let* ((caption (org-find-text-property-in-string 'org-caption src)) + (attr (or (org-find-text-property-in-string 'org-attributes src) + "")) + (label (org-find-text-property-in-string 'org-label src)) + (default-attr org-export-docbook-default-image-attributes) + tmp) + (while (setq tmp (pop default-attr)) + (if (not (string-match (concat (car tmp) "=") attr)) + (setq attr (concat attr " " (car tmp) "=" (cdr tmp))))) + (format "<mediaobject%s> +<imageobject>\n<imagedata fileref=\"%s\" %s/>\n</imageobject> +%s</mediaobject>" + (if label (concat " xml:id=\"" label "\"") "") + src attr + (if caption + (concat "<caption>\n<para>" + caption + "</para>\n</caption>\n") + "") + )))) + +(defun org-export-docbook-preprocess (parameters) + "Extra preprocessing work for DocBook export." + ;; Merge lines starting with "\par" to one line. Such lines are + ;; regarded as the continuation of a long footnote. + (goto-char (point-min)) + (while (re-search-forward "\n\\(\\\\par\\>\\)" nil t) + (if (not (get-text-property (match-beginning 1) 'org-protected)) + (replace-match "")))) + +(defun org-export-docbook-finalize-table (table) + "Change TABLE to informaltable if caption does not exist. +TABLE is a string containing the HTML code generated by +`org-format-table-html' for a table in Org-mode buffer." + (if (string-match + "^<table \\(\\(.\\|\n\\)+\\)<caption></caption>\n\\(\\(.\\|\n\\)+\\)</table>" + table) + (replace-match (concat "<informaltable " + (match-string 1 table) + (match-string 3 table) + "</informaltable>") + nil nil table) + table)) + +;; Note: This function is very similar to +;; org-export-html-convert-sub-super. They can be merged in the future. +(defun org-export-docbook-convert-sub-super (string) + "Convert sub- and superscripts in STRING for DocBook." + (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) + (while (string-match org-match-substring-regexp string s) + (cond + ((and requireb (match-end 8)) (setq s (match-end 2))) + ((get-text-property (match-beginning 2) 'org-protected string) + (setq s (match-end 2))) + (t + (setq s (match-end 1) + key (if (string= (match-string 2 string) "_") + "subscript" + "superscript") + c (or (match-string 8 string) + (match-string 6 string) + (match-string 5 string)) + string (replace-match + (concat (match-string 1 string) + "<" key ">" c "</" key ">") + t t string))))) + (while (string-match "\\\\\\([_^]\\)" string) + (setq string (replace-match (match-string 1 string) t t string))) + string)) + +(defun org-export-docbook-protect-tags (string) + "Change ``<...>'' in string STRING into ``@<...>''. +This is normally needed when STRING contains DocBook elements +that need to be preserved in later phase of DocBook exporting." + (let ((start 0)) + (while (string-match "<\\([^>]*\\)>" string start) + (setq string (replace-match + "@<\\1>" t nil string) + start (match-end 0))) + string)) + +(defun org-export-docbook-handle-time-stamps (line) + "Format time stamps in string LINE." + (let (replaced + (kw-markup (org-export-docbook-protect-tags + org-export-docbook-keywords-markup)) + (ts-markup (org-export-docbook-protect-tags + org-export-docbook-timestamp-markup))) + (while (string-match org-maybe-keyword-time-regexp line) + (setq replaced + (concat replaced + (substring line 0 (match-beginning 0)) + (if (match-end 1) + (format kw-markup + (match-string 1 line))) + " " + (format ts-markup + (substring (org-translate-time + (match-string 3 line)) 1 -1))) + line (substring line (match-end 0)))) + (concat replaced line))) + +(provide 'org-docbook) + +;;; org-docbook.el ends here diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el new file mode 100644 index 00000000000..2b5cd819b69 --- /dev/null +++ b/lisp/org/org-exp-blocks.el @@ -0,0 +1,440 @@ +;;; org-exp-blocks.el --- pre-process blocks when exporting org files + +;; Copyright (C) 2009 +;; Free Software Foundation, Inc. + +;; Author: Eric Schulte + +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This is a utility for pre-processing blocks in org files before +;; export using the `org-export-preprocess-hook'. It can be used for +;; exporting new types of blocks from org-mode files and also for +;; changing the default export behavior of existing org-mode blocks. +;; The `org-export-blocks' and `org-export-interblocks' variables can +;; be used to control how blocks and the spaces between blocks +;; respectively are processed upon export. +;; +;; The type of a block is defined as the string following =#+begin_=, +;; so for example the following block would be of type ditaa. Note +;; that both upper or lower case are allowed in =#+BEGIN_= and +;; =#+END_=. +;; +;; #+begin_ditaa blue.png -r -S +;; +---------+ +;; | cBLU | +;; | | +;; | +----+ +;; | |cPNK| +;; | | | +;; +----+----+ +;; #+end_ditaa +;; +;;; Currently Implemented Block Types +;; +;; ditaa :: Convert ascii pictures to actual images using ditaa +;; http://ditaa.sourceforge.net/. To use this set +;; `org-ditaa-jar-path' to the path to ditaa.jar on your +;; system (should be set automatically in most cases) . +;; +;; dot :: Convert graphs defined using the dot graphing language to +;; images using the dot utility. For information on dot see +;; http://www.graphviz.org/ +;; +;; comment :: Wrap comments with titles and author information, in +;; their own divs with author-specific ids allowing for css +;; coloring of comments based on the author. +;; +;; R :: Implements Sweave type exporting, evaluates blocks of R code, +;; and also replaces \R{} chunks in the file with their result +;; when passed to R. This require the `R' command which is +;; provided by ESS (Emacs Speaks Statistics). +;; +;;; Adding new blocks +;; +;; When adding a new block type first define a formatting function +;; along the same lines as `org-export-blocks-format-dot' and then use +;; `org-export-blocks-add-block' to add your block type to +;; `org-export-blocks'. + +(eval-when-compile + (require 'cl)) +(require 'org) + +(defvar comint-last-input-end) +(defvar comint-prompt-regexp) +(defvar comint-last-input-end) +(defvar htmlp) +(defvar latexp) +(defvar docbookp) +(defvar asciip) + +(declare-function comint-send-input "comint" (&optional no-newline artificial)) +(declare-function R "ess" nil) + +(defun org-export-blocks-set (var value) + "Set the value of `org-export-blocks' and install fontification." + (set var value) + (mapc (lambda (spec) + (if (nth 2 spec) + (setq org-protecting-blocks + (delete (symbol-name (car spec)) + org-protecting-blocks)) + (add-to-list 'org-protecting-blocks + (symbol-name (car spec))))) + value)) + +(defcustom org-export-blocks + '((comment org-export-blocks-format-comment t) + (ditaa org-export-blocks-format-ditaa nil) + (dot org-export-blocks-format-dot nil) + (r org-export-blocks-format-R nil) + (R org-export-blocks-format-R 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..." + :group 'org-export-general + :type '(repeat + (list + (symbol :tag "Block name") + (function :tag "Block formatter") + (boolean :tag "Fontify content as Org syntax"))) + :set 'org-export-blocks-set) + +(defun org-export-blocks-add-block (block-spec) + "Add a new block type to `org-export-blocks'. BLOCK-SPEC +should be a three element list the first element of which should +indicate the name of the block, the second element should be the +formatting function called by `org-export-blocks-preprocess' and +the third element a flag indicating whether these types of blocks +should be fontified in org-mode buffers (see +`org-protecting-blocks'). For example the BLOCK-SPEC for ditaa +blocks is as follows... + + (ditaa org-export-blocks-format-ditaa nil)" + (unless (member block-spec org-export-blocks) + (setq org-export-blocks (cons block-spec org-export-blocks)) + (org-export-blocks-set 'org-export-blocks org-export-blocks))) + +(defcustom org-export-interblocks + '((r org-export-interblocks-format-R) + (R org-export-interblocks-format-R)) + "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..." + :group 'org-export-general + :type 'alist) + +(defcustom org-export-blocks-witheld + '(hidden) + "List of block types (see `org-export-blocks') which should not +be exported." + :group 'org-export-general + :type 'list) + +(defvar org-export-blocks-postblock-hooks nil "") + +(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." + (concat + "\n#+BEGIN_HTML\n" + (or open "") + body (if (string-match "\n$" body) "" "\n") + (or close "") + "#+END_HTML\n")) + +(defun org-export-blocks-latex-quote (body &optional open close) + "Protext BODY from org latex export. The optional OPEN and +CLOSE tags will be inserted around BODY." + (concat + "\n#+BEGIN_LaTeX\n" + (or open "") + body (if (string-match "\n$" body) "" "\n") + (or close "") + "#+END_LaTeX\n")) + +(defun org-export-blocks-preprocess () + "Export all blocks acording 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'." + (interactive) + (save-window-excursion + (let ((count 0) + (blocks org-export-blocks-witheld) + (case-fold-search t) + (types '()) + indentation type func start end) + (flet ((interblock (start end type) + (save-match-data + (when (setf func (cadr (assoc type org-export-interblocks))) + (funcall func start end))))) + (goto-char (point-min)) + (setf start (point)) + (while (re-search-forward + "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]\\([^\000]*?\\)[\r\n][ \t]*#\\+end_\\S-+.*" nil t) + (save-match-data (setq indentation (length (match-string 1)))) + (save-match-data (setf type (intern (match-string 2)))) + (unless (memq type types) (setf types (cons type types))) + (setf end (save-match-data (match-beginning 0))) + (interblock start end type) + (if (setf func (cadr (assoc type org-export-blocks))) + (progn + (replace-match (save-match-data + (if (memq type blocks) + "" + (apply func (save-match-data (org-remove-indentation (match-string 4))) + (split-string (match-string 3) " ")))) t t) + ;; indent the replaced match + (indent-region (match-beginning 0) (match-end 0) indentation) + )) + (setf start (save-match-data (match-end 0)))) + (mapcar (lambda (type) + (interblock start (point-max) type)) + types))))) + +(add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess) + +;;================================================================================ +;; type specific functions + +;;-------------------------------------------------------------------------------- +;; ditaa: create images from ASCII art using the ditaa utility +(defvar org-ditaa-jar-path (expand-file-name + "ditaa.jar" + (file-name-as-directory + (expand-file-name + "scripts" + (file-name-as-directory + (expand-file-name + "../contrib" + (file-name-directory (or load-file-name buffer-file-name))))))) + "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. +Specify the path at which the image should be saved as the first +element of headers, any additional elements of headers will be +passed to the ditaa utility as command line arguments." + (message "ditaa-formatting...") + (let ((out-file (if headers (car headers))) + (args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) + (data-file (make-temp-file "org-ditaa"))) + (unless (file-exists-p org-ditaa-jar-path) + (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path))) + (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body) + body + (mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1))) + (org-split-string body "\n") + "\n"))) + (cond + ((or htmlp latexp docbookp) + (with-temp-file data-file (insert body)) + (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) + (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) + (format "\n[[file:%s]]\n" out-file)) + (t (concat + "\n#+BEGIN_EXAMPLE\n" + body (if (string-match "\n$" body) "" "\n") + "#+END_EXAMPLE\n"))))) + +;;-------------------------------------------------------------------------------- +;; dot: create graphs using the dot graphing language +;; (require the dot executable to be in your path) +(defun org-export-blocks-format-dot (body &rest headers) + "Pass block BODY to the dot graphing utility creating an image. +Specify the path at which the image should be saved as the first +element of headers, any additional elements of headers will be +passed to the dot utility as command line arguments. Don't +forget to specify the output type for the dot command, so if you +are exporting to a file with a name like 'image.png' you should +include a '-Tpng' argument, and your block should look like the +following. + +#+begin_dot models.png -Tpng +digraph data_relationships { + \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"] + \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"] + \"data_requirement\" -> \"data_product\" +} +#+end_dot" + (message "dot-formatting...") + (let ((out-file (if headers (car headers))) + (args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) + (data-file (make-temp-file "org-ditaa"))) + (cond + ((or htmlp latexp docbookp) + (with-temp-file data-file (insert body)) + (message (concat "dot " data-file " " args " -o " out-file)) + (shell-command (concat "dot " data-file " " args " -o " out-file)) + (format "\n[[file:%s]]\n" out-file)) + (t (concat + "\n#+BEGIN_EXAMPLE\n" + body (if (string-match "\n$" body) "" "\n") + "#+END_EXAMPLE\n"))))) + +;;-------------------------------------------------------------------------------- +;; comment: export comments in author-specific css-stylable divs +(defun org-export-blocks-format-comment (body &rest headers) + "Format comment BODY by OWNER and return it formatted for export. +Currently, this only does something for HTML export, for all +other backends, it converts the comment into an EXAMPLE segment." + (let ((owner (if headers (car headers))) + (title (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))) + (cond + (htmlp ;; We are exporting to HTML + (concat "#+BEGIN_HTML\n" + "<div class=\"org-comment\"" + (if owner (format " id=\"org-comment-%s\" " owner)) + ">\n" + (if owner (concat "<b>" owner "</b> ") "") + (if (and title (> (length title) 0)) (concat " -- " title "</br>\n") "</br>\n") + "<p>\n" + "#+END_HTML\n" + body + "#+BEGIN_HTML\n" + "</p>\n" + "</div>\n" + "#+END_HTML\n")) + (t ;; This is not HTML, so just make it an example. + (concat "#+BEGIN_EXAMPLE\n" + (if title (concat "Title:" title "\n") "") + (if owner (concat "By:" owner "\n") "") + body + (if (string-match "\n\\'" body) "" "\n") + "#+END_EXAMPLE\n"))))) + +;;-------------------------------------------------------------------------------- +;; R: Sweave-type functionality +(defvar interblock-R-buffer nil + "Holds the buffer for the current R process") + +(defvar count) ; dynamicaly scoped from `org-export-blocks-preprocess'? +(defun org-export-blocks-format-R (body &rest headers) + "Process R blocks and replace \R{} forms outside the blocks +with their values as determined by R." + (interactive) + (message "R processing...") + (let ((image-path (or (and (car headers) + (string-match "\\(.?\\)\.\\(EPS\\|eps\\)" (car headers)) + (match-string 1 (car headers))) + (and (> (length (car headers)) 0) + (car headers)) + ;; create the default filename + (format "Rplot-%03d" count))) + (plot (string-match "plot" body)) + R-proc) + (setf count (+ count 1)) + (interblock-initiate-R-buffer) + (setf R-proc (get-buffer-process interblock-R-buffer)) + ;; send strings to the ESS process using `comint-send-string' + (setf body (mapconcat (lambda (line) + (interblock-R-input-command line) (concat "> " line)) + (butlast (split-string body "[\r\n]")) + "\n")) + ;; if there is a plot command, then create the images + (when plot + (interblock-R-input-command (format "dev.copy2eps(file=\"%s.eps\")" image-path))) + (concat (cond + (htmlp (org-export-blocks-html-quote body + (format "<div id=\"R-%d\">\n<pre>\n" count) + "</pre>\n</div>\n")) + (latexp (org-export-blocks-latex-quote body + "\\begin{Schunk}\n\\begin{Sinput}\n" + "\\end{Sinput}\n\\end{Schunk}\n")) + (t (insert ;; default export + "#+begin_R " (mapconcat 'identity headers " ") "\n" + body (if (string-match "\n$" body) "" "\n") + "#+end_R\n"))) + (if plot + (format "[[file:%s.eps]]\n" image-path) + "")))) + +(defun org-export-interblocks-format-R (start end) + "This is run over parts of the org-file which are between R +blocks. It's main use is to expand the \R{stuff} chunks for +export." + (save-excursion + (goto-char start) + (interblock-initiate-R-buffer) + (let (code replacement) + (while (and (< (point) end) (re-search-forward "\\\\R{\\(.*\\)}" end t)) + (save-match-data (setf code (match-string 1))) + (setf replacement (interblock-R-command-to-string code)) + (setf replacement (cond + (htmlp replacement) + (latexp replacement) + (t replacement))) + (setf end (+ end (- (length replacement) (length code)))) + (replace-match replacement t t))))) + +(defun interblock-initiate-R-buffer () + "If there is not a current R process then create one." + (unless (and (buffer-live-p interblock-R-buffer) (get-buffer interblock-R-buffer)) + (save-excursion + (R) + (setf interblock-R-buffer (current-buffer)) + (interblock-R-wait-for-output) + (interblock-R-input-command "")))) + +(defun interblock-R-command-to-string (command) + "Send a command to R, and return the results as a string." + (interblock-R-input-command command) + (interblock-R-last-output)) + +(defun interblock-R-input-command (command) + "Pass COMMAND to the R process running in `interblock-R-buffer'." + (save-excursion + (save-match-data + (set-buffer interblock-R-buffer) + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert command) + (comint-send-input) + (interblock-R-wait-for-output)))) + +(defun interblock-R-wait-for-output () + "Wait until output arrives" + (save-excursion + (save-match-data + (set-buffer interblock-R-buffer) + (while (progn + (goto-char comint-last-input-end) + (not (re-search-forward comint-prompt-regexp nil t))) + (accept-process-output (get-buffer-process (current-buffer))))))) + +(defun interblock-R-last-output () + "Return the last R output as a string" + (save-excursion + (save-match-data + (set-buffer interblock-R-buffer) + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (forward-line 0) + (let ((raw (buffer-substring comint-last-input-end (- (point) 1)))) + (if (string-match "\n" raw) + raw + (and (string-match "\\[[[:digit:]+]\\] *\\(.*\\)$" raw) + (message raw) + (message (match-string 1 raw)) + (match-string 1 raw))))))) + +(provide 'org-exp-blocks) + +;;; org-exp-blocks.el ends here diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el index 501e7620851..53264d30d47 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -28,16 +28,19 @@ (require 'org) (require 'org-agenda) +(require 'org-exp-blocks) (eval-and-compile (require 'cl)) -(declare-function org-export-latex-preprocess "org-export-latex" ()) +(declare-function org-export-latex-preprocess "org-latex" (parameters)) +(declare-function org-export-ascii-preprocess "org-ascii" (parameters)) +(declare-function org-export-html-preprocess "org-html" (parameters)) +(declare-function org-export-docbook-preprocess "org-docbook" (parameters)) (declare-function org-agenda-skip "org-agenda" ()) (declare-function org-infojs-options-inbuffer-template "org-jsinfo" ()) -(declare-function htmlize-region "ext:htmlize" (beg end)) -(declare-function org-id-find-id-file "org-id" (id)) -(defvar htmlize-buffer-places) ; from htmlize.el - +(declare-function org-export-htmlize-region-for-paste "org-html" (beg end)) +(declare-function htmlize-buffer "htmlize" (&optional buffer)) +(autoload 'org-export-generic "org-export-generic" "Export using the generic exporter" t) (defgroup org-export nil "Options for exporting org-listings." :tag "Org Export" @@ -48,9 +51,33 @@ :tag "Org Export General" :group 'org-export) +(defcustom org-export-allow-BIND 'confirm + "Non-nil means, allow #+BIND to define local variable values for export. +This is a potential security risk, which is why the user must confirm the +use of these lines." + :group 'org-export-general + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Make the user confirm for each file" confirm))) + ;; FIXME (defvar org-export-publishing-directory nil) +(defcustom org-export-show-temporary-export-buffer t + "Non-nil means, show buffer after exporting to temp buffer. +When Org exports to a file, the buffer visiting that file is ever +shown, but remains buried. However, when exporting to a temporary +buffer, that buffer is popped up in a second window. When this variable +is nil, the buffer remains buried also in these cases." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-copy-to-kill-ring t + "Non-nil means, exported stuff will also be pushed onto the kill ring." + :group 'org-export-general + :type 'boolean) + (defcustom org-export-run-in-background nil "Non-nil means export and publishing commands will run in background. This works by starting up a separate Emacs process visiting the same file @@ -66,7 +93,6 @@ force an export command into the current process." :group 'org-export-general :type 'boolean) - (defcustom org-export-select-tags '("export") "Tags that select a tree for export. If any such tag is found in a buffer, all trees that do not carry one @@ -84,6 +110,17 @@ This is without condition, so even subtrees inside that carry one of the :group 'org-export-general :type '(repeat (string :tag "Tag"))) +;; FIXME: rename, this is a general variable +(defcustom org-export-html-expand t + "Non-nil means, for HTML export, treat @<...> as HTML tag. +When nil, these tags will be exported as plain text and therefore +not be interpreted by a browser. + +This option can also be set with the +OPTIONS line, e.g. \"@:nil\"." + :group 'org-export-html + :group 'org-export-general + :type 'boolean) + (defcustom org-export-with-special-strings t "Non-nil means, interpret \"\-\", \"--\" and \"---\" for export. When this option is turned on, these strings will be exported as: @@ -99,6 +136,18 @@ This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." :group 'org-export-translation :type 'boolean) +(defcustom org-export-html-link-up "" + "Where should the \"UP\" link of exported HTML pages lead?" + :group 'org-export-html + :group 'org-export-general + :type '(string :tag "File or URL")) + +(defcustom org-export-html-link-home "" + "Where should the \"HOME\" link of exported HTML pages lead?" + :group 'org-export-html + :group 'org-export-general + :type '(string :tag "File or URL")) + (defcustom org-export-language-setup '(("en" "Author" "Date" "Table of Contents" "Footnotes") ("ca" "Autor" "Data" "Índex" "Peus de pàgina") @@ -136,6 +185,16 @@ This should have an association in `org-export-language-setup'." :group 'org-export-general :type 'string) +(defvar org-export-page-description "" + "The page description, for the XHTML meta tag. +This is best set with the #+DESCRIPTION line in a file, it does not make +sense to set this globally.") + +(defvar org-export-page-keywords "" + "The page description, for the XHTML meta tag. +This is best set with the #+KEYWORDS line in a file, it does not make +sense to set this globally.") + (defcustom org-export-skip-text-before-1st-heading nil "Non-nil means, skip all text before the first headline when exporting. When nil, that text is exported as well." @@ -150,7 +209,7 @@ this setting. This option can also be set with the +OPTIONS line, e.g. \"H:2\"." :group 'org-export-general - :type 'number) + :type 'integer) (defcustom org-export-with-section-numbers t "Non-nil means, add section numbers to headlines when exporting. @@ -269,7 +328,7 @@ e.g. \"timestamp:nil\"." :type 'boolean) (defcustom org-export-remove-timestamps-from-toc t - "If nil, remove timestamps from the table of contents entries." + "If t, remove timestamps from the table of contents entries." :group 'org-export-general :type 'boolean) @@ -310,6 +369,11 @@ This is run after selection of trees to be exported has happened. This selection includes tags-based selection, as well as removal of commented and archived trees.") +(defvar org-export-preprocess-after-blockquote-hook nil + "Hook for preprocessing an export buffer. +This is run after blockquote/quote/verse/center have been marked +with cookies.") + (defvar org-export-preprocess-before-backend-specifics-hook nil "Hook run before backend-specific functions are called during preprocessing.") @@ -342,19 +406,6 @@ This option can also be set with the +OPTIONS line, e.g. \"f:nil\"." :group 'org-export-translation :type 'boolean) -(defcustom org-export-html-footnotes-section "<div id=\"footnotes\"> -<h2 class=\"footnotes\">%s: </h2> -<div id=\"text-footnotes\"> -%s -</div> -</div>" - "Format for the footnotes section. -Should contain a two instances of %s. The first will be replaced with the -language-specific word for \"Footnotes\", the second one will be replaced -by the footnotes themselves." - :group 'org-export-html - :type 'string) - (defcustom org-export-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 @@ -404,7 +455,10 @@ the first non-white thing on a line. It will also find the math delimiters like $a=b$ and \\( a=b \\) for inline math, $$a=b$$ and \\[ a=b \\] for display math. -This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\"." +This option can also be set with the +OPTIONS line, e.g. \"LaTeX:t\". + +The default is nil, because this option needs the `dvipng' program which +is not available on all systems." :group 'org-export-translation :group 'org-export-latex :type 'boolean) @@ -477,405 +531,32 @@ much faster." :group 'org-export-tables :type 'boolean) -(defgroup org-export-ascii nil - "Options specific for ASCII export of Org-mode files." - :tag "Org Export ASCII" - :group 'org-export) - -(defcustom org-export-ascii-underline '(?\$ ?\# ?^ ?\~ ?\= ?\-) - "Characters for underlining headings in ASCII export. -In the given sequence, these characters will be used for level 1, 2, ..." - :group 'org-export-ascii - :type '(repeat character)) - -(defcustom org-export-ascii-bullets '(?* ?+ ?-) - "Bullet characters for headlines converted to lists in ASCII export. -The first character is used for the first lest level generated in this -way, and so on. If there are more levels than characters given here, -the list will be repeated. -Note that plain lists will keep the same bullets as the have in the -Org-mode file." - :group 'org-export-ascii - :type '(repeat character)) (defgroup org-export-xml nil "Options specific for XML export of Org-mode files." :tag "Org Export XML" :group 'org-export) -(defgroup org-export-html nil - "Options specific for HTML export of Org-mode files." - :tag "Org Export HTML" - :group 'org-export) - -(defcustom org-export-html-coding-system nil - "Coding system for HTML export, defaults to buffer-file-coding-system." - :group 'org-export-html - :type 'coding-system) - -(defcustom org-export-html-extension "html" - "The extension for exported HTML files." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-link-up "" - "Where should the \"UP\" link of exported HTML pages lead?" - :group 'org-export-html - :type '(string :tag "File or URL")) - -(defcustom org-export-html-link-home "" - "Where should the \"HOME\" link of exported HTML pages lead?" - :group 'org-export-html - :type '(string :tag "File or URL")) - -(defconst org-export-html-scripts -"<script type=\"text/javascript\"> -<!--/*--><![CDATA[/*><!--*/ - function CodeHighlightOn(elem, id) - { - var target = document.getElementById(id); - if(null != target) { - elem.cacheClassElem = elem.className; - elem.cacheClassTarget = target.className; - target.className = \"code-highlighted\"; - elem.className = \"code-highlighted\"; - } - } - function CodeHighlightOff(elem, id) - { - var target = document.getElementById(id); - if(elem.cacheClassElem) - elem.className = elem.cacheClassElem; - if(elem.cacheClassTarget) - target.className = elem.cacheClassTarget; - } -/*]]>*/--> -</script>" -"Basic javascript that is needed by HTML files produced by Org-mode.") - -(defconst org-export-html-style-default -"<style type=\"text/css\"> - <!--/*--><![CDATA[/*><!--*/ - html { font-family: Times, serif; font-size: 12pt; } - .title { text-align: center; } - .todo { color: red; } - .done { color: green; } - .tag { background-color:lightblue; font-weight:normal } - .target { } - .timestamp { color: grey } - .timestamp-kwd { color: CadetBlue } - p.verse { margin-left: 3% } - pre { - border: 1pt solid #AEBDCC; - background-color: #F3F5F7; - padding: 5pt; - font-family: courier, monospace; - font-size: 90%; - overflow:auto; - } - table { border-collapse: collapse; } - td, th { vertical-align: top; } - dt { font-weight: bold; } - div.figure { padding: 0.5em; } - div.figure p { text-align: center; } - .linenr { font-size:smaller } - .code-highlighted {background-color:#ffff00;} - .org-info-js_info-navigation { border-style:none; } - #org-info-js_console-label { font-size:10px; font-weight:bold; - white-space:nowrap; } - .org-info-js_search-highlight {background-color:#ffff00; color:#000000; - font-weight:bold; } - /*]]>*/--> -</style>" - "The default style specification for exported HTML files. -Please use the variables `org-export-html-style' and -`org-export-html-style-extra' to add to this style. If you wish to not -have the default style included, customize the variable -`org-export-html-style-include-default'.") - -(defcustom org-export-html-style-include-default t - "Non-nil means, include the default style in exported HTML files. -The actual style is defined in `org-export-html-style-default' and should -not be modified. Use the variables `org-export-html-style' to add -your own style information." - :group 'org-export-html - :type 'boolean) -;;;###autoload -(put 'org-export-html-style 'safe-local-variable 'booleanp) - -(defcustom org-export-html-style "" - "Org-wide style definitions for exported HTML files. - -This variable needs to contain the full HTML structure to provide a style, -including the surrounding HTML tags. If you set the value of this variable, -you should consider to include definitions for the following classes: - title, todo, done, timestamp, timestamp-kwd, tag, target. - -For example, a valid value would be: - - <style type=\"text/css\"> - <![CDATA[ - p { font-weight: normal; color: gray; } - h1 { color: black; } - .title { text-align: center; } - .todo, .timestamp-kwd { color: red; } - .done { color: green; } - ]]> - </style> - -If you'd like to refer to en external style file, use something like - - <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> - -As the value of this option simply gets inserted into the HTML <head> header, -you can \"misuse\" it to add arbitrary text to the header. -See also the variable `org-export-html-style-extra'." - :group 'org-export-html - :type 'string) -;;;###autoload -(put 'org-export-html-style 'safe-local-variable 'stringp) - -(defcustom org-export-html-style-extra "" - "Additional style information for HTML export. -The value of this variable is inserted into the HTML buffer right after -the value of `org-export-html-style'. Use this variable for per-file -settings of style information, and do not forget to surround the style -settings with <style>...</style> tags." - :group 'org-export-html - :type 'string) -;;;###autoload -(put 'org-export-html-style-extra 'safe-local-variable 'stringp) - - -(defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n" - "Format for typesetting the document title in HTML export." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-toplevel-hlevel 2 - "The <H> level for level 1 headings in HTML export." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-link-org-files-as-html t - "Non-nil means, make file links to `file.org' point to `file.html'. -When org-mode is exporting an org-mode file to HTML, links to -non-html files are directly put into a href tag in HTML. -However, links to other Org-mode files (recognized by the -extension `.org.) should become links to the corresponding html -file, assuming that the linked org-mode file will also be -converted to HTML. -When nil, the links still point to the plain `.org' file." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-inline-images 'maybe - "Non-nil means, inline images into exported HTML pages. -This is done using an <img> tag. When nil, an anchor with href is used to -link to the image. If this option is `maybe', then images in links with -an empty description will be inlined, while images with a description will -be linked only." - :group 'org-export-html - :type '(choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "When there is no description" maybe))) - -(defcustom org-export-html-inline-image-extensions - '("png" "jpeg" "jpg" "gif") - "Extensions of image files that can be inlined into HTML." - :group 'org-export-html - :type '(repeat (string :tag "Extension"))) - -;; FIXME: rename -(defcustom org-export-html-expand t - "Non-nil means, for HTML export, treat @<...> as HTML tag. -When nil, these tags will be exported as plain text and therefore -not be interpreted by a browser. - -This option can also be set with the +OPTIONS line, e.g. \"@:nil\"." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-table-tag - "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">" - "The HTML tag that is used to start a table. -This must be a <table> tag, but you may change the options like -borders and spacing." - :group 'org-export-html - :type 'string) - -(defcustom org-export-table-header-tags '("<th>" . "</th>") - "The opening tag for table header fields. -This is customizable so that alignment options can be specified." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-table-data-tags '("<td>" . "</td>") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(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." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-html-helper-timestamp - "<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n" - "The HTML tag used as timestamp delimiter for HTML-helper-mode." - :group 'org-export-html - :type 'string) - -(defgroup org-export-htmlize nil - "Options for processing examples with htmlize.el." - :tag "Org Export Htmlize" - :group 'org-export-html) - -(defcustom org-export-htmlize-output-type 'inline-css - "Output type to be used by htmlize when formatting code snippets. -Normally this is `inline-css', but if you have defined to appropriate -classes in your css style file, setting this to `css' means that the -fontification will use the class names. -See also the function `org-export-htmlize-generate-css'." - :group 'org-export-htmlize - :type '(choice (const css) (const inline-css))) - -(defcustom org-export-htmlize-css-font-prefix "org-" - "The prefix for CSS class names for htmlize font specifications." - :group 'org-export-htmlize - :type 'string) - -(defgroup org-export-icalendar nil - "Options specific for iCalendar export of Org-mode files." - :tag "Org Export iCalendar" - :group 'org-export) - -(defcustom org-combined-agenda-icalendar-file "~/org.ics" - "The file name for the iCalendar file covering all agenda files. -This file is created with the command \\[org-export-icalendar-all-agenda-files]. -The file name should be absolute, the file will be overwritten without warning." - :group 'org-export-icalendar - :type 'file) - -(defcustom org-icalendar-combined-name "OrgMode" - "Calendar name for the combined iCalendar representing all agenda files." - :group 'org-export-icalendar - :type 'string) - -(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due) - "Contexts where iCalendar export should use a deadline time stamp. -This is a list with several symbols in it. Valid symbol are: - -event-if-todo Deadlines in TODO entries become calendar events. -event-if-not-todo Deadlines in non-TODO entries become calendar events. -todo-due Use deadlines in TODO entries as due-dates" - :group 'org-export-icalendar - :type '(set :greedy t - (const :tag "Deadlines in non-TODO entries become events" - event-if-not-todo) - (const :tag "Deadline in TODO entries become events" - event-if-todo) - (const :tag "Deadlines in TODO entries become due-dates" - todo-due))) - -(defcustom org-icalendar-use-scheduled '(todo-start) - "Contexts where iCalendar export should use a scheduling time stamp. -This is a list with several symbols in it. Valid symbol are: - -event-if-todo Scheduling time stamps in TODO entries become an event. -event-if-not-todo Scheduling time stamps in non-TODO entries become an event. -todo-start Scheduling time stamps in TODO entries become start date. - Some calendar applications show TODO entries only after - that date." - :group 'org-export-icalendar - :type '(set :greedy t - (const :tag - "SCHEDULED timestamps in non-TODO entries become events" - event-if-not-todo) - (const :tag "SCHEDULED timestamps in TODO entries become events" - event-if-todo) - (const :tag "SCHEDULED in TODO entries become start date" - todo-start))) - -(defcustom org-icalendar-categories '(local-tags category) - "Items that should be entered into the categories field. -This is a list of symbols, the following are valid: - -category The Org-mode category of the current file or tree -todo-state The todo state, if any -local-tags The tags, defined in the current line -all-tags All tags, including inherited ones." - :group 'org-export-icalendar - :type '(repeat - (choice - (const :tag "The file or tree category" category) - (const :tag "The TODO state" todo-state) - (const :tag "Tags defined in current line" local-tags) - (const :tag "All tags, including inherited ones" all-tags)))) - -(defcustom org-icalendar-include-todo nil - "Non-nil means, export to iCalendar files should also cover TODO items." - :group 'org-export-icalendar - :type '(choice - (const :tag "None" nil) - (const :tag "Unfinished" t) - (const :tag "All" all))) - -(defcustom org-icalendar-include-sexps t - "Non-nil means, export to iCalendar files should also cover sexp entries. -These are entries like in the diary, but directly in an Org-mode file." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-include-body 100 - "Amount of text below headline to be included in iCalendar export. -This is a number of characters that should maximally be included. -Properties, scheduling and clocking lines will always be removed. -The text will be inserted into the DESCRIPTION field." - :group 'org-export-icalendar - :type '(choice - (const :tag "Nothing" nil) - (const :tag "Everything" t) - (integer :tag "Max characters"))) - -(defcustom org-icalendar-store-UID nil - "Non-nil means, store any created UIDs in properties. -The iCalendar standard requires that all entries have a unique identifier. -Org will create these identifiers as needed. When this variable is non-nil, -the created UIDs will be stored in the ID property of the entry. Then the -next time this entry is exported, it will be exported with the same UID, -superceding the previous form of it. This is essential for -synchronization services. -This variable is not turned on by default because we want to avoid creating -a property drawer in every entry if people are only playing with this feature, -or if they are only using it locally." - :group 'org-export-icalendar - :type 'boolean) - ;;;; Exporting ;;; Variables, constants, and parameter plists (defconst org-level-max 20) -(defvar org-export-html-preamble nil - "Preamble, to be inserted just before <body>. Set by publishing functions.") -(defvar org-export-html-postamble nil - "Preamble, to be inserted just after </body>. Set by publishing functions.") -(defvar org-export-html-auto-preamble t - "Should default preamble be inserted? Set by publishing functions.") -(defvar org-export-html-auto-postamble t - "Should default postamble be inserted? Set by publishing functions.") (defvar org-current-export-file nil) ; dynamically scoped parameter (defvar org-current-export-dir nil) ; dynamically scoped parameter +(defvar org-export-opt-plist nil + "Contains the current option plist.") +(defvar org-last-level nil) ; dynamically scoped variable +(defvar org-min-level nil) ; dynamically scoped variable +(defvar org-levels-open nil) ; dynamically scoped parameter (defconst org-export-plist-vars '((:link-up nil org-export-html-link-up) (:link-home nil org-export-html-link-home) (:language nil org-export-default-language) + (:keywords nil org-export-page-keywords) + (:description nil org-export-page-description) (:customtime nil org-display-custom-times) (:headline-levels "H" org-export-headline-levels) (:section-numbers "num" org-export-with-section-numbers) @@ -902,12 +583,14 @@ or if they are only using it locally." (:tables "|" org-export-with-tables) (:table-auto-headline nil org-export-highlight-first-table-line) (:style-include-default nil org-export-html-style-include-default) + (:style-include-scripts nil org-export-html-style-include-scripts) (:style nil org-export-html-style) (:style-extra nil org-export-html-style-extra) (:agenda-style nil org-agenda-export-html-style) (:convert-org-links nil org-export-html-link-org-files-as-html) (:inline-images nil org-export-html-inline-images) (:html-extension nil org-export-html-extension) + (:xml-declaration nil org-export-html-xml-declaration) (:html-table-tag nil org-export-html-table-tag) (:expand-quoted-html "@" org-export-html-expand) (:timestamp nil org-export-html-with-timestamp) @@ -919,21 +602,29 @@ or if they are only using it locally." (:author nil user-full-name) (:email nil user-mail-address) (:select-tags nil org-export-select-tags) - (:exclude-tags nil org-export-exclude-tags)) + (:exclude-tags nil org-export-exclude-tags) + + (:latex-image-options nil org-export-latex-image-default-option)) "List of properties that represent export/publishing variables. Each element is a list of 3 items: 1. The property that is used internally, and also for org-publish-project-alist 2. The string that can be used in the OPTION lines to set this option, or nil if this option cannot be changed in this way 3. The customization variable that sets the default for this option." - ) (defun org-default-export-plist () "Return the property list with default settings for the export variables." - (let ((l org-export-plist-vars) rtn e) + (let* ((infile (org-infile-export-plist)) + (letbind (plist-get infile :let-bind)) + (l org-export-plist-vars) rtn e s v) (while (setq e (pop l)) - (setq rtn (cons (car e) (cons (symbol-value (nth 2 e)) rtn)))) + (setq s (nth 2 e) + v (cond + ((assq s letbind) (nth 1 (assq s letbind))) + ((boundp s) (symbol-value s)) + (t nil)) + rtn (cons (car e) (cons v rtn)))) rtn)) (defvar org-export-inbuffer-options-extra nil @@ -965,10 +656,11 @@ modified) list.") (append '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE" "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE" "LATEX_HEADER" - "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS") + "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS" + "KEYWORDS" "DESCRIPTION" "MACRO" "BIND") (mapcar 'car org-export-inbuffer-options-extra)))) p key val text options a pr style - latex-header + latex-header macros letbind ext-setup-or-nil setup-contents (start 0)) (while (or (and ext-setup-or-nil (string-match re ext-setup-or-nil start) @@ -985,6 +677,9 @@ modified) list.") ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) ((string-equal key "EMAIL") (setq p (plist-put p :email val))) ((string-equal key "DATE") (setq p (plist-put p :date val))) + ((string-equal key "KEYWORDS") (setq p (plist-put p :keywords val))) + ((string-equal key "DESCRIPTION") + (setq p (plist-put p :description val))) ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) ((string-equal key "STYLE") (setq style (concat style "\n" val))) @@ -994,6 +689,8 @@ modified) list.") (setq text (if text (concat text "\n" val) val))) ((string-equal key "OPTIONS") (setq options (concat val " " options))) + ((string-equal key "BIND") + (push (read (concat "(" val ")")) letbind)) ((string-equal key "LINK_UP") (setq p (plist-put p :link-up val))) ((string-equal key "LINK_HOME") @@ -1002,6 +699,8 @@ modified) list.") (setq p (plist-put p :select-tags (org-split-string val)))) ((string-equal key "EXPORT_EXCLUDE_TAGS") (setq p (plist-put p :exclude-tags (org-split-string val)))) + ((string-equal key "MACRO") + (push val macros)) ((equal key "SETUPFILE") (setq setup-contents (org-file-contents (expand-file-name @@ -1015,13 +714,55 @@ modified) list.") "\n" setup-contents "\n" (substring ext-setup-or-nil start))))))) (setq p (plist-put p :text text)) + (when (and letbind (org-export-confirm-letbind)) + (setq p (plist-put p :let-bind letbind))) (when style (setq p (plist-put p :style-extra style))) (when latex-header (setq p (plist-put p :latex-header-extra (substring latex-header 1)))) (when options (setq p (org-export-add-options-to-plist p options))) + ;; Add macro definitions + (setq p (plist-put p :macro-date "(eval (format-time-string \"$1\"))")) + (setq p (plist-put p :macro-time "(eval (format-time-string \"$1\"))")) + (setq p (plist-put + p :macro-modification-time + (and (buffer-file-name) + (file-exists-p (buffer-file-name)) + (concat + "(eval (format-time-string \"$1\" '" + (prin1-to-string (nth 5 (file-attributes + (buffer-file-name)))) + "))")))) + (setq p (plist-put p :macro-input-file (and (buffer-file-name) + (file-name-nondirectory + (buffer-file-name))))) + (while (setq val (pop macros)) + (when (string-match "^\\([-a-zA-Z0-9_]+\\)[ \t]+\\(.*?[ \t]*$\\)" val) + (setq p (plist-put + p (intern + (concat ":macro-" (downcase (match-string 1 val)))) + (match-string 2 val))))) p)))) +(defvar org-export-allow-BIND-local nil) +(defun org-export-confirm-letbind () + "Can we use #+BIND values during export? +By default this will ask fro confirmation by the user, to divert possible +security risks." + (cond + ((not org-export-allow-BIND) nil) + ((eq org-export-allow-BIND t) t) + ((local-variable-p 'org-export-allow-BIND-local (current-buffer)) + org-export-allow-BIND-local) + (t (org-set-local 'org-export-allow-BIND-local + (yes-or-no-p "Allow BIND values in this buffer? "))))) + +(defun org-install-letbind () + "Install the values from #+BIND lines as local variables." + (let ((letbind (plist-get org-export-opt-plist :let-bind))) + (while letbind + (org-set-local (caar letbind) (nth 1 (pop letbind)))))) + (defun org-export-add-options-to-plist (p options) "Parse an OPTIONS line and set values in the property list P." (let (o) @@ -1048,6 +789,10 @@ modified) list.") ;; (setq p (plist-put p :title a))) (when (setq a (org-entry-get pos "EXPORT_TEXT")) (setq p (plist-put p :text a))) + (when (setq a (org-entry-get pos "EXPORT_AUTHOR")) + (setq p (plist-put p :author a))) + (when (setq a (org-entry-get pos "EXPORT_DATE")) + (setq p (plist-put p :date a))) (when (setq a (org-entry-get pos "EXPORT_OPTIONS")) (setq p (org-export-add-options-to-plist p a))))) p)) @@ -1080,36 +825,40 @@ value of `org-export-run-in-background'." (help "[t] insert the export option template \[v] limit export to visible part of outline tree -\[a] export as ASCII +\[a] export as ASCII [A] to temporary buffer -\[h] export as HTML -\[H] export as HTML to temporary buffer -\[R] export region as HTML -\[b] export as HTML and browse immediately -\[x] export as XOXO +\[h] export as HTML [H] to temporary buffer [R] export region +\[b] export as HTML and open in browser -\[l] export as LaTeX +\[l] export as LaTeX [L] to temporary buffer \[p] export as LaTeX and process to PDF \[d] export as LaTeX, process to PDF, and open the resulting PDF document -\[L] export as LaTeX to temporary buffer + +\[D] export as DocBook +\[V] export as DocBook, process to PDF, and open the resulting PDF document + +\[x] export as XOXO +\[g] export using Wes Hardaker's generic exporter \[i] export current file as iCalendar file \[I] export all agenda files as iCalendar files \[c] export agenda files into combined iCalendar file -\[F] publish current file -\[P] publish current project -\[X] publish... (project will be prompted for) -\[A] publish all projects") +\[F] publish current file [P] publish current project +\[X] publish a project... [E] publish every projects") (cmds '((?t org-insert-export-options-template nil) (?v org-export-visible nil) (?a org-export-as-ascii t) + (?A org-export-as-ascii-to-buffer t) (?h org-export-as-html t) (?b org-export-as-html-and-open t) (?H org-export-as-html-to-buffer nil) (?R org-export-region-as-html nil) (?x org-export-as-xoxo t) + (?g org-export-generic t) + (?D org-export-as-docbook t) + (?V org-export-as-docbook-pdf-and-open t) (?l org-export-as-latex t) (?p org-export-as-pdf t) (?d org-export-as-pdf-and-open t) @@ -1120,16 +869,17 @@ value of `org-export-run-in-background'." (?F org-publish-current-file t) (?P org-publish-current-project t) (?X org-publish t) - (?A org-publish-all t))) + (?E org-publish-all t))) r1 r2 ass) - (save-window-excursion - (delete-other-windows) - (with-output-to-temp-buffer "*Org Export/Publishing Help*" - (princ help)) - (org-fit-window-to-buffer (get-buffer-window - "*Org Export/Publishing Help*")) - (message "Select command: ") - (setq r1 (read-char-exclusive))) + (save-excursion + (save-window-excursion + (delete-other-windows) + (with-output-to-temp-buffer "*Org Export/Publishing Help*" + (princ help)) + (org-fit-window-to-buffer (get-buffer-window + "*Org Export/Publishing Help*")) + (message "Select command: ") + (setq r1 (read-char-exclusive)))) (setq r2 (if (< r1 27) (+ r1 96) r1)) (unless (setq ass (assq r2 cmds)) (error "No command associated with key %c" r1)) @@ -1176,6 +926,7 @@ value of `org-export-run-in-background'." ("reg") ("macr") ("deg") + ("pm" . "±") ("plusmn") ("sup2") ("sup3") @@ -1461,6 +1212,8 @@ translations. There is currently no way for users to extend this.") (defvar org-export-target-aliases nil "Alist of targets with invisible aliases.") +(defvar org-export-preferred-target-alist nil + "Alist of section id's with preferred aliases.") (defvar org-export-code-refs nil "Alist of code references and line numbers") @@ -1474,8 +1227,11 @@ on this string to produce the exported version." (let* ((htmlp (plist-get parameters :for-html)) (asciip (plist-get parameters :for-ascii)) (latexp (plist-get parameters :for-LaTeX)) - (backend (cond (htmlp 'html) (latexp 'latex) (asciip 'ascii))) - + (docbookp (plist-get parameters :for-docbook)) + (backend (cond (htmlp 'html) + (latexp 'latex) + (asciip 'ascii) + (docbookp 'docbook))) (archived-trees (plist-get parameters :archived-trees)) (inhibit-read-only t) (drawers org-drawers) @@ -1483,6 +1239,7 @@ on this string to produce the exported version." target-alist rtn) (setq org-export-target-aliases nil) + (setq org-export-preferred-target-alist nil) (setq org-export-code-refs nil) (with-current-buffer (get-buffer-create " org-mode-tmp") @@ -1497,10 +1254,15 @@ on this string to produce the exported version." (let ((org-inhibit-startup t)) (org-mode)) (setq case-fold-search t) + (org-install-letbind) ;; Call the hook (run-hooks 'org-export-preprocess-hook) + ;; Process the macros + (org-export-preprocess-apply-macros) + (run-hooks 'org-export-preprocess-after-macros-hook) + (untabify (point-min) (point-max)) ;; Handle include files, and call a hook @@ -1560,14 +1322,17 @@ on this string to produce the exported version." ;; Protect quoted subtrees (org-export-protect-quoted-subtrees) + ;; Remove clock lines + (org-export-remove-clock-lines) + ;; Protect verbatim elements (org-export-protect-verbatim) - ;; Blockquotes and verse - (org-export-mark-blockquote-and-verse) + ;; Blockquotes, verse, and center + (org-export-mark-blockquote-verse-center) + (run-hooks 'org-export-preprocess-after-blockquote-hook) ;; Remove timestamps, if the user has requested so - (org-export-remove-clock-lines) (unless (plist-get parameters :timestamps) (org-export-remove-timestamps)) @@ -1603,17 +1368,22 @@ on this string to produce the exported version." ;; LaTeX-specific preprocessing (when latexp - (require 'org-export-latex nil) - (org-export-latex-preprocess)) + (require 'org-latex nil) + (org-export-latex-preprocess parameters)) ;; ASCII-specific preprocessing (when asciip - (org-export-ascii-preprocess)) + (org-export-ascii-preprocess parameters)) ;; HTML-specific preprocessing (when htmlp (org-export-html-preprocess parameters)) + ;; DocBook-specific preprocessing + (when docbookp + (require 'org-docbook nil) + (org-export-docbook-preprocess parameters)) + ;; Remove or replace comments (org-export-handle-comments (plist-get parameters :comments)) @@ -1639,19 +1409,24 @@ The new targets are added to TARGET-ALIST, which is also returned." (goto-char (point-min)) (org-init-section-numbers) (let ((re (concat "^" org-outline-regexp - "\\| [ \t]*:ID:[ \t]*\\([^ \t\r\n]+\\)")) - level target last-section-target a) + "\\| [ \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 1) + (if (match-end 2) (progn - (push (cons (org-match-string-no-properties 1) - target) target-alist) + (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))) + (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)))) (setq level (org-reduced-level (save-excursion (goto-char (point-at-bol)) (org-outline-level)))) @@ -1705,7 +1480,13 @@ the current file." found props pos cref (target (cond - ((cdr (assoc slink target-alist))) + ((= (string-to-char link) ?#) + ;; user wants exactly this link + link) + ((cdr (assoc slink target-alist)) + (or (cdr (assoc (assoc slink target-alist) + org-export-preferred-target-alist)) + (cdr (assoc slink target-alist)))) ((and (string-match "^id:" link) (cdr (assoc (substring link 3) target-alist)))) ((string-match "^(\\(.*\\))$" link) @@ -1751,10 +1532,20 @@ whose content to keep." (org-delete-all exp-drawers (copy-sequence all-drawers)) "\\|") - "\\):[ \t]*\n\\([^\000]*?\n\\)?[ \t]*:END:[ \t]*\n"))) + "\\):[ \t]*$")) + beg eol) (while (re-search-forward re nil t) (org-if-unprotected - (replace-match "")))))) + (setq beg (match-beginning 0) + eol (match-end 0)) + (if (re-search-forward "^\\([ \t]*:END:[ \t]*\n?\\)\\|^\\*+[ \t]" + nil t) + (if (match-end 1) + ;; terminated in this entry + (progn + (delete-region beg (match-end 1)) + (goto-char beg)) + (goto-char eol)))))))) (defun org-export-handle-export-tags (select-tags exclude-tags) "Modify the buffer, honoring SELECT-TAGS and EXCLUDE-TAGS. @@ -1848,6 +1639,7 @@ from the buffer." (defun org-export-remove-timestamps () "Remove timestamps and keywords for export." + (goto-char (point-min)) (while (re-search-forward org-maybe-keyword-time-regexp nil t) (backward-char 1) (org-if-unprotected @@ -1858,7 +1650,8 @@ from the buffer." (replace-match "")))))) (defun org-export-remove-clock-lines () - "Remove timestamps and keywords for export." + "Remove clock lines for export." + (goto-char (point-min)) (let ((re (concat "^[ \t]*" org-clock-string ".*\n?"))) (while (re-search-forward re nil t) (org-if-unprotected @@ -1897,7 +1690,8 @@ from the buffer." (defun org-export-select-backend-specific-text (backend) (let ((formatters - '((html "HTML" "BEGIN_HTML" "END_HTML") + '((docbook "DOCBOOK" "BEGIN_DOCBOOK" "END_DOCBOOK") + (html "HTML" "BEGIN_HTML" "END_HTML") (ascii "ASCII" "BEGIN_ASCII" "END_ASCII") (latex "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) (case-fold-search t) @@ -1908,17 +1702,17 @@ from the buffer." (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 "^#\\+" (cadr fmt) + (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" (cadr fmt) ":[ \t]*\\(.*\\)") nil t) - (replace-match "\\1" t) + (replace-match "\\1\\2" t) (add-text-properties (point-at-bol) (min (1+ (point-at-eol)) (point-max)) '(org-protected t)))) (goto-char (point-min)) (while (re-search-forward - (concat "^#\\+" - (caddr fmt) "\\>.*\\(\\(\n.*\\)*?\n\\)#\\+" - (cadddr fmt) "\\>.*\n?") nil t) + (concat "^[ \t]*#\\+" (caddr fmt) + "\\>.*\\(\\(\n.*\\)*?\n\\)[ \t]*#\\+" (cadddr fmt) + "\\>.*\n?") nil t) (if (eq (car fmt) backend) ;; yes, keep this (add-text-properties (match-beginning 1) (1+ (match-end 1)) @@ -1926,22 +1720,29 @@ from the buffer." ;; No, this is for a different backend, kill it (delete-region (match-beginning 0) (match-end 0))))))) -(defun org-export-mark-blockquote-and-verse () +(defun org-export-mark-blockquote-verse-center () "Mark block quote and verse environments with special cookies. These special cookies will later be interpreted by the backend." ;; Blockquotes - (goto-char (point-min)) - (while (re-search-forward "^#\\+\\(begin\\|end\\)_\\(block\\)?quote\\>.*" - nil t) - (replace-match (if (equal (downcase (match-string 1)) "end") - "ORG-BLOCKQUOTE-END" "ORG-BLOCKQUOTE-START") - t t)) - ;; Verse - (goto-char (point-min)) - (while (re-search-forward "^#\\+\\(begin\\|end\\)_verse\\>.*" nil t) - (replace-match (if (equal (downcase (match-string 1)) "end") - "ORG-VERSE-END" "ORG-VERSE-START") - t t))) + (let (type t1 ind beg end beg1 end1 content) + (goto-char (point-min)) + (while (re-search-forward + "^\\([ \t]*\\)#\\+\\(begin_\\(\\(block\\)?quote\\|verse\\|center\\)\\>.*\\)" + nil t) + (setq ind (length (match-string 1)) + type (downcase (match-string 3)) + t1 (if (equal type "quote") "blockquote" type)) + (setq beg (match-beginning 0) + beg1 (1+ (match-end 0))) + (when (re-search-forward (concat "^[ \t]*#\\+end_" type "\\>.*") nil t) + (setq end (1+ (point-at-eol)) + end1 (1- (match-beginning 0))) + (setq content (org-remove-indentation (buffer-substring beg1 end1))) + (setq content (concat "ORG-" (upcase t1) "-START\n" + content "\n" + "ORG-" (upcase t1) "-END\n")) + (delete-region beg end) + (insert (org-add-props content nil 'original-indentation ind)))))) (defun org-export-attach-captions-and-attributes (backend target-alist) "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties. @@ -1951,11 +1752,11 @@ table line. If it is a link, add it to the line containing the link." (remove-text-properties (point-min) (point-max) '(org-caption nil org-attributes nil)) (let ((case-fold-search t) - (re (concat "^#\\+caption:[ \t]+\\(.*\\)" + (re (concat "^[ \t]*#\\+caption:[ \t]+\\(.*\\)" "\\|" - "^#\\+attr_" (symbol-name backend) ":[ \t]+\\(.*\\)" + "^[ \t]*#\\+attr_" (symbol-name backend) ":[ \t]+\\(.*\\)" "\\|" - "^#\\+label:[ \t]+\\(.*\\)" + "^[ \t]*#\\+label:[ \t]+\\(.*\\)" "\\|" "^[ \t]*|[^-]" "\\|" @@ -1997,16 +1798,17 @@ 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 "^#\\(.*\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 commentsp + (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 1)) t t)) + (replace-match (format commentsp (match-string 2)) t t)) (goto-char (1+ pos)) (org-if-unprotected (replace-match "") @@ -2019,8 +1821,12 @@ When it is nil, all comments will be removed." (goto-char (point-min)) (when re-radio (while (re-search-forward re-radio nil t) - (org-if-unprotected - (replace-match "\\1[[\\2]]")))))) + (unless + (save-match-data + (or (org-in-regexp org-bracket-link-regexp) + (org-in-regexp org-plain-link-re))) + (org-if-unprotected + (replace-match "\\1[[\\2]]"))))))) (defun org-export-remove-special-table-lines () "Remove tables lines that are used for internal purposes." @@ -2037,11 +1843,12 @@ When it is nil, all comments will be removed." (defun org-export-normalize-links () "Convert all links to bracket links, and expand link abbreviations." (let ((re-plain-link (concat "\\([^[<]\\)" org-plain-link-re)) - (re-angle-link (concat "\\([^[]\\)" org-angle-link-re))) + (re-angle-link (concat "\\([^[]\\)" org-angle-link-re)) + nodesc) (goto-char (point-min)) (while (re-search-forward re-plain-link nil t) (goto-char (1- (match-end 0))) - (org-if-unprotected + (org-if-unprotected-at (1+ (match-beginning 0)) (let* ((s (concat (match-string 1) "[[" (match-string 2) ":" (match-string 3) "]]"))) ;; added 'org-link face to links @@ -2058,19 +1865,18 @@ When it is nil, all comments will be removed." (goto-char (point-min)) (while (re-search-forward org-bracket-link-regexp nil t) (goto-char (1- (match-end 0))) + (setq nodesc (not (match-end 3))) (org-if-unprotected (let* ((xx (save-match-data (org-translate-link (org-link-expand-abbrev (match-string 1))))) (s (concat "[[" (org-add-props (copy-sequence xx) - nil 'org-protected t) + nil 'org-protected t 'org-no-description nodesc) "]" (if (match-end 3) (match-string 2) - (concat "[" (org-add-props - (copy-sequence xx) - '(org-protected t)) + (concat "[" (copy-sequence xx) "]")) "]"))) (put-text-property 0 (length s) 'face 'org-link s) @@ -2145,13 +1951,14 @@ can work correctly." (a (assoc rtn alist))) (or (cdr a) rtn)))) -(defun org-get-min-level (lines) +(defun org-get-min-level (lines &optional offset) "Get the minimum level in LINES." (let ((re "^\\(\\*+\\) ") l) (catch 'exit (while (setq l (pop lines)) (if (string-match re l) - (throw 'exit (org-tr-level (length (match-string 1 l)))))) + (throw 'exit (org-tr-level (- (length (match-string 1 l)) + (or offset 0)))))) 1))) ;; Variable holding the vector with section numbers @@ -2242,8 +2049,52 @@ TYPE must be a string, any of: (pop roman))) res))) -(org-number-to-roman 1961) +;;; Macros +(defun org-export-preprocess-apply-macros () + "Replace macro references." + (goto-char (point-min)) + (let (sy val key args args2 s n) + (while (re-search-forward + "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\(.*?\\))\\)?}}}" + nil t) + (setq key (downcase (match-string 1)) + args (match-string 3)) + (when (setq val (or (plist-get org-export-opt-plist + (intern (concat ":macro-" key))) + (plist-get org-export-opt-plist + (intern (concat ":" key))))) + (save-match-data + (when args + (setq args (org-split-string args ",[ \t]*") args2 nil) + (while args + (while (string-match "\\\\\\'" (car args)) + ;; repair bad splits + (setcar (cdr args) (concat (substring (car args) 0 -1) + ";" (nth 1 args))) + (pop args)) + (push (pop args) args2)) + (setq args (nreverse args2)) + (setq s 0) + (while (string-match "\\$\\([0-9]+\\)" val s) + (setq s (1+ (match-beginning 0)) + n (string-to-number (match-string 1 val))) + (and (>= (length args) n) + (setq val (replace-match (nth (1- n) args) t t val))))) + (when (string-match "\\`(eval\\>" val) + (setq val (eval (read val)))) + (if (and val (not (stringp val))) + (setq val (format "%s" val)))) + (and (stringp val) + (replace-match val t t)))))) + +(defun org-export-apply-macros-in-string (s) + "Apply the macros in string S." + (when s + (with-temp-buffer + (insert s) + (org-export-preprocess-apply-macros) + (buffer-string)))) ;;; Include files @@ -2275,14 +2126,16 @@ TYPE must be a string, any of: (setq start (format "#+begin_%s %s\n" markup switches) end (format "#+end_%s" markup)))) (insert (or start "")) - (insert (org-get-file-contents (expand-file-name file) prefix prefix1)) + (insert (org-get-file-contents (expand-file-name file) prefix prefix1 markup)) (or (bolp) (newline)) (insert (or end "")))))) -(defun org-get-file-contents (file &optional prefix prefix1) +(defun org-get-file-contents (file &optional prefix prefix1 markup) "Get the contents of FILE and return them as a string. If PREFIX is a string, prepend it to each line. If PREFIX1 -is a string, prepend it to the first line instead of PREFIX." +is a string, prepend it to the first line instead of PREFIX. +If MARKUP, don't protect org-like lines, the exporter will +take care of the block they are in." (with-temp-buffer (insert-file-contents file) (when (or prefix prefix1) @@ -2291,6 +2144,13 @@ is a string, prepend it to the first line instead of PREFIX." (insert (or prefix1 prefix)) (setq prefix1 nil) (beginning-of-line 2))) + (buffer-string) + (unless markup + (goto-char (point-min)) + (while (re-search-forward "^\\(\\*\\|[ \t]*#\\)" nil t) + (goto-char (match-beginning 0)) + (insert ",") + (end-of-line 1))) (buffer-string))) (defun org-get-and-remove-property (listvar prop) @@ -2320,35 +2180,39 @@ in the list) and remove property and value from the list in LISTVAR." "Replace source code segments with special code for export." (setq org-export-last-code-line-counter-value 0) (let ((case-fold-search t) - lang code trans opts) + lang code trans opts indent) (goto-char (point-min)) (while (re-search-forward - "\\(^#\\+BEGIN_SRC:?[ \t]+\\([^ \t\n]+\\)\\(.*\\)\n\\([^\000]+?\n\\)#\\+END_SRC.*\\)\\|\\(^#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)#\\+END_EXAMPLE.*\\)" + "\\(^\\([ \t]*\\)#\\+BEGIN_SRC:?[ \t]+\\([^ \t\n]+\\)\\(.*\\)\n\\([^\000]+?\n\\)[ \t]*#\\+END_SRC.*\\)\\|\\(^\\([ \t]*\\)#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)[ \t]*#\\+END_EXAMPLE.*\\)" nil t) (if (match-end 1) ;; src segments - (setq lang (match-string 2) - opts (match-string 3) - code (match-string 4)) + (setq lang (match-string 3) + opts (match-string 4) + code (match-string 5) + indent (length (match-string 2))) (setq lang nil - opts (match-string 6) - code (match-string 7))) + opts (match-string 8) + code (match-string 9) + indent (length (match-string 7)))) (setq trans (org-export-format-source-code-or-example - backend lang code opts)) + backend lang code opts indent)) (replace-match trans t t)))) (defvar htmlp) ;; dynamically scoped (defvar latexp) ;; dynamically scoped +(defvar org-export-latex-verbatim-wrap) ;; defined in org-latex.el -(defun org-export-format-source-code-or-example (backend - lang code &optional opts) +(defun org-export-format-source-code-or-example + (backend lang code &optional opts indent) "Format CODE from language LANG and return it formatted for export. If LANG is nil, do not add any fontification. OPTS contains formatting optons, like `-n' for triggering numbering lines, and `+n' for continuing previous numering. Code formatting according to language currently only works for HTML. -Numbering lines works for all three major backends (html, latex, and ascii)." +Numbering lines works for all three major backends (html, latex, and ascii). +INDENT was the original indentation of the block." (save-match-data (let (num cont rtn rpllbl keepp textareap cols rows fmt) (setq opts (or opts "") @@ -2369,88 +2233,104 @@ Numbering lines works for all three major backends (html, latex, and ascii)." ;; we cannot use numbering or highlighting. (setq num nil cont nil lang nil)) (if keepp (setq rpllbl 'keep)) - (setq rtn code) - (when (equal lang "org") + (setq rtn (org-remove-indentation code)) + (when (string-match "^," rtn) (setq rtn (with-temp-buffer (insert rtn) ;; Free up the protected lines (goto-char (point-min)) (while (re-search-forward "^," nil t) - (replace-match "") + (if (or (equal lang "org") + (save-match-data + (looking-at "\\([*#]\\|[ \t]*#\\+\\)"))) + (replace-match "")) (end-of-line 1)) (buffer-string)))) ;; Now backend-specific coding - (cond - ((eq backend 'html) - ;; We are exporting to HTML - (when lang - (require 'htmlize nil t) - (when (not (fboundp 'htmlize-region-for-paste)) - ;; we do not have htmlize.el, or an old version of it - (setq lang nil) - (message - "htmlize.el 1.34 or later is needed for source code formatting"))) - - (if lang - (let* ((mode (and lang (intern (concat lang "-mode")))) - (org-inhibit-startup t) - (org-startup-folded nil)) - (setq rtn - (with-temp-buffer - (insert rtn) - (if (functionp mode) - (funcall mode) - (fundamental-mode)) - (font-lock-fontify-buffer) - (org-export-htmlize-region-for-paste - (point-min) (point-max)))) - (if (string-match "<pre\\([^>]*\\)>\n?" rtn) - (setq rtn (replace-match - (format "<pre class=\"src src-%s\">\n" lang) - t t rtn)))) - (if textareap - (setq rtn (concat - (format "<p>\n<textarea cols=\"%d\" rows=\"%d\" overflow-x:scroll >\n" - cols rows) - rtn "</textarea>\n</p>\n")) - (with-temp-buffer - (insert rtn) - (goto-char (point-min)) - (while (re-search-forward "[<>&]" nil t) - (replace-match (cdr (assq (char-before) - '((?&."&")(?<."<")(?>.">")))) - t t)) - (setq rtn (buffer-string))) - (setq rtn (concat "<pre class=\"example\">\n" rtn "</pre>\n")))) - (unless textareap - (setq rtn (org-export-number-lines rtn 'html 1 1 num - cont rpllbl fmt))) - (concat "\n#+BEGIN_HTML\n" (org-add-props rtn '(org-protected t)) "\n#+END_HTML\n\n")) - ((eq backend 'latex) - (setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt)) - (concat "\n#+BEGIN_LaTeX\n" - (org-add-props (concat "\\begin{verbatim}\n" rtn "\n\\end{verbatim}\n") - '(org-protected t)) - "#+END_LaTeX\n\n")) - ((eq backend 'ascii) - ;; This is not HTML or LaTeX, so just make it an example. - (setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt)) - (concat "#+BEGIN_ASCII\n" - (org-add-props - (concat - (mapconcat - (lambda (l) (concat " " l)) - (org-split-string rtn "\n") - "\n") - "\n") - '(org-protected t)) - "#+END_ASCII\n")))))) + (setq rtn + (cond + ((eq backend 'docbook) + (setq rtn (org-export-number-lines rtn 'docbook 0 0 num cont rpllbl fmt)) + (concat "\n#+BEGIN_DOCBOOK\n" + (org-add-props (concat "<programlisting><![CDATA[" + rtn + "]]>\n</programlisting>\n") + '(org-protected t)) + "#+END_DOCBOOK\n")) + ((eq backend 'html) + ;; We are exporting to HTML + (when lang + (require 'htmlize nil t) + (when (not (fboundp 'htmlize-region-for-paste)) + ;; we do not have htmlize.el, or an old version of it + (setq lang nil) + (message + "htmlize.el 1.34 or later is needed for source code formatting"))) + + (if lang + (let* ((mode (and lang (intern (concat lang "-mode")))) + (org-inhibit-startup t) + (org-startup-folded nil)) + (setq rtn + (with-temp-buffer + (insert rtn) + (if (functionp mode) + (funcall mode) + (fundamental-mode)) + (font-lock-fontify-buffer) + (org-src-mode) + (set-buffer-modified-p nil) + (org-export-htmlize-region-for-paste + (point-min) (point-max)))) + (if (string-match "<pre\\([^>]*\\)>\n*" rtn) + (setq rtn (replace-match + (format "<pre class=\"src src-%s\">\n" lang) + t t rtn)))) + (if textareap + (setq rtn (concat + (format "<p>\n<textarea cols=\"%d\" rows=\"%d\" overflow-x:scroll >\n" + cols rows) + rtn "</textarea>\n</p>\n")) + (with-temp-buffer + (insert rtn) + (goto-char (point-min)) + (while (re-search-forward "[<>&]" nil t) + (replace-match (cdr (assq (char-before) + '((?&."&")(?<."<")(?>.">")))) + t t)) + (setq rtn (buffer-string))) + (setq rtn (concat "<pre class=\"example\">\n" rtn "</pre>\n")))) + (unless textareap + (setq rtn (org-export-number-lines rtn 'html 1 1 num + 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")) + ((eq backend 'latex) + (setq rtn (org-export-number-lines rtn 'latex 0 0 num cont rpllbl fmt)) + (concat "\n#+BEGIN_LaTeX\n" + (org-add-props (concat (car org-export-latex-verbatim-wrap) + rtn (cdr org-export-latex-verbatim-wrap)) + '(org-protected t)) + "#+END_LaTeX\n\n")) + ((eq backend 'ascii) + ;; This is not HTML or LaTeX, so just make it an example. + (setq rtn (org-export-number-lines rtn 'ascii 0 0 num cont rpllbl fmt)) + (concat "#+BEGIN_ASCII\n" + (org-add-props + (concat + (mapconcat + (lambda (l) (concat " " l)) + (org-split-string rtn "\n") + "\n") + "\n") + '(org-protected t)) + "#+END_ASCII\n")))) + (org-add-props rtn nil 'original-indentation indent)))) (defun org-export-number-lines (text backend &optional skip1 skip2 number cont replace-labels label-format) - (if (and (not number) (not (eq replace-labels 'keep))) - (setq replace-labels nil)) ;; must use names if no numbers (setq skip1 (or skip1 0) skip2 (or skip2 0)) (if (not cont) (setq org-export-last-code-line-counter-value 0)) (with-temp-buffer @@ -2469,6 +2349,7 @@ Numbering lines works for all three major backends (html, latex, and ascii)." fmt)) ((eq backend 'ascii) fmt) ((eq backend 'latex) fmt) + ((eq backend 'docbook) fmt) (t ""))) (label-format (or label-format org-coderef-label-format)) (label-pre (if (string-match "%s" label-format) @@ -2478,10 +2359,10 @@ Numbering lines works for all three major backends (html, latex, and ascii)." (substring label-format (match-end 0)) "")) (lbl-re - (concat + (concat ".*?\\S-.*?\\([ \t]*\\(" (regexp-quote label-pre) - "\\([-a-zA-Z0-9_]+\\)" + "\\([-a-zA-Z0-9_ ]+\\)" (regexp-quote label-post) "\\)\\)")) ref) @@ -2491,17 +2372,28 @@ Numbering lines works for all three major backends (html, latex, and ascii)." (if number (insert (format fm (incf n))) (forward-char 1)) - (when (and (not (eq replace-labels 'keep)) - (looking-at lbl-re)) + (when (looking-at lbl-re) (setq ref (match-string 3)) - (if replace-labels - (progn - (delete-region (match-beginning 1) (match-end 1)) - (push (cons ref n) org-export-code-refs)) - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 2)) - (insert "(" ref ")") - (push (cons ref (concat "(" ref ")")) org-export-code-refs)) + (cond ((numberp replace-labels) + ;; remove labels; use numbers for references when lines + ;; are numbered, use labels otherwise + (delete-region (match-beginning 1) (match-end 1)) + (push (cons ref (if (> n 0) n ref)) org-export-code-refs)) + ((eq replace-labels 'keep) + ;; don't remove labels; use numbers for references when + ;; lines are numbered, use labels otherwise + (goto-char (match-beginning 2)) + (delete-region (match-beginning 2) (match-end 2)) + (insert "(" ref ")") + (push (cons ref (if (> n 0) n (concat "(" ref ")"))) + org-export-code-refs)) + (t + ;; don't remove labels and don't use numbers for + ;; references + (goto-char (match-beginning 2)) + (delete-region (match-beginning 2) (match-end 2)) + (insert "(" ref ")") + (push (cons ref (concat "(" ref ")")) org-export-code-refs))) (when (eq backend 'html) (save-excursion (beginning-of-line 1) @@ -2514,312 +2406,6 @@ Numbering lines works for all three major backends (html, latex, and ascii)." (newline) (buffer-string)))) -;;; ASCII export - -(defvar org-last-level nil) ; dynamically scoped variable -(defvar org-min-level nil) ; dynamically scoped variable -(defvar org-levels-open nil) ; dynamically scoped parameter -(defvar org-ascii-current-indentation nil) ; For communication - -;;;###autoload -(defun org-export-as-ascii (arg) - "Export the outline as a pretty ASCII file. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -underlined headlines. The default is 3." - (interactive "P") - (setq-default org-todo-line-regexp org-todo-line-regexp) - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend))))) - (opt-plist (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist)) - (custom-times org-display-custom-times) - (org-ascii-current-indentation '(0 . 0)) - (level 0) line txt - (umax nil) - (umax-toc nil) - (case-fold-search nil) - (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) - (filename (concat (file-name-as-directory - (org-export-directory :ascii opt-plist)) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory bfname))) - ".txt")) - (filename (if (equal (file-truename filename) - (file-truename bfname)) - (concat filename ".txt") - filename)) - (buffer (find-file-noselect filename)) - (org-levels-open (make-vector org-level-max nil)) - (odd org-odd-levels-only) - (date (plist-get opt-plist :date)) - (author (plist-get opt-plist :author)) - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (file-name-sans-extension - (file-name-nondirectory bfname)))) - (email (plist-get opt-plist :email)) - (language (plist-get opt-plist :language)) - (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) -; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) - (todo nil) - (lang-words nil) - (region - (buffer-substring - (if (org-region-active-p) (region-beginning) (point-min)) - (if (org-region-active-p) (region-end) (point-max)))) - (lines (org-split-string - (org-export-preprocess-string - region - :for-ascii t - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get opt-plist :drawers) - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :timestamps (plist-get opt-plist :timestamps) - :todo-keywords (plist-get opt-plist :todo-keywords) - :verbatim-multiline t - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :archived-trees - (plist-get opt-plist :archived-trees) - :add-text (plist-get opt-plist :text)) - "\n")) - thetoc have-headings first-heading-pos - table-open table-buffer link desc) - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (setq org-min-level (org-get-min-level lines)) - (setq org-last-level org-min-level) - (org-init-section-numbers) - - (find-file-noselect filename) - - (setq lang-words (or (assoc language org-export-language-setup) - (assoc "en" org-export-language-setup))) - (switch-to-buffer-other-window buffer) - (erase-buffer) - (fundamental-mode) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (org-set-local 'org-odd-levels-only odd) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc (if (integerp org-export-with-toc) - (min org-export-with-toc umax) - umax)) - - ;; File header - (if title (org-insert-centered title ?=)) - (insert "\n") - (if (and (or author email) - org-export-author-info) - (insert (concat (nth 1 lang-words) ": " (or author "") - (if email (concat " <" email ">") "") - "\n"))) - - (cond - ((and date (string-match "%" date)) - (setq date (format-time-string date))) - (date) - (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) - - (if (and date org-export-time-stamp-file) - (insert (concat (nth 2 lang-words) ": " date"\n"))) - - (insert "\n\n") - - (if org-export-with-toc - (progn - (push (concat (nth 3 lang-words) "\n") thetoc) - (push (concat (make-string (string-width (nth 3 lang-words)) ?=) - "\n") thetoc) - (mapc '(lambda (line) - (if (string-match org-todo-line-regexp - line) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1)) - level (org-tr-level level) - txt (match-string 3 line) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) - ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (setq txt (org-html-expand-for-ascii txt)) - - (while (string-match org-bracket-link-regexp txt) - (setq txt - (replace-match - (match-string (if (match-end 2) 3 1) txt) - t t txt))) - - (if (and (memq org-export-with-tags '(not-in-toc nil)) - (string-match - (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") - txt)) - (setq txt (replace-match "" t t txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - - (if org-export-with-section-numbers - (setq txt (concat (org-section-number level) - " " txt))) - (if (<= level umax-toc) - (progn - (push - (concat - (make-string - (* (max 0 (- level org-min-level)) 4) ?\ ) - (format (if todo "%s (*)\n" "%s\n") txt)) - thetoc) - (setq org-last-level level)) - )))) - lines) - (setq thetoc (if have-headings (nreverse thetoc) nil)))) - - (org-init-section-numbers) - (while (setq line (pop lines)) - ;; Remove the quoted HTML tags. - (setq line (org-html-expand-for-ascii line)) - ;; Replace links with the description when possible - (while (string-match org-bracket-link-regexp line) - (setq link (match-string 1 line) - desc (match-string (if (match-end 3) 3 1) line)) - (if (and (> (length link) 8) - (equal (substring link 0 8) "coderef:")) - (setq line (replace-match - (format (org-export-get-coderef-format (substring link 8) desc) - (cdr (assoc - (substring link 8) - org-export-code-refs))) - t t line)) - (setq line (replace-match - (if (match-end 3) "[\\3]" "[\\1]") - t nil line)))) - (when custom-times - (setq line (org-translate-time line))) - (cond - ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) - ;; a Headline - (setq first-heading-pos (or first-heading-pos (point))) - (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) - txt (match-string 2 line)) - (org-ascii-level-start level txt umax lines)) - - ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) - (if (not table-open) - ;; New table starts - (setq table-open t table-buffer nil)) - ;; Accumulate lines - (setq table-buffer (cons line table-buffer)) - (when (or (not lines) - (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" - (car lines)))) - (setq table-open nil - table-buffer (nreverse table-buffer)) - (insert (mapconcat - (lambda (x) - (org-fix-indentation x org-ascii-current-indentation)) - (org-format-table-ascii table-buffer) - "\n") "\n"))) - (t - (setq line (org-fix-indentation line org-ascii-current-indentation)) - ;; Remove forced line breaks - (if (string-match "\\\\\\\\[ \t]*$" line) - (setq line (replace-match "" t t line))) - (if (and org-export-with-fixed-width - (string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line)) - (setq line (replace-match "\\1" nil nil line))) - (insert line "\n")))) - - (normal-mode) - - ;; insert the table of contents - (when thetoc - (goto-char (point-min)) - (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t) - (progn - (goto-char (match-beginning 0)) - (replace-match "")) - (goto-char first-heading-pos)) - (mapc 'insert thetoc) - (or (looking-at "[ \t]*\n[ \t]*\n") - (insert "\n\n"))) - - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (make-string (- end beg) ?\ )))) - - (save-buffer) - ;; remove display and invisible chars - (let (beg end) - (goto-char (point-min)) - (while (setq beg (next-single-property-change (point) 'display)) - (setq end (next-single-property-change beg 'display)) - (delete-region beg end) - (goto-char beg) - (insert "=>")) - (goto-char (point-min)) - (while (setq beg (next-single-property-change (point) 'org-cwidth)) - (setq end (next-single-property-change beg 'org-cwidth)) - (delete-region beg end) - (goto-char beg))) - (goto-char (point-min)))) - -(defun org-export-ascii-preprocess () - "Do extra work for ASCII export" - ;; Put quotes around verbatim text - (goto-char (point-min)) - (while (re-search-forward org-verbatim-re nil t) - (goto-char (match-end 2)) - (backward-delete-char 1) (insert "'") - (goto-char (match-beginning 2)) - (delete-char 1) (insert "`") - (goto-char (match-end 2))) - (goto-char (point-min)) - ;; Remove target markers - (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t) - (replace-match "\\1\\2"))) - (defun org-search-todo-below (line lines level) "Search the subtree below LINE for any TODO entries." (let ((rest (cdr (memq line lines))) @@ -2837,52 +2423,6 @@ underlined headlines. The default is 3." (if (<= lv level) (throw 'exit nil)) (if todo (throw 'exit t)))))))) -(defun org-html-expand-for-ascii (line) - "Handle quoted HTML for ASCII export." - (if org-export-html-expand - (while (string-match "@<[^<>\n]*>" line) - ;; We just remove the tags for now. - (setq line (replace-match "" nil nil line)))) - line) - -(defun org-insert-centered (s &optional underline) - "Insert the string S centered and underline it with character UNDERLINE." - (let ((ind (max (/ (- fill-column (string-width s)) 2) 0))) - (insert (make-string ind ?\ ) s "\n") - (if underline - (insert (make-string ind ?\ ) - (make-string (string-width s) underline) - "\n")))) - -(defun org-ascii-level-start (level title umax &optional lines) - "Insert a new level in ASCII export." - (let (char (n (- level umax 1)) (ind 0)) - (if (> level umax) - (progn - (insert (make-string (* 2 n) ?\ ) - (char-to-string (nth (% n (length org-export-ascii-bullets)) - org-export-ascii-bullets)) - " " title "\n") - ;; find the indentation of the next non-empty line - (catch 'stop - (while lines - (if (string-match "^\\* " (car lines)) (throw 'stop nil)) - (if (string-match "^\\([ \t]*\\)\\S-" (car lines)) - (throw 'stop (setq ind (org-get-indentation (car lines))))) - (pop lines))) - (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind))) - (if (or (not (equal (char-before) ?\n)) - (not (equal (char-before (1- (point))) ?\n))) - (insert "\n")) - (setq char (nth (- umax level) (reverse org-export-ascii-underline))) - (unless org-export-with-tags - (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) - (setq title (replace-match "" t t title)))) - (if org-export-with-section-numbers - (setq title (concat (org-section-number level) " " title))) - (insert title "\n" (make-string (string-width title) char) "\n") - (setq org-ascii-current-indentation '(0 . 0))))) - ;;;###autoload (defun org-export-visible (type arg) "Create a copy of the visible part of the current buffer, and export it. @@ -2895,19 +2435,21 @@ continue to use it. The prefix arg ARG is passed through to the exporting command." (interactive (list (progn - (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]uffer with HTML [x]OXO [ ]keep buffer") + (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]uffer with HTML [D]ocBook [x]OXO [ ]keep buffer") (read-char-exclusive)) current-prefix-arg)) - (if (not (member type '(?a ?\C-a ?b ?\C-b ?h ?x ?\ ))) + (if (not (member type '(?a ?\C-a ?b ?\C-b ?h ?D ?x ?\ ))) (error "Invalid export key")) (let* ((binding (cdr (assoc type '((?a . org-export-as-ascii) + (?A . org-export-as-ascii-to-buffer) (?\C-a . org-export-as-ascii) (?b . org-export-as-html-and-open) (?\C-b . org-export-as-html-and-open) (?h . org-export-as-html) (?H . org-export-as-html-to-buffer) (?R . org-export-region-as-html) + (?D . org-export-as-docbook) (?x . org-export-as-xoxo))))) (keepp (equal type ?\ )) (file buffer-file-name) @@ -2959,7 +2501,96 @@ command." (not (get-char-property s 'invisible)))) s)) -;;; HTML export +(defvar org-export-htmlized-org-css-url) ;; defined in org-html.el + +;;;###autoload +(defun org-export-as-org (arg &optional hidden ext-plist + to-buffer body-only pub-dir) + "Make a copy with not-exporting stuff removed. +The purpose of this function is to provide a way to export the source +Org file of a webpage in Org format, but with sensitive and/or irrelevant +stuff removed. This command will remove the following: + +- archived trees (if the variable `org-export-with-archived-trees' is nil) +- comment blocks and trees starting with the COMMENT keyword +- only trees that are consistent with `org-export-select-tags' + and `org-export-exclude-tags'. + +The only arguments that will be used are EXT-PLIST and PUB-DIR, +all the others will be ignored (but are present so that the general +mechanism to call publishing functions will work). + +EXT-PLIST is a property list with external parameters overriding +org-mode's default settings, but still inferior to file-local +settings. When PUB-DIR is set, use this as the publishing +directory." + (interactive "P") + (let* ((opt-plist (org-combine-plists (org-default-export-plist) + ext-plist + (org-infile-export-plist))) + (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) + (filename (concat (file-name-as-directory + (or pub-dir + (org-export-directory :org opt-plist))) + (file-name-sans-extension + (file-name-nondirectory bfname)) + ".org")) + (filename (and filename + (if (equal (file-truename filename) + (file-truename bfname)) + (concat (file-name-sans-extension filename) + "-source." + (file-name-extension filename)) + filename))) + (backup-inhibited t) + (buffer (find-file-noselect filename)) + (region (buffer-string))) + (save-excursion + (switch-to-buffer buffer) + (erase-buffer) + (insert region) + (let ((org-inhibit-startup t)) (org-mode)) + (org-install-letbind) + + ;; Get rid of archived trees + (org-export-remove-archived-trees (plist-get opt-plist :archived-trees)) + + ;; Remove comment environment and comment subtrees + (org-export-remove-comment-blocks-and-subtrees) + + ;; Get rid of excluded trees + (org-export-handle-export-tags (plist-get opt-plist :select-tags) + (plist-get opt-plist :exclude-tags)) + + (when (or (plist-get opt-plist :plain-source) + (not (or (plist-get opt-plist :plain-source) + (plist-get opt-plist :htmlized-source)))) + ;; Either nothing special is requested (default call) + ;; or the plain source is explicitly requested + ;; so: save it + (save-buffer)) + (when (plist-get opt-plist :htmlized-source) + ;; Make the htmlized version + (require 'htmlize) + (require 'org-html) + (font-lock-fontify-buffer) + (let* ((htmlize-output-type 'css) + (newbuf (htmlize-buffer))) + (with-current-buffer newbuf + (when org-export-htmlized-org-css-url + (goto-char (point-min)) + (and (re-search-forward + "<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*" + nil t) + (replace-match + (format + "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">" + org-export-htmlized-org-css-url) + t t))) + (write-file (concat filename ".html"))) + (kill-buffer newbuf))) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))))) (defvar org-archive-location) ;; gets loaded with the org-archive require. (defun org-get-current-options () @@ -2971,6 +2602,8 @@ Does include HTML export options as well as TODO and CATEGORY stuff." #+AUTHOR: %s #+EMAIL: %s #+DATE: %s +#+DESCRIPTION: +#+KEYWORDS: #+LANGUAGE: %s #+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s <:%s #+OPTIONS: TeX:%s LaTeX:%s skip:%s d:%s todo:%s pri:%s tags:%s @@ -3045,16 +2678,6 @@ Does include HTML export options as well as TODO and CATEGORY stuff." "org file:~/org/%s.org" )) -(defun org-export-html-preprocess (parameters) - ;; Convert LaTeX fragments to images - (when (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")) - (message "Exporting...")) - ;;;###autoload (defun org-insert-export-options-template () "Insert into the buffer a template with information for exporting." @@ -3065,1138 +2688,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." (setq s (substring s 0 (match-beginning 0)))) (insert s))) -;;;###autoload -(defun org-export-as-html-and-open (arg) - "Export the outline as HTML and immediately open it with a browser. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted lists." - (interactive "P") - (org-export-as-html arg 'hidden) - (org-open-file buffer-file-name)) - -;;;###autoload -(defun org-export-as-html-batch () - "Call `org-export-as-html', may be used in batch processing as -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-export-as-html-batch" - (org-export-as-html org-export-headline-levels 'hidden)) - -;;;###autoload -(defun org-export-as-html-to-buffer (arg) - "Call `org-export-as-html` with output to a temporary buffer. -No file is created. The prefix ARG is passed through to `org-export-as-html'." - (interactive "P") - (org-export-as-html arg nil nil "*Org HTML Export*") - (switch-to-buffer-other-window "*Org HTML Export*")) - -;;;###autoload -(defun org-replace-region-by-html (beg end) - "Assume the current region has org-mode syntax, and convert it to HTML. -This can be used in any buffer. For example, you could write an -itemized list in org-mode syntax in an HTML buffer and then use this -command to convert it." - (interactive "r") - (let (reg html buf pop-up-frames) - (save-window-excursion - (if (org-mode-p) - (setq html (org-export-region-as-html - beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq html (org-export-region-as-html - (point-min) (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert html))) - -;;;###autoload -(defun org-export-region-as-html (beg end &optional body-only buffer) - "Convert region from BEG to END in org-mode buffer to HTML. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted HTML. If BUFFER is the symbol `string', return the -produced HTML as a string and leave not buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq html (org-export-region-as-html beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (interactive "r\nP") - (when (interactive-p) - (setq buffer "*Org HTML Export*")) - (let ((transient-mark-mode t) (zmacs-regions t) - ext-plist rtn) - (setq ext-plist (plist-put ext-plist :ignore-subree-p t)) - (goto-char end) - (set-mark (point)) ;; to activate the region - (goto-char beg) - (setq rtn (org-export-as-html - nil nil ext-plist - buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (interactive-p) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -(defvar html-table-tag nil) ; dynamically scoped into this. -(defvar org-par-open nil) -;;;###autoload -(defun org-export-as-html (arg &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the outline as a pretty HTML file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted -lists. When HIDDEN is non-nil, don't display the HTML buffer. -EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local -settings. When TO-BUFFER is non-nil, create a buffer with that -name and export to that buffer. If TO-BUFFER is the symbol -`string', don't leave any buffer behind but just return the -resulting HTML as a string. When BODY-ONLY is set, don't produce -the file header and footer, simply return the content of -<body>...</body>, without even the body tags themselves. When -PUB-DIR is set, use this as the publishing directory." - (interactive "P") - - ;; Make sure we have a file name when we need it. - (when (and (not (or to-buffer body-only)) - (not buffer-file-name)) - (if (buffer-base-buffer) - (org-set-local 'buffer-file-name - (with-current-buffer (buffer-base-buffer) - buffer-file-name)) - (error "Need a file name to be able to export."))) - - (message "Exporting...") - (setq-default org-todo-line-regexp org-todo-line-regexp) - (setq-default org-deadline-line-regexp org-deadline-line-regexp) - (setq-default org-done-keywords org-done-keywords) - (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp) - (let* ((opt-plist - (org-export-process-option-filters - (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist)))) - (style (concat (if (plist-get opt-plist :style-include-default) - org-export-html-style-default) - (plist-get opt-plist :style) - (plist-get opt-plist :style-extra) - "\n" org-export-html-scripts)) - (html-extension (plist-get opt-plist :html-extension)) - (link-validate (plist-get opt-plist :link-validation-function)) - valid thetoc have-headings first-heading-pos - (odd org-odd-levels-only) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (opt-plist (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist)) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-export-directory :html opt-plist))) - (org-current-export-file buffer-file-name) - (level 0) (line "") (origline "") txt todo - (umax nil) - (umax-toc nil) - (filename (if to-buffer nil - (expand-file-name - (concat - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory buffer-file-name))) - "." html-extension) - (file-name-as-directory - (or pub-dir (org-export-directory :html opt-plist)))))) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (buffer (if to-buffer - (cond - ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*")) - (t (get-buffer-create to-buffer))) - (find-file-noselect filename))) - (org-levels-open (make-vector org-level-max nil)) - (date (plist-get opt-plist :date)) - (author (plist-get opt-plist :author)) - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "UNTITLED")) - (html-table-tag (plist-get opt-plist :html-table-tag)) - (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) - (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)")) - (inquote nil) - (infixed nil) - (inverse nil) - (in-local-list nil) - (local-list-type nil) - (local-list-indent nil) - (llt org-plain-list-ordered-item-terminator) - (email (plist-get opt-plist :email)) - (language (plist-get opt-plist :language)) - (lang-words nil) - (head-count 0) cnt - (start 0) - (coding-system (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system)) - (coding-system-for-write (or org-export-html-coding-system - coding-system)) - (save-buffer-coding-system (or org-export-html-coding-system - coding-system)) - (charset (and coding-system-for-write - (fboundp 'coding-system-get) - (coding-system-get coding-system-for-write - 'mime-charset))) - (region - (buffer-substring - (if region-p (region-beginning) (point-min)) - (if region-p (region-end) (point-max)))) - (lines - (org-split-string - (org-export-preprocess-string - region - :emph-multiline t - :for-html t - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get opt-plist :drawers) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :timestamps (plist-get opt-plist :timestamps) - :archived-trees - (plist-get opt-plist :archived-trees) - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :add-text - (plist-get opt-plist :text) - :LaTeX-fragments - (plist-get opt-plist :LaTeX-fragments)) - "[\r\n]")) - table-open type - table-buffer table-orig-buffer - ind item-type starter didclose - rpl path attr desc descp desc1 desc2 link - snumber fnc item-tag - footnotes footref-seen - id-file - ) - - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (message "Exporting...") - - (setq org-min-level (org-get-min-level lines)) - (setq org-last-level org-min-level) - (org-init-section-numbers) - - (cond - ((and date (string-match "%" date)) - (setq date (format-time-string date))) - (date) - (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) - - ;; Get the language-dependent settings - (setq lang-words (or (assoc language org-export-language-setup) - (assoc "en" org-export-language-setup))) - - ;; Switch to the output buffer - (set-buffer buffer) - (let ((inhibit-read-only t)) (erase-buffer)) - (fundamental-mode) - - (and (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system coding-system-for-write)) - - (let ((case-fold-search nil) - (org-odd-levels-only odd)) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc (if (integerp org-export-with-toc) - (min org-export-with-toc umax) - umax)) - (unless body-only - ;; File header - (insert (format - "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" - \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"> -<html xmlns=\"http://www.w3.org/1999/xhtml\" -lang=\"%s\" xml:lang=\"%s\"> -<head> -<title>%s</title> -<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/> -<meta name=\"generator\" content=\"Org-mode\"/> -<meta name=\"generated\" content=\"%s\"/> -<meta name=\"author\" content=\"%s\"/> -%s -</head><body> -" - language language (org-html-expand title) - (or charset "iso-8859-1") date author style)) - - (insert (or (plist-get opt-plist :preamble) "")) - - (when (plist-get opt-plist :auto-preamble) - (if title (insert (format org-export-html-title-format - (org-html-expand title)))))) - - (if (and org-export-with-toc (not body-only)) - (progn - (push (format "<h%d>%s</h%d>\n" - org-export-html-toplevel-hlevel - (nth 3 lang-words) - org-export-html-toplevel-hlevel) - thetoc) - (push "<div id=\"text-table-of-contents\">\n" thetoc) - (push "<ul>\n<li>" thetoc) - (setq lines - (mapcar '(lambda (line) - (if (string-match org-todo-line-regexp line) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1)) - level (org-tr-level level) - txt (save-match-data - (org-html-expand - (org-export-cleanup-toc-line - (match-string 3 line)))) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) - ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) - (setq txt (replace-match " <span class=\"tag\"> \\1</span>" t nil txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (setq snumber (org-section-number level)) - (if org-export-with-section-numbers - (setq txt (concat snumber " " txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (if (<= level umax-toc) - (progn - (if (> level org-last-level) - (progn - (setq cnt (- level org-last-level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "\n<ul>\n<li>" thetoc)) - (push "\n" thetoc))) - (if (< level org-last-level) - (progn - (setq cnt (- org-last-level level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "</li>\n</ul>" thetoc)) - (push "\n" thetoc))) - ;; Check for targets - (while (string-match org-any-target-regexp line) - (setq line (replace-match - (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") - t t line))) - (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) - (setq txt (replace-match "" t t txt))) - (push - (format - (if todo - "</li>\n<li><a href=\"#sec-%s\"><span class=\"todo\">%s</span></a>" - "</li>\n<li><a href=\"#sec-%s\">%s</a>") - snumber txt) thetoc) - - (setq org-last-level level)) - ))) - line) - lines)) - (while (> org-last-level (1- org-min-level)) - (setq org-last-level (1- org-last-level)) - (push "</li>\n</ul>\n" thetoc)) - (push "</div>\n" thetoc) - (setq thetoc (if have-headings (nreverse thetoc) nil)))) - - (setq head-count 0) - (org-init-section-numbers) - - (org-open-par) - - (while (setq line (pop lines) origline line) - (catch 'nextline - - ;; end of quote section? - (when (and inquote (string-match "^\\*+ " line)) - (insert "</pre>\n") - (setq inquote nil)) - ;; inside a quote section? - (when inquote - (insert (org-html-protect line) "\n") - (throw 'nextline nil)) - - ;; Fixed-width, verbatim lines (examples) - (when (and org-export-with-fixed-width - (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line)) - (when (not infixed) - (setq infixed t) - (org-close-par-maybe) - (insert "<pre class=\"example\">\n")) - (insert (org-html-protect (match-string 3 line)) "\n") - (when (or (not lines) - (not (string-match "^[ \t]*\\(:.*\\)" - (car lines)))) - (setq infixed nil) - (insert "</pre>\n")) - (throw 'nextline nil)) - - ;; Protected HTML - (when (get-text-property 0 'org-protected line) - (let (par) - (when (re-search-backward - "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t) - (setq par (match-string 1)) - (replace-match "\\2\n")) - (insert line "\n") - (while (and lines - (or (= (length (car lines)) 0) - (get-text-property 0 'org-protected (car lines)))) - (insert (pop lines) "\n")) - (and par (insert "<p>\n"))) - (throw 'nextline nil)) - - ;; Horizontal line - (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) - (if org-par-open - (insert "\n</p>\n<hr/>\n<p>\n") - (insert "\n<hr/>\n")) - (throw 'nextline nil)) - - ;; Blockquotes and verse - (when (equal "ORG-BLOCKQUOTE-START" line) - (org-close-par-maybe) - (insert "<blockquote>\n<p>\n") - (throw 'nextline nil)) - (when (equal "ORG-BLOCKQUOTE-END" line) - (insert "</p>\n</blockquote>\n") - (throw 'nextline nil)) - (when (equal "ORG-VERSE-START" line) - (org-close-par-maybe) - (insert "\n<p class=\"verse\">\n") - (setq inverse t) - (throw 'nextline nil)) - (when (equal "ORG-VERSE-END" line) - (insert "</p>\n") - (setq inverse nil) - (throw 'nextline nil)) - (when inverse - (let ((i (org-get-string-indentation line))) - (if (> i 0) - (setq line (concat (mapconcat 'identity - (make-list (* 2 i) "\\nbsp") "") - " " (org-trim line)))) - (setq line (concat line "\\\\")))) - - ;; make targets to anchors - (while (string-match "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line) - (cond - ((match-end 2) - (setq line (replace-match - (format - "@<a name=\"%s\" id=\"%s\">@</a>" - (org-solidify-link-text (match-string 1 line)) - (org-solidify-link-text (match-string 1 line))) - t t line))) - ((and org-export-with-toc (equal (string-to-char line) ?*)) - ;; FIXME: NOT DEPENDENT on TOC????????????????????? - (setq line (replace-match - (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") -; (concat "@<i>" (match-string 1 line) "@</i> ") - t t line))) - (t - (setq line (replace-match - (concat "@<a name=\"" - (org-solidify-link-text (match-string 1 line)) - "\" class=\"target\">" (match-string 1 line) "@</a> ") - t t line))))) - - (setq line (org-html-handle-time-stamps line)) - - ;; replace "&" by "&", "<" and ">" by "<" and ">" - ;; handle @<..> HTML tags (replace "@>..<" by "<..>") - ;; Also handle sub_superscripts and checkboxes - (or (string-match org-table-hline-regexp line) - (setq line (org-html-expand line))) - - ;; Format the links - (setq start 0) - (while (string-match org-bracket-link-analytic-regexp++ line start) - (setq start (match-beginning 0)) - (setq path (save-match-data (org-link-unescape - (match-string 3 line)))) - (setq type (cond - ((match-end 2) (match-string 2 line)) - ((save-match-data - (or (file-name-absolute-p path) - (string-match "^\\.\\.?/" path))) - "file") - (t "internal"))) - (setq path (org-extract-attributes (org-link-unescape path))) - (setq attr (get-text-property 0 'org-attributes path)) - (setq desc1 (if (match-end 5) (match-string 5 line)) - desc2 (if (match-end 2) (concat type ":" path) path) - descp (and desc1 (not (equal desc1 desc2))) - desc (or desc1 desc2)) - ;; Make an image out of the description if that is so wanted - (when (and descp (org-file-image-p - desc org-export-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=\"#" - (org-solidify-link-text - (save-match-data (org-link-unescape path)) nil) - "\"" attr ">" - (org-export-html-format-desc desc) - "</a>"))) - ((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...) - (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 "#" path "\"" - attr ">" - (org-export-html-format-desc desc) - "</a>"))) - ((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>")))) - ((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>"))) - - ((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)))))) - - ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - ;; The link protocol has a function for format the link - (setq rpl - (save-match-data - (funcall fnc (org-link-unescape path) desc1 'html)))) - - ((string= type "file") - ;; FILE link - (let* ((filename path) - (abs-p (file-name-absolute-p filename)) - thefile file-is-image-p search) - (save-match-data - (if (string-match "::\\(.*\\)" filename) - (setq search (match-string 1 filename) - filename (replace-match "" t nil filename))) - (setq valid - (if (functionp link-validate) - (funcall link-validate filename current-dir) - t)) - (setq file-is-image-p - (org-file-image-p - filename org-export-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 "#" - (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)))) - - (t - ;; just publish the path, as default - (setq rpl (concat "<i><" type ":" - (save-match-data (org-link-unescape path)) - "></i>")))) - (setq line (replace-match rpl t t line) - start (+ start (length rpl)))) - - ;; TODO items - (if (and (string-match org-todo-line-regexp line) - (match-beginning 2)) - - (setq line - (concat (substring line 0 (match-beginning 2)) - "<span class=\"" - (if (member (match-string 2 line) - org-done-keywords) - "done" "todo") - "\">" (match-string 2 line) - "</span>" (substring line (match-end 2))))) - - ;; Does this contain a reference to a footnote? - (when org-export-with-footnotes - (setq start 0) - (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start) - (if (get-text-property (match-beginning 2) 'org-protected line) - (setq start (match-end 2)) - (let ((n (match-string 2 line)) extra a) - (if (setq a (assoc n footref-seen)) - (progn - (setcdr a (1+ (cdr a))) - (setq extra (format ".%d" (cdr a)))) - (setq extra "") - (push (cons n 1) footref-seen)) - (setq line - (replace-match - (format - "%s<sup><a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a></sup>" - (match-string 1 line) n extra n n) - t t line)))))) - - (cond - ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) - ;; This is a headline - (setq level (org-tr-level (- (match-end 1) (match-beginning 1))) - txt (match-string 2 line)) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) - (setq first-heading-pos (or first-heading-pos (point))) - (org-html-level-start level txt umax - (and org-export-with-toc (<= level umax)) - head-count) - ;; QUOTES - (when (string-match quote-re line) - (org-close-par-maybe) - (insert "<pre>") - (setq inquote t))) - - ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) - (if (not table-open) - ;; New table starts - (setq table-open t table-buffer nil table-orig-buffer nil)) - ;; Accumulate lines - (setq table-buffer (cons line table-buffer) - table-orig-buffer (cons origline table-orig-buffer)) - (when (or (not lines) - (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" - (car lines)))) - (setq table-open nil - table-buffer (nreverse table-buffer) - table-orig-buffer (nreverse table-orig-buffer)) - (org-close-par-maybe) - (insert (org-format-table-html table-buffer table-orig-buffer)))) - (t - ;; Normal lines - (when (string-match - (cond - ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) - line) - (setq ind (org-get-string-indentation line) - item-type (if (match-beginning 4) "o" "u") - starter (if (match-beginning 2) - (substring (match-string 2 line) 0 -1)) - line (substring line (match-beginning 5)) - item-tag nil) - (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) - (setq item-type "d" - item-tag (match-string 1 line) - line (substring line (match-end 0)))) - (when (and (not (equal item-type "d")) - (not (string-match "[^ \t]" line))) - ;; empty line. Pretend indentation is large. - (setq ind (if org-empty-line-terminates-plain-lists - 0 - (1+ (or (car local-list-indent) 1))))) - (setq didclose nil) - (while (and in-local-list - (or (and (= ind (car local-list-indent)) - (not starter)) - (< ind (car local-list-indent)))) - (setq didclose t) - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) - (cond - ((and starter - (or (not in-local-list) - (> ind (car local-list-indent)))) - ;; 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 "d") - (format "<dl>\n<dt>%s</dt><dd>\n" item-tag)))) - (push item-type local-list-type) - (push ind local-list-indent) - (setq in-local-list t)) - (starter - ;; continue current list - (org-close-li (car local-list-type)) - (insert (cond - ((equal (car local-list-type) "d") - (format "<dt>%s</dt><dd>\n" (or item-tag "???"))) - (t "<li>\n")))) - (didclose - ;; we did close a list, normal text follows: need <p> - (org-open-par))) - (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) - (setq line - (replace-match - (if (equal (match-string 1 line) "X") - "<b>[X]</b>" - "<b>[<span style=\"visibility:hidden;\">X</span>]</b>") - t t line)))) - - ;; Empty lines start a new paragraph. If hand-formatted lists - ;; are not fully interpreted, lines starting with "-", "+", "*" - ;; also start a new paragraph. - (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par)) - - ;; Is this the start of a footnote? - (when org-export-with-footnotes - (when (and (boundp 'footnote-section-tag-regexp) - (string-match (concat "^" footnote-section-tag-regexp) - line)) - ;; ignore this line - (throw 'nextline nil)) - (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line) - (org-close-par-maybe) - (let ((n (match-string 1 line))) - (setq org-par-open t - line (replace-match - (format "<p class=\"footnote\"><sup><a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a></sup>" n n n) t t line))))) - - ;; Check if the line break needs to be conserved - (cond - ((string-match "\\\\\\\\[ \t]*$" line) - (setq line (replace-match "<br/>" t t line))) - (org-export-preserve-breaks - (setq line (concat line "<br/>")))) - - ;; Check if a paragraph should be started - (let ((start 0)) - (while (and org-par-open - (string-match "\\\\par\\>" line start)) - ;; Leave a space in the </p> so that the footnote matcher - ;; does not see this. - (if (not (get-text-property (match-beginning 0) - 'org-protected line)) - (setq line (replace-match "</p ><p >" t t line))) - (setq start (match-end 0)))) - - (insert line "\n"))))) - - ;; Properly close all local lists and other lists - (when inquote - (insert "</pre>\n") - (org-open-par)) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) - (org-html-level-start 1 nil umax - (and org-export-with-toc (<= level umax)) - head-count) - ;; the </div> to close the last text-... div. - (when (and (> umax 0) first-heading-pos) (insert "</div>\n")) - - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "<p class=\"footnote\">[^\000]*?\\(</p>\\|\\'\\)" nil t) - (push (match-string 0) footnotes) - (replace-match "" t t))) - (when footnotes - (insert (format org-export-html-footnotes-section - (or (nth 4 lang-words) "Footnotes") - (mapconcat 'identity (nreverse footnotes) "\n")) - "\n")) - (unless body-only - (when (plist-get opt-plist :auto-postamble) - (insert "<div id=\"postamble\">") - (when (and org-export-author-info author) - (insert "<p class=\"author\"> " - (nth 1 lang-words) ": " author "\n") - (when email - (if (listp (split-string email ",+ *")) - (mapc (lambda(e) - (insert "<a href=\"mailto:" e "\"><" - e "></a>\n")) - (split-string email ",+ *")) - (insert "<a href=\"mailto:" email "\"><" - email "></a>\n"))) - (insert "</p>\n")) - (when (and date org-export-time-stamp-file) - (insert "<p class=\"date\"> " - (nth 2 lang-words) ": " - date "</p>\n")) - (when org-export-creator-info - (insert (format "<p>HTML generated by org-mode %s in emacs %s</p>\n" - org-version emacs-major-version))) - (insert "</div>")) - - (if org-export-html-with-timestamp - (insert org-export-html-html-helper-timestamp)) - (insert (or (plist-get opt-plist :postamble) "")) - (insert "</body>\n</html>\n")) - - (unless (plist-get opt-plist :buffer-will-be-killed) - (normal-mode) - (if (eq major-mode default-major-mode) (html-mode))) - - ;; insert the table of contents - (goto-char (point-min)) - (when thetoc - (if (or (re-search-forward - "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t) - (re-search-forward - "\\[TABLE-OF-CONTENTS\\]" nil t)) - (progn - (goto-char (match-beginning 0)) - (replace-match "")) - (goto-char first-heading-pos) - (when (looking-at "\\s-*</p>") - (goto-char (match-end 0)) - (insert "\n"))) - (insert "<div id=\"table-of-contents\">\n") - (mapc 'insert thetoc) - (insert "</div>\n")) - ;; remove empty paragraphs and lists - (goto-char (point-min)) - (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t) - (replace-match "")) - (goto-char (point-min)) - (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t) - (replace-match "")) - (goto-char (point-min)) - (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t) - (replace-match "")) - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end n) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq n (get-text-property beg 'org-whitespace) - end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (format "<span style=\"visibility:hidden;\">%s</span>" - (make-string n ?x))))) - (or to-buffer (save-buffer)) - (goto-char (point-min)) - (message "Exporting... done") - (if (eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer))) - (current-buffer))))) - -(defun org-export-get-coderef-format (path desc) - (save-match-data - (if (and desc (string-match - (regexp-quote (concat "(" path ")")) - desc)) - (replace-match "%s" t t desc) - "%s"))) - - -(defun org-export-html-format-href (s) - "Make sure the S is valid as a href reference in an XHTML document." - (save-match-data - (let ((start 0)) - (while (string-match "&" s start) - (setq start (+ (match-beginning 0) 3) - s (replace-match "&" t t s))))) - s) - -(defun org-export-html-format-desc (s) - "Make sure the S is valid as a description in a link." - (if (and s (not (get-text-property 1 'org-protected s))) - (save-match-data - (org-html-do-expand s)) - s)) - -(defun org-export-html-format-image (src par-open) - "Create image tag with source and attributes." - (save-match-data - (if (string-match "^ltxpng/" src) - (format "<img src=\"%s\"/>" src) - (let* ((caption (org-find-text-property-in-string 'org-caption src)) - (attr (org-find-text-property-in-string 'org-attributes src)) - (label (org-find-text-property-in-string 'org-label src))) - (format "%s<div %sclass=\"figure\"> -<p><img src=\"%s\"%s /></p>%s -</div>%s" - (if org-par-open "</p>\n" "") - (if label (format "id=\"%s\" " label) "") - src - (if (string-match "\\<alt=" (or attr "")) - (concat " " attr ) - (concat " " attr " alt=\"" src "\"")) - (if caption (concat "\n<p>" caption "</p>") "") - (if org-par-open "\n<p>" "")))))) - - (defvar org-table-colgroup-info nil) -(defun org-format-table-ascii (lines) - "Format a table for ascii export." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (not (string-match "^[ \t]*|" (car lines))) - ;; Table made by table.el - test for spanning - lines - - ;; A normal org table - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; column and the special lines - (setq lines (org-table-clean-before-export lines))) - ;; Get rid of the vertical lines except for grouping - (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info)) - rtn line vl1 start) - (while (setq line (pop lines)) - (if (string-match org-table-hline-regexp line) - (and (string-match "|\\(.*\\)|" line) - (setq line (replace-match " \\1" t nil line))) - (setq start 0 vl1 vl) - (while (string-match "|" line start) - (setq start (match-end 0)) - (or (pop vl1) (setq line (replace-match " " t t line))))) - (push line rtn)) - (nreverse rtn)))) - -(defun org-colgroup-info-to-vline-list (info) - (let (vl new last) - (while info - (setq last new new (pop info)) - (if (or (memq last '(:end :startend)) - (memq new '(:start :startend))) - (push t vl) - (push nil vl))) - (setq vl (nreverse vl)) - (and vl (setcar vl nil)) - vl)) - -(defvar org-table-number-regexp) ; defined in org-table.el -(defun org-format-table-html (lines olines) - "Find out which HTML converter to use and return the HTML code." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (string-match "^[ \t]*|" (car lines)) - ;; A normal org table - (org-format-org-table-html lines) - ;; Table made by table.el - test for spanning - (let* ((hlines (delq nil (mapcar - (lambda (x) - (if (string-match "^[ \t]*\\+-" x) x - nil)) - lines))) - (first (car hlines)) - (ll (and (string-match "\\S-+" first) - (match-string 0 first))) - (re (concat "^[ \t]*" (regexp-quote ll))) - (spanning (delq nil (mapcar (lambda (x) (not (string-match re x))) - hlines)))) - (if (and (not spanning) - (not org-export-prefer-native-exporter-for-tables)) - ;; We can use my own converter with HTML conversions - (org-format-table-table-html lines) - ;; Need to use the code generator in table.el, with the original text. - (org-format-table-table-html-using-table-generate-source olines))))) - -(defvar org-table-number-fraction) ; defined in org-table.el -(defun org-format-org-table-html (lines &optional splice) - "Format a table into HTML." - (require 'org-table) - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; column and the special lines - (setq lines (org-table-clean-before-export lines))) - - (let ((caption (or (get-text-property 0 'org-caption (car lines)) - (get-text-property (or (next-single-property-change - 0 'org-caption (car lines)) - 0) - 'org-caption (car lines)))) - (head (and org-export-highlight-first-table-line - (delq nil (mapcar - (lambda (x) (string-match "^[ \t]*|-" x)) - (cdr lines))))) - - (nlines 0) fnum i - tbopen line fields html gr colgropen) - (if splice (setq head nil)) - (unless splice (push (if head "<thead>" "<tbody>") html)) - (setq tbopen t) - (while (setq line (pop lines)) - (catch 'next-line - (if (string-match "^[ \t]*|-" line) - (progn - (unless splice - (push (if head "</thead>" "</tbody>") html) - (if lines (push "<tbody>" html) (setq tbopen nil))) - (setq head nil) ;; head ends here, first time around - ;; ignore this line - (throw 'next-line t))) - ;; Break the line into fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (unless fnum (setq fnum (make-vector (length fields) 0))) - (setq nlines (1+ nlines) i -1) - (push (concat "<tr>" - (mapconcat - (lambda (x) - (setq i (1+ i)) - (if (and (< i nlines) - (string-match org-table-number-regexp x)) - (incf (aref fnum i))) - (if head - (concat (car org-export-table-header-tags) x - (cdr org-export-table-header-tags)) - (concat (car org-export-table-data-tags) x - (cdr org-export-table-data-tags)))) - fields "") - "</tr>") - html))) - (unless splice (if tbopen (push "</tbody>" html))) - (unless splice (push "</table>\n" html)) - (setq html (nreverse html)) - (unless splice - ;; Put in col tags with the alignment (unfortunately often ignored...) - (push (mapconcat - (lambda (x) - (setq gr (pop org-table-colgroup-info)) - (format "%s<col align=\"%s\"></col>%s" - (if (memq gr '(:start :startend)) - (prog1 - (if colgropen "</colgroup>\n<colgroup>" "<colgroup>") - (setq colgropen t)) - "") - (if (> (/ (float x) nlines) org-table-number-fraction) - "right" "left") - (if (memq gr '(:end :startend)) - (progn (setq colgropen nil) "</colgroup>") - ""))) - fnum "") - html) - (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) - (if caption (push (format "<caption>%s</caption>" caption) html)) - (push html-table-tag html)) - (concat (mapconcat 'identity html "\n") "\n"))) (defun org-table-clean-before-export (lines &optional maybe-quoted) "Check if the table has a marking column. @@ -4250,165 +2742,6 @@ If yes remove the column and the special lines." (replace-match "\\1|" t nil x)))) lines)))) -(defun org-format-table-table-html (lines) - "Format a table generated by table.el into HTML. -This conversion does *not* use `table-generate-source' from table.el. -This has the advantage that Org-mode's HTML conversions can be used. -But it has the disadvantage, that no cell- or row-spanning is allowed." - (let (line field-buffer - (head org-export-highlight-first-table-line) - fields html empty) - (setq html (concat html-table-tag "\n")) - (while (setq line (pop lines)) - (setq empty " ") - (catch 'next-line - (if (string-match "^[ \t]*\\+-" line) - (progn - (if field-buffer - (progn - (setq - html - (concat - html - "<tr>" - (mapconcat - (lambda (x) - (if (equal x "") (setq x empty)) - (if head - (concat (car org-export-table-header-tags) x - (cdr org-export-table-header-tags)) - (concat (car org-export-table-data-tags) x - (cdr org-export-table-data-tags)))) - field-buffer "\n") - "</tr>\n")) - (setq head nil) - (setq field-buffer nil))) - ;; Ignore this line - (throw 'next-line t))) - ;; Break the line into fields and store the fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (if field-buffer - (setq field-buffer (mapcar - (lambda (x) - (concat x "<br/>" (pop fields))) - field-buffer)) - (setq field-buffer fields)))) - (setq html (concat html "</table>\n")) - html)) - -(defun org-format-table-table-html-using-table-generate-source (lines) - "Format a table into html, using `table-generate-source' from table.el. -This has the advantage that cell- or row-spanning is allowed. -But it has the disadvantage, that Org-mode's HTML conversions cannot be used." - (require 'table) - (with-current-buffer (get-buffer-create " org-tmp1 ") - (erase-buffer) - (insert (mapconcat 'identity lines "\n")) - (goto-char (point-min)) - (if (not (re-search-forward "|[^+]" nil t)) - (error "Error processing table")) - (table-recognize-table) - (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) - (table-generate-source 'html " org-tmp2 ") - (set-buffer " org-tmp2 ") - (buffer-substring (point-min) (point-max)))) - -(defun org-export-splice-style (style extra) - "Splice EXTRA into STYLE, just before \"</style>\"." - (if (and (stringp extra) - (string-match "\\S-" extra) - (string-match "</style>" style)) - (concat (substring style 0 (match-beginning 0)) - "\n" extra "\n" - (substring style (match-beginning 0))) - style)) - -(defun org-html-handle-time-stamps (s) - "Format time stamps in string S, or remove them." - (catch 'exit - (let (r b) - (while (string-match org-maybe-keyword-time-regexp s) - (or b (setq b (substring s 0 (match-beginning 0)))) - (setq r (concat - r (substring s 0 (match-beginning 0)) - (if (match-end 1) - (format "@<span class=\"timestamp-kwd\">%s @</span>" - (match-string 1 s))) - (format " @<span class=\"timestamp\">%s@</span>" - (substring - (org-translate-time (match-string 3 s)) 1 -1))) - s (substring s (match-end 0)))) - ;; Line break if line started and ended with time stamp stuff - (if (not r) - s - (setq r (concat r s)) - (unless (string-match "\\S-" (concat b s)) - (setq r (concat r "@<br/>"))) - r)))) - -(defun org-export-htmlize-region-for-paste (beg end) - "Convert the region to HTML, using htmlize.el. -This is much like `htmlize-region-for-paste', only that it uses -the settings define in the org-... variables." - (let* ((htmlize-output-type org-export-htmlize-output-type) - (htmlize-css-name-prefix org-export-htmlize-css-font-prefix) - (htmlbuf (htmlize-region beg end))) - (unwind-protect - (with-current-buffer htmlbuf - (buffer-substring (plist-get htmlize-buffer-places 'content-start) - (plist-get htmlize-buffer-places 'content-end))) - (kill-buffer htmlbuf)))) - -;;;###autoload -(defun org-export-htmlize-generate-css () - "Create the CSS for all font definitions in the current Emacs session. -Use this to create face definitions in your CSS style file that can then -be used by code snippets transformed by htmlize. -This command just produces a buffer that contains class definitions for all -faces used in the current Emacs session. You can copy and paste the ones you -need into your CSS file. - -If you then set `org-export-htmlize-output-type' to `css', calls to -the function `org-export-htmlize-region-for-paste' will produce code -that uses these same face definitions." - (interactive) - (require 'htmlize) - (and (get-buffer "*html*") (kill-buffer "*html*")) - (with-temp-buffer - (let ((fl (face-list)) - (htmlize-css-name-prefix "org-") - (htmlize-output-type 'css) - f i) - (while (setq f (pop fl) - i (and f (face-attribute f :inherit))) - (when (and (symbolp f) (or (not i) (not (listp i)))) - (insert (org-add-props (copy-sequence "1") nil 'face f)))) - (htmlize-region (point-min) (point-max)))) - (switch-to-buffer "*html*") - (goto-char (point-min)) - (if (re-search-forward "<style" nil t) - (delete-region (point-min) (match-beginning 0))) - (if (re-search-forward "</style>" nil t) - (delete-region (1+ (match-end 0)) (point-max))) - (beginning-of-line 1) - (if (looking-at " +") (replace-match "")) - (goto-char (point-min))) - -(defun org-html-protect (s) - ;; convert & to &, < to < and > to > - (let ((start 0)) - (while (string-match "&" s start) - (setq s (replace-match "&" t t s) - start (1+ (match-beginning 0)))) - (while (string-match "<" s) - (setq s (replace-match "<" t t s))) - (while (string-match ">" s) - (setq s (replace-match ">" t t s))) -; (while (string-match "\"" s) -; (setq s (replace-match """ t t s))) - ) - s) - (defun org-export-cleanup-toc-line (s) "Remove tags and timestamps from lines going into the toc." (when (memq org-export-with-tags '(not-in-toc nil)) @@ -4422,47 +2755,6 @@ that uses these same face definitions." t t s))) s) -(defun org-html-expand (string) - "Prepare STRING for HTML export. Applies all active conversions. -If there are links in the string, don't modify these." - (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) - m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-html-do-expand s) res) - (push l res)) - (push (org-html-do-expand string) res) - (apply 'concat (nreverse res)))) - -(defun org-html-do-expand (s) - "Apply all active conversions to translate special ASCII to HTML." - (setq s (org-html-protect s)) - (if org-export-html-expand - (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" t nil s)))) - (if org-export-with-emphasize - (setq s (org-export-html-convert-emphasize s))) - (if org-export-with-special-strings - (setq s (org-export-html-convert-special-strings s))) - (if org-export-with-sub-superscripts - (setq s (org-export-html-convert-sub-super s))) - (if org-export-with-TeX-macros - (let ((start 0) wd ass) - (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?" - s start)) - (if (get-text-property (match-beginning 0) 'org-protected s) - (setq start (match-end 0)) - (setq wd (match-string 1 s)) - (if (setq ass (assoc wd org-html-entities)) - (setq s (replace-match (or (cdr ass) - (concat "&" (car ass) ";")) - t t s)) - (setq start (+ start (length wd)))))))) - 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 @@ -4471,7 +2763,7 @@ 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 "]*?")) + (let* ((nothing (concat "[^" left right "]*?")) (or "\\|") (re nothing) (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) @@ -4498,643 +2790,29 @@ stacked delimiters is N. Escaping delimiters is not possible." "\\)") "The regular expression matching a sub- or superscript, forcing braces.") -(defconst org-export-html-special-string-regexps - '(("\\\\-" . "­") - ("---\\([^-]\\)" . "—\\1") - ("--\\([^-]\\)" . "–\\1") - ("\\.\\.\\." . "…")) - "Regular expressions for special string conversion.") - -(defun org-export-html-convert-special-strings (string) - "Convert special characters in STRING to HTML." - (let ((all org-export-html-special-string-regexps) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (if (get-text-property (match-beginning 0) 'org-protected string) - (setq start (match-end 0)) - (setq string (replace-match rpl t nil string))))) - string)) - -(defun org-export-html-convert-sub-super (string) - "Convert sub- and superscripts in STRING to HTML." - (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) - (while (string-match org-match-substring-regexp string s) - (cond - ((and requireb (match-end 8)) (setq s (match-end 2))) - ((get-text-property (match-beginning 2) 'org-protected string) - (setq s (match-end 2))) - (t - (setq s (match-end 1) - key (if (string= (match-string 2 string) "_") "sub" "sup") - c (or (match-string 8 string) - (match-string 6 string) - (match-string 5 string)) - string (replace-match - (concat (match-string 1 string) - "<" key ">" c "</" key ">") - t t string))))) - (while (string-match "\\\\\\([_^]\\)" string) - (setq string (replace-match (match-string 1 string) t t string))) - string)) - -(defun org-export-html-convert-emphasize (string) - "Apply emphasis." - (let ((s 0) rpl) - (while (string-match org-emph-re string s) - (if (not (equal - (substring string (match-beginning 3) (1+ (match-beginning 3))) - (substring string (match-beginning 4) (1+ (match-beginning 4))))) - (setq s (match-beginning 0) - rpl - (concat - (match-string 1 string) - (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) - (match-string 4 string) - (nth 3 (assoc (match-string 3 string) - org-emphasis-alist)) - (match-string 5 string)) - string (replace-match rpl t t string) - s (+ s (- (length rpl) 2))) - (setq s (1+ s)))) - string)) - -(defun org-open-par () - "Insert <p>, but first close previous paragraph if any." - (org-close-par-maybe) - (insert "\n<p>") - (setq org-par-open t)) -(defun org-close-par-maybe () - "Close paragraph if there is one open." - (when org-par-open - (insert "</p>") - (setq org-par-open nil))) -(defun org-close-li (&optional type) - "Close <li> if necessary." - (org-close-par-maybe) - (insert (if (equal type "d") "</dd>\n" "</li>\n"))) - -(defvar body-only) ; dynamically scoped into this. -(defun org-html-level-start (level title umax with-toc head-count) - "Insert a new level in HTML export. -When TITLE is nil, just close all open levels." - (org-close-par-maybe) - (let* ((target (and title (org-get-text-property-any 0 'target title))) - (extra-targets - (mapconcat (lambda (x) - (format "<a name=\"%s\" id=\"%s\"></a>" - x x)) - (cdr (assoc target org-export-target-aliases)) - "")) - (l org-level-max) - snumber) - (while (>= l level) - (if (aref org-levels-open (1- l)) - (progn - (org-html-level-close l umax) - (aset org-levels-open (1- l) nil))) - (setq l (1- l))) - (when title - ;; If title is nil, this means this function is called to close - ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) - (setq title (replace-match - (if org-export-with-tags - (save-match-data - (concat - " <span class=\"tag\">" - (mapconcat 'identity (org-split-string - (match-string 1 title) ":") - " ") - "</span>")) - "") - t t title))) - (if (> level umax) - (progn - (if (aref org-levels-open (1- level)) - (progn - (org-close-li) - (if target - (insert (format "<li id=\"%s\">" target) extra-targets title "<br/>\n") - (insert "<li>" title "<br/>\n"))) - (aset org-levels-open (1- level) t) - (org-close-par-maybe) - (if target - (insert (format "<ul>\n<li id=\"%s\">" target) - 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)) - (if (and org-export-with-section-numbers (not body-only)) - (setq title (concat snumber " " title))) - (setq level (+ level org-export-html-toplevel-hlevel -1)) - (unless (= head-count 1) (insert "\n</div>\n")) - (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d\">\n<h%d id=\"sec-%s\">%s%s</h%d>\n<div id=\"text-%s\">\n" - snumber level level snumber extra-targets title level snumber)) - (org-open-par))))) (defun org-get-text-property-any (pos prop &optional object) (or (get-text-property pos prop object) (and (setq pos (next-single-property-change pos prop object)) (get-text-property pos prop object)))) -(defun org-html-level-close (level max-outline-level) - "Terminate one level in HTML export." - (if (<= level max-outline-level) - (insert "</div>\n") - (org-close-li) - (insert "</ul>\n"))) - -;;; iCalendar export - -;;;###autoload -(defun org-export-icalendar-this-file () - "Export current file as an iCalendar file. -The iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (org-export-icalendar nil buffer-file-name)) - -;;;###autoload -(defun org-export-icalendar-all-agenda-files () - "Export all files in `org-agenda-files' to iCalendar .ics files. -Each iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (apply 'org-export-icalendar nil (org-agenda-files t))) - -;;;###autoload -(defun org-export-icalendar-combine-agenda-files () - "Export all files in `org-agenda-files' to a single combined iCalendar file. -The file is stored under the name `org-combined-agenda-icalendar-file'." - (interactive) - (apply 'org-export-icalendar t (org-agenda-files t))) - -(defun org-export-icalendar (combine &rest files) - "Create iCalendar files for all elements of FILES. -If COMBINE is non-nil, combine all calendar entries into a single large -file and store it under the name `org-combined-agenda-icalendar-file'." - (save-excursion - (org-prepare-agenda-buffers files) - (let* ((dir (org-export-directory - :ical (list :publishing-directory - org-export-publishing-directory))) - file ical-file ical-buffer category started org-agenda-new-buffers) - (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*")) - (when combine - (setq ical-file - (if (file-name-absolute-p org-combined-agenda-icalendar-file) - org-combined-agenda-icalendar-file - (expand-file-name org-combined-agenda-icalendar-file dir)) - ical-buffer (org-get-agenda-file-buffer ical-file)) - (set-buffer ical-buffer) (erase-buffer)) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (set-buffer (org-get-agenda-file-buffer file)) - (unless combine - (setq ical-file (concat (file-name-as-directory dir) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".ics")) - (setq ical-buffer (org-get-agenda-file-buffer ical-file)) - (with-current-buffer ical-buffer (erase-buffer))) - (setq category (or org-category - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)))) - (if (symbolp category) (setq category (symbol-name category))) - (let ((standard-output ical-buffer)) - (if combine - (and (not started) (setq started t) - (org-start-icalendar-file org-icalendar-combined-name)) - (org-start-icalendar-file category)) - (org-print-icalendar-entries combine) - (when (or (and combine (not files)) (not combine)) - (org-finish-icalendar-file) - (set-buffer ical-buffer) - (run-hooks 'org-before-save-iCalendar-file-hook) - (save-buffer) - (run-hooks 'org-after-save-iCalendar-file-hook) - (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)) - )))) - (org-release-buffers org-agenda-new-buffers)))) - -(defvar org-before-save-iCalendar-file-hook nil - "Hook run before an iCalendar file has been saved. -This can be used to modify the result of the export.") - -(defvar org-after-save-iCalendar-file-hook nil - "Hook run after an iCalendar file has been saved. -The iCalendar buffer is still current when this hook is run. -A good way to use this is to tell a desktop calendar application to re-read -the iCalendar file.") - -(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el -(defun org-print-icalendar-entries (&optional combine) - "Print iCalendar entries for the current Org-mode file to `standard-output'. -When COMBINE is non nil, add the category to each line." - (require 'org-agenda) - (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) - (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) - (dts (org-ical-ts-to-string - (format-time-string (cdr org-time-stamp-formats) (current-time)) - "DTSTART")) - hd ts ts2 state status (inc t) pos b sexp rrule - scheduledp deadlinep todo prefix due start - tmp pri categories location summary desc uid - (sexp-buffer (get-buffer-create "*ical-tmp*"))) - (org-refresh-category-properties) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re1 nil t) - (catch :skip - (org-agenda-skip) - (when (boundp 'org-icalendar-verify-function) - (unless (funcall org-icalendar-verify-function) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq pos (match-beginning 0) - ts (match-string 0) - inc t - hd (condition-case nil - (org-icalendar-cleanup-string - (org-get-heading)) - (error (throw :skip nil))) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION" 'selective)) - uid (if org-icalendar-store-UID - (org-id-get-create) - (or (org-id-get) (org-id-new))) - categories (org-export-get-categories) - deadlinep nil scheduledp nil) - (if (looking-at re2) - (progn - (goto-char (match-end 0)) - (setq ts2 (match-string 1) - inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2)))) - (setq tmp (buffer-substring (max (point-min) - (- pos org-ds-keyword-length)) - pos) - ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) - (progn - (setq inc nil) - (replace-match "\\1" t nil ts)) - ts) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - todo (org-get-todo-state) - ;; donep (org-entry-is-done-p) - )) - (when (and - deadlinep - (if todo - (not (memq 'event-if-todo org-icalendar-use-deadline)) - (not (memq 'event-if-not-todo org-icalendar-use-deadline)))) - (throw :skip t)) - (when (and - scheduledp - (if todo - (not (memq 'event-if-todo org-icalendar-use-scheduled)) - (not (memq 'event-if-not-todo org-icalendar-use-scheduled)))) - (throw :skip t)) - (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-"))) - (if (or (string-match org-tr-regexp hd) - (string-match org-ts-regexp hd)) - (setq hd (replace-match "" t t hd))) - (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts) - (setq rrule - (concat "\nRRULE:FREQ=" - (cdr (assoc - (match-string 2 ts) - '(("d" . "DAILY")("w" . "WEEKLY") - ("m" . "MONTHLY")("y" . "YEARLY")))) - ";INTERVAL=" (match-string 1 ts))) - (setq rrule "")) - (setq summary (or summary hd)) - (if (string-match org-bracket-link-regexp summary) - (setq summary - (replace-match (if (match-end 3) - (match-string 3 summary) - (match-string 1 summary)) - t t summary))) - (if deadlinep (setq summary (concat "DL: " summary))) - (if scheduledp (setq summary (concat "S: " summary))) - (if (string-match "\\`<%%" ts) - (with-current-buffer sexp-buffer - (insert (substring ts 1 -1) " " summary "\n")) - (princ (format "BEGIN:VEVENT -UID: %s -%s -%s%s -SUMMARY:%s%s%s -CATEGORIES:%s -END:VEVENT\n" - (concat prefix uid) - (org-ical-ts-to-string ts "DTSTART") - (org-ical-ts-to-string ts2 "DTEND" inc) - rrule summary - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - categories))))) - (when (and org-icalendar-include-sexps - (condition-case nil (require 'icalendar) (error nil)) - (fboundp 'icalendar-export-region)) - ;; Get all the literal sexps - (goto-char (point-min)) - (while (re-search-forward "^&?%%(" nil t) - (catch :skip - (org-agenda-skip) - (setq b (match-beginning 0)) - (goto-char (1- (match-end 0))) - (forward-sexp 1) - (end-of-line 1) - (setq sexp (buffer-substring b (point))) - (with-current-buffer sexp-buffer - (insert sexp "\n")))) - (princ (org-diary-to-ical-string sexp-buffer)) - (kill-buffer sexp-buffer)) - - (when org-icalendar-include-todo - (setq prefix "TODO-") - (goto-char (point-min)) - (while (re-search-forward org-todo-line-regexp nil t) - (catch :skip - (org-agenda-skip) - (when (boundp 'org-icalendar-verify-function) - (unless (funcall org-icalendar-verify-function) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq state (match-string 2)) - (setq status (if (member state org-done-keywords) - "COMPLETED" "NEEDS-ACTION")) - (when (and state - (or (not (member state org-done-keywords)) - (eq org-icalendar-include-todo 'all)) - (not (member org-archive-tag (org-get-tags-at))) - ) - (setq hd (match-string 3) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION" 'selective)) - due (and (member 'todo-due org-icalendar-use-deadline) - (org-entry-get nil "DEADLINE")) - start (and (member 'todo-start org-icalendar-use-scheduled) - (org-entry-get nil "SCHEDULED")) - categories (org-export-get-categories) - uid (if org-icalendar-store-UID - (org-id-get-create) - (or (org-id-get) (org-id-new)))) - (and due (setq due (org-ical-ts-to-string due "DUE"))) - (and start (setq start (org-ical-ts-to-string start "DTSTART"))) - - (if (string-match org-bracket-link-regexp hd) - (setq hd (replace-match (if (match-end 3) (match-string 3 hd) - (match-string 1 hd)) - t t hd))) - (if (string-match org-priority-regexp hd) - (setq pri (string-to-char (match-string 2 hd)) - hd (concat (substring hd 0 (match-beginning 1)) - (substring hd (match-end 1)))) - (setq pri org-default-priority)) - (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri)) - (- org-lowest-priority org-highest-priority)))))) - - (princ (format "BEGIN:VTODO -UID: %s -%s -SUMMARY:%s%s%s%s -CATEGORIES:%s -SEQUENCE:1 -PRIORITY:%d -STATUS:%s -END:VTODO\n" - (concat prefix uid) - (or start dts) - (or summary hd) - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - (if due (concat "\n" due) "") - categories - pri status))))))))) - -(defun org-export-get-categories () - "Get categories according to `org-icalendar-categories'." - (let ((cs org-icalendar-categories) c rtn tmp) - (while (setq c (pop cs)) - (cond - ((eq c 'category) (push (org-get-category) rtn)) - ((eq c 'todo-state) - (setq tmp (org-get-todo-state)) - (and tmp (push tmp rtn))) - ((eq c 'local-tags) - (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn))) - ((eq c 'all-tags) - (setq rtn (append (nreverse (org-get-tags-at (point))) rtn))))) - (mapconcat 'identity (nreverse rtn) ","))) - -(defun org-icalendar-cleanup-string (s &optional is-body maxlength) - "Take out stuff and quote what needs to be quoted. -When IS-BODY is non-nil, assume that this is the body of an item, clean up -whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH -characters." - (if (not s) - nil - (when is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s))))) - (let ((start 0)) - (while (string-match "\\([,;]\\)" s start) - (setq start (+ (match-beginning 0) 2) - s (replace-match "\\\\\\1" nil nil s)))) - (setq s (org-trim s)) - (when is-body - (while (string-match "[ \t]*\n[ \t]*" s) - (setq s (replace-match "\\n" t t s)))) - (if is-body - (if maxlength - (if (and (numberp maxlength) - (> (length s) maxlength)) - (setq s (substring s 0 maxlength))))) - s)) - -(defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength) - "Take out stuff and quote what needs to be quoted. -When IS-BODY is non-nil, assume that this is the body of an item, clean up -whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH -characters. -This seems to be more like RFC 2455, but it causes problems, so it is -not used right now." - (if (not s) - nil - (if is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s))) - (setq s (org-trim s)) - (while (string-match "[ \t]*\n[ \t]*" s) - (setq s (replace-match "\\n" t t s))) - (if maxlength - (if (and (numberp maxlength) - (> (length s) maxlength)) - (setq s (substring s 0 maxlength))))) - (setq s (org-trim s))) - (while (string-match "\"" s) (setq s (replace-match "''" t t s))) - (when (string-match "[;,:]" s) (setq s (concat "\"" s "\""))) - s)) - -(defun org-get-entry () - "Clean-up description string." - (save-excursion - (org-back-to-heading t) - (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) - -(defun org-start-icalendar-file (name) - "Start an iCalendar file by inserting the header." - (let ((user user-full-name) - (name (or name "unknown")) - (timezone (cadr (current-time-zone)))) - (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)))) - -(defun org-finish-icalendar-file () - "Finish an iCalendar file by inserting the END statement." - (princ "END:VCALENDAR\n")) - -(defun org-ical-ts-to-string (s keyword &optional inc) - "Take a time string S and convert it to iCalendar format. -KEYWORD is added in front, to make a complete line like DTSTART.... -When INC is non-nil, increase the hour by two (if time string contains -a time), or the day by one (if it does not contain a time)." - (let ((t1 (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)))) - -;;; XOXO export - -(defun org-export-as-xoxo-insert-into (buffer &rest output) - (with-current-buffer buffer - (apply 'insert output))) -(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1) - -;;;###autoload -(defun org-export-as-xoxo (&optional buffer) - "Export the org buffer as XOXO. -The XOXO buffer is named *xoxo-<source buffer name>*" - (interactive (list (current-buffer))) - ;; A quickie abstraction - - ;; Output everything as XOXO - (with-current-buffer (get-buffer buffer) - (let* ((pos (point)) - (opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (filename (concat (file-name-as-directory - (org-export-directory :xoxo opt-plist)) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".html")) - (out (find-file-noselect filename)) - (last-level 1) - (hanging-li nil)) - (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. - ;; Check the output buffer is empty. - (with-current-buffer out (erase-buffer)) - ;; Kick off the output - (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n") - (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't) - (let* ((hd (match-string-no-properties 1)) - (level (length hd)) - (text (concat - (match-string-no-properties 2) - (save-excursion - (goto-char (match-end 0)) - (let ((str "")) - (catch 'loop - (while 't - (forward-line) - (if (looking-at "^[ \t]\\(.*\\)") - (setq str (concat str (match-string-no-properties 1))) - (throw 'loop str))))))))) - - ;; Handle level rendering - (cond - ((> level last-level) - (org-export-as-xoxo-insert-into out "\n<ol>\n")) - - ((< level last-level) - (dotimes (- (- last-level level) 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "</li>\n")) - (org-export-as-xoxo-insert-into out "</ol>\n")) - (when hanging-li - (org-export-as-xoxo-insert-into out "</li>\n") - (setq hanging-li nil))) - - ((equal level last-level) - (if hanging-li - (org-export-as-xoxo-insert-into out "</li>\n"))) - ) - - (setq last-level level) - - ;; And output the new li - (setq hanging-li 't) - (if (equal ?+ (elt text 0)) - (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>") - (org-export-as-xoxo-insert-into out "<li>" text)))) - - ;; Finally finish off the ol - (dotimes (- last-level 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "</li>\n")) - (org-export-as-xoxo-insert-into out "</ol>\n")) - - (goto-char pos) - ;; Finish the buffer off and clean it up. - (switch-to-buffer-other-window out) - (indent-region (point-min) (point-max) nil) - (save-buffer) - (goto-char (point-min)) - ))) +(defun org-export-get-coderef-format (path desc) + (save-match-data + (if (and desc (string-match + (regexp-quote (concat "(" path ")")) + desc)) + (replace-match "%s" t t desc) + (or desc "%s")))) + +(defun org-export-push-to-kill-ring (format) + "Push buffer content to kill ring. +The depends on the variable `org-export-copy-to-kill'." + (when org-export-copy-to-kill-ring + (org-kill-new (buffer-string)) + (when (fboundp 'x-set-selection) + (ignore-errors (x-set-selection 'PRIMARY (buffer-string))) + (ignore-errors (x-set-selection 'CLIPBOARD (buffer-string)))) + (message "%s export done, pushed to kill ring and clipboard" format))) (provide 'org-exp) diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index a539585d447..3674f0a4e74 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -258,21 +258,21 @@ column view defines special faces for each outline level. See the file '((((class color) (background light)) (:underline t)) (((class color) (background dark)) (:underline t)) (t (:underline t))) - "Face for links." + "Face for link targets." :group 'org-faces) (defface org-date '((((class color) (background light)) (:foreground "Purple" :underline t)) (((class color) (background dark)) (:foreground "Cyan" :underline t)) (t (:underline t))) - "Face for links." + "Face for date/time stamps." :group 'org-faces) (defface org-sexp-date '((((class color) (background light)) (:foreground "Purple")) (((class color) (background dark)) (:foreground "Cyan")) (t (:underline t))) - "Face for links." + "Face for diary-like sexp date specifications." :group 'org-faces) (defface org-tag @@ -301,6 +301,20 @@ specific tags." "Face used for todo keywords that indicate DONE items." :group 'org-faces) +(defface org-agenda-done ;; originally copied from font-lock-type-face + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold nil)))) + "Face used in agenda, to indicate lines switched to DONE. +This face is used to de-emphasize items that where brightly colord in the +agenda because they were things to do, or overdue. The DONE state itself +is of course immediately visible, but for example a passed deadline is +\(by default) very bright read. This face could be simply the default face +of the frame, for example." + :group 'org-faces) + (defface org-headline-done ;; originally copied from font-lock-string-face (org-compatible-face nil '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) @@ -323,6 +337,18 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)." (string :tag "keyword") (sexp :tag "face")))) +(defcustom org-priority-faces nil + "Faces for specific Priorities. +This is a list of cons cells, with priority character in the car +and faces in the cdr. The face can be a symbol, or a property +list of attributes, like (:foreground \"blue\" :weight bold :underline t)." + :group 'org-faces + :group 'org-todo + :type '(repeat + (cons + (character :tag "Priority") + (sexp :tag "face")))) + (defvar org-tags-special-faces-re nil) (defun org-set-tag-faces (var value) (set var value) @@ -331,6 +357,22 @@ list of attributes, like (:foreground \"blue\" :weight bold :underline t)." (setq org-tags-special-faces-re (concat ":\\(" (mapconcat 'car value "\\|") "\\):")))) +(defface org-checkbox + (org-compatible-face 'bold + '((t (:bold t)))) + "Face for checkboxes" + :group 'org-faces) + +(unless (facep 'org-checkbox-statistics-todo) + (copy-face 'org-todo 'org-checkbox-statistics-todo) + (set-face-doc-string 'org-checkbox-statistics-todo + "Face used for unfinished checkbox statistics.")) + +(unless (facep 'org-checkbox-statistics-done) + (copy-face 'org-done 'org-checkbox-statistics-done) + (set-face-doc-string 'org-checkbox-statistics-done + "Face used for finished checkbox statistics.")) + (defcustom org-tag-faces nil "Faces for specific tags. This is a list of cons cells, with tags in the car and faces in the cdr. @@ -370,7 +412,7 @@ changes." :group 'org-faces) (defface org-code - (org-compatible-face nil + (org-compatible-face 'shadow '((((class color grayscale) (min-colors 88) (background light)) (:foreground "grey50")) (((class color grayscale) (min-colors 88) (background dark)) @@ -383,8 +425,28 @@ changes." :group 'org-faces :version "22.1") +(defface org-meta-line + (org-compatible-face 'font-lock-comment-face nil) + "Face for meta lines startin with \"#+\"." + :group 'org-faces + :version "22.1") + +(defface org-block + (org-compatible-face 'shadow + '((((class color grayscale) (min-colors 88) (background light)) + (:foreground "grey50")) + (((class color grayscale) (min-colors 88) (background dark)) + (:foreground "grey70")) + (((class color) (min-colors 8) (background light)) + (:foreground "green")) + (((class color) (min-colors 8) (background dark)) + (:foreground "yellow")))) + "Face text in #+begin ... #+end blocks." + :group 'org-faces + :version "22.1") + (defface org-verbatim - (org-compatible-face nil + (org-compatible-face 'shadow '((((class color grayscale) (min-colors 88) (background light)) (:foreground "grey50" :underline t)) (((class color grayscale) (min-colors 88) (background dark)) @@ -429,6 +491,13 @@ changes." (set-face-doc-string 'org-agenda-date "Face used in agenda for normal days.")) +(unless (facep 'org-agenda-date-today) + (copy-face 'org-agenda-date 'org-agenda-date-today) + (set-face-doc-string 'org-agenda-date-today + "Face used in agenda for today.") + (when (fboundp 'set-face-attribute) + (set-face-attribute 'org-agenda-date-today nil :weight 'bold :italic 't))) + (unless (facep 'org-agenda-date-weekend) (copy-face 'org-agenda-date 'org-agenda-date-weekend) (set-face-doc-string 'org-agenda-date-weekend @@ -535,7 +604,7 @@ month and 365.24 days for a year)." "The number of different faces to be used for headlines. Org-mode defines 8 different headline faces, so this can be at most 8. If it is less than 8, the level-1 face gets re-used for level N+1 etc." - :type 'number + :type 'integer :group 'org-faces) (defface org-latex-and-export-specials @@ -554,6 +623,11 @@ If it is less than 8, the level-1 face gets re-used for level N+1 etc." "Face used to highlight math latex and other special exporter stuff." :group 'org-faces) +(unless (facep 'org-mode-line-clock) + (copy-face 'modeline 'org-mode-line-clock) + (set-face-doc-string 'org-agenda-date + "Face used for clock display in mode line.")) + (provide 'org-faces) ;; arch-tag: 9dab5f91-c4b9-4d6f-bac3-1f6211ad0a04 diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el new file mode 100644 index 00000000000..7a961cea73c --- /dev/null +++ b/lisp/org/org-feed.el @@ -0,0 +1,665 @@ +;;; org-feed.el --- Add RSS feed items to Org files +;; +;; Copyright (C) 2009 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.29c +;; +;; 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 module allows to create and change entries in an Org-mode +;; file triggered by items in an RSS feed. The basic functionality is +;; geared toward simply adding new items found in a feed as outline nodes +;; to an Org file. Using hooks, arbitrary actions can be triggered for +;; new or changed items. +;; +;; Selecting feeds and target locations +;; ------------------------------------ +;; +;; This module is configured through a single variable, `org-feed-alist'. +;; Here is an example, using a notes/tasks feed from reQall.com. +;; +;; (setq org-feed-alist +;; '(("ReQall" +;; "http://www.reqall.com/user/feeds/rss/a1b2c3....." +;; "~/org/feeds.org" "ReQall Entries") +;; +;; 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 +;; heading - however see the `:drawer' parameter. +;; +;; Besides these standard elements that need to be specified for each +;; feed, keyword-value pairs can set additional options. For example, +;; to de-select transitional entries with a title containing +;; +;; "reQall is typing what you said", +;; +;; you could use the `:filter' argument: +;; +;; (setq org-feed-alist +;; '(("ReQall" +;; "http://www.reqall.com/user/feeds/rss/a1b2c3....." +;; "~/org/feeds.org" "ReQall Entries" +;; :filter my-reqall-filter))) +;; +;; (defun my-reqall-filter (e) +;; (if (string-match "reQall is typing what you said" +;; (plist-get e :title)) +;; nil +;; e)) +;; +;; See the docstring for `org-feed-alist' for more details. +;; +;; +;; Keeping track of previously added entries +;; ----------------------------------------- +;; +;; Since Org allows you to delete, archive, or move outline nodes, +;; org-feed.el needs to keep track of which feed items have been handled +;; before, so that they will not be handled again. For this, org-feed.el +;; stores information in a special drawer, FEEDSTATUS, under the heading +;; that received the input of the feed. You should add FEEDSTATUS +;; to your list of drawers in the files that receive feed input: +;; +;; #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS +;; +;; Acknowledgments +;; ---------------- +;; +;; org-feed.el is based on ideas by Brad Bozarth who implemented a +;; similar mechanism using shell and awk scripts. + +;;; Code: + +(require 'org) +(require 'sha1) + +(declare-function url-retrieve-synchronously "url" (url)) +(declare-function xml-node-children "xml" (node)) +(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)) + +(defgroup org-feed nil + "Options concerning RSS feeds as inputs for Org files." + :tag "Org ID" + :group 'org) + +(defcustom org-feed-alist nil + "Alist specifying RSS feeds that should create inputs for Org. +Each entry in this list specified an RSS feed tat should be queried +to create inbox items in Org. Each entry is a list with the following items: + +name a custom name for this feed +URL the Feed URL +file the target Org file where entries should be listed +headline the headline under which entries should be listed + +Additional arguments can be given using keyword-value pairs. Many of these +specify functions that receive one or a list of \"entries\" as their single +argument. An entry is a property list that describes a feed item. The +property list has properties for each field in the item, for example `:title' +for the `<title>' field and `:pubDate' for the publication date. In addition, +it contains the following properties: + +`:item-full-text' the full text in the <item> tag +`:guid-permalink' t when the guid property is a permalink + +Here are the keyword-value pair allows in `org-feed-alist'. + +:drawer drawer-name + The name of the drawer for storing feed information. The default is + \"FEEDSTATUS\". Using different drawers for different feeds allows + several feeds to target the same inbox heading. + +:filter filter-function + A function to select interesting entries in the feed. It gets a single + entry as parameter. It should return the entry if it is relevant, or + nil if it is not. + +:template template-string + The default action on new items in the feed is to add them as children + under the headline for the feed. The template describes how the entry + should be formatted. If not given, it defaults to + `org-feed-default-template'. + +:formatter formatter-function + Instead of relying on a template, you may specify a function to format + the outline node to be inserted as a child. This function gets passed + a property list describing a single feed item, and it should return a + string that is a properly formatted Org outline node of level 1. + +:new-handler function + If adding new items as children to the outline is not what you want + to do with new items, define a handler function that is called with + a list of all new items in the feed, each one represented as a property + list. The handler should do what needs to be done, and org-feed will + mark all items given to this handler as \"handled\", i.e. they will not + be passed to this handler again in future readings of the feed. + When the handler is called, point will be at the feed headline. + +:changed-handler function + This function gets passed a list of all entries that have been + handled before, but are now still in the feed and have *changed* + since last handled (as evidenced by a different sha1 hash). + 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. + +:parse-entry function + This function gets passed an entry as returned by the parse-feed + function, and should return the entry with interesting properties added. + The default is `org-feed-parse-rss-entry'; `org-feed-parse-atom-entry' + is an alternative." + :group 'org-feed + :type '(repeat + (list :value ("" "http://" "" "") + (string :tag "Name") + (string :tag "Feed URL") + (file :tag "File for inbox") + (string :tag "Headline for inbox") + (repeat :inline t + (choice + (list :inline t :tag "Filter" + (const :filter) + (symbol :tag "Filter Function")) + (list :inline t :tag "Template" + (const :template) + (string :tag "Template")) + (list :inline t :tag "Formatter" + (const :formatter) + (symbol :tag "Formatter Function")) + (list :inline t :tag "New items handler" + (const :new-handler) + (symbol :tag "Handler Function")) + (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")) + ))))) + +(defcustom org-feed-drawer "FEEDSTATUS" + "The name of the drawer for feed status information. +Each feed may also specify its own drawer name using the `:drawer' +parameter in `org-feed-alist'. +Note that in order to make these drawers behave like drawers, they must +be added to the variable `org-drawers' or configured with a #+DRAWERS +line." + :group 'org-feed + :type '(string :tag "Drawer Name")) + +(defcustom org-feed-default-template "\n* %h\n %U\n %description\n %a\n" + "Template for the Org node created from RSS feed items. +This is just the default, each feed can specify its own. +Any fields from the feed item can be interpolated into the template with +%name, for example %title, %description, %pubDate etc. In addition, the +following special escapes are valid as well: + +%h the title, or the first line of the description +%t the date as a stamp, either from <pubDate> (if present), or + the current date. +%T date and time +%u,%U like %t,%T, but inactive time stamps +%a A link, from <guid> if that is a permalink, else from <link>" + :group 'org-feed + :type '(string :tag "Template")) + +(defcustom org-feed-save-after-adding t + "Non-nil means, save buffer after adding new feed items." + :group 'org-feed + :type 'boolean) + +(defcustom org-feed-retrieve-method 'url-retrieve-synchronously + "The method to be used to retrieve a feed URL. +This can be `curl' or `wget' to call these external programs, or it can be +an Emacs Lisp function that will return a buffer containing the content +of the file pointed to by the URL." + :group 'org-feed + :type '(choice + (const :tag "Internally with url.el" url-retrieve-synchronously) + (const :tag "Externally with curl" curl) + (const :tag "Externally with wget" wget) + (function :tag "Function"))) + + (defcustom org-feed-before-adding-hook nil + "Hook that is run before adding new feed items to a file. +You might want to commit the file in its current state to version control, +for example." + :group 'org-feed + :type 'hook) + +(defcustom org-feed-after-adding-hook nil + "Hook that is run after new items have been added to a file. +Depending on `org-feed-save-after-adding', the buffer will already +have been saved." + :group 'org-feed + :type 'hook) + +(defvar org-feed-buffer "*Org feed*" + "The buffer used to retrieve a feed.") + +;;;###autoload +(defun org-feed-update-all () + "Get inbox items from all feeds in `org-feed-alist'." + (interactive) + (let ((nfeeds (length org-feed-alist)) + (nnew (apply '+ (mapcar 'org-feed-update org-feed-alist)))) + (message "%s from %d %s" + (cond ((= nnew 0) "No new entries") + ((= nnew 1) "1 new entry") + (t (format "%d new entries" nnew))) + nfeeds + (if (= nfeeds 1) "feed" "feeds")))) + +;;;###autoload +(defun org-feed-update (feed &optional retrieve-only) + "Get inbox items from FEED. +FEED can be a string with an association in `org-feed-alist', or +it can be a list structured like an entry in `org-feed-alist'." + (interactive (list (org-completing-read "Feed name: " org-feed-alist))) + (if (stringp feed) (setq feed (assoc feed org-feed-alist))) + (unless feed + (error "No such feed in `org-feed-alist")) + (catch 'exit + (let ((name (car feed)) + (url (nth 1 feed)) + (file (nth 2 feed)) + (headline (nth 3 feed)) + (filter (nth 1 (memq :filter feed))) + (formatter (nth 1 (memq :formatter feed))) + (new-handler (nth 1 (memq :new-handler feed))) + (changed-handler (nth 1 (memq :changed-handler feed))) + (template (or (nth 1 (memq :template feed)) + 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)) + 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)) + (unless (and feed-buffer (bufferp (get-buffer feed-buffer))) + (error "Cannot get feed %s" name)) + (when retrieve-only + (throw 'exit feed-buffer)) + (setq entries (funcall parse-feed feed-buffer)) + (ignore-errors (kill-buffer feed-buffer)) + (save-excursion + (save-window-excursion + (setq inbox-pos (org-feed-goto-inbox-internal file headline)) + (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))))) + entries)) + ;; Find out which entries are new and which are changed + (dolist (e entries) + (if (not (plist-get e :handled)) + (push e new) + (setq olds (nth 2 (assoc (plist-get e :guid) old-status))) + (if (and olds + (not (string= (sha1 + (plist-get e :item-full-text)) + olds))) + (push e changed)))) + + ;; Parse the relevant entries fully + (setq new (mapcar parse-entry new) + changed (mapcar parse-entry changed)) + + ;; Run the filter + (when filter + (setq new (delq nil (mapcar filter new)) + changed (delq nil (mapcar filter new)))) + + (when (not (or new changed)) + (message "No new items in feed %s" name) + (throw 'exit 0)) + + ;; Get alist based on guid, to look up entries + (setq guid-alist + (append + (mapcar (lambda (e) (list (plist-get e :guid) e)) new) + (mapcar (lambda (e) (list (plist-get e :guid) e)) changed))) + + ;; Construct the new status + (setq status + (mapcar + (lambda (e) + (setq guid (plist-get e :guid)) + (list guid + ;; things count as handled if we handle them now, + ;; or if they were handled previously + (if (assoc guid guid-alist) t (plist-get e :handled)) + ;; A hash, to detect changes + (sha1 (plist-get e :item-full-text)))) + entries)) + + ;; Handle new items in the feed + (when new + (if new-handler + (progn + (goto-char inbox-pos) + (funcall new-handler new)) + ;; No custom handler, do the default adding + ;; Format the new entries into an alist with GUIDs in the car + (setq new-formatted + (mapcar + (lambda (e) (org-feed-format-entry e template formatter)) + new))) + + ;; Insert the new items + (org-feed-add-items inbox-pos new-formatted)) + + ;; Handle changed items in the feed + (when (and changed-handler changed) + (goto-char inbox-pos) + (funcall changed-handler changed)) + + ;; Write the new status + ;; We do this only now, in case something goes wrong above, so + ;; that would would end up with a status that does not reflect + ;; which items truely have been handled + (org-feed-write-status inbox-pos drawer status) + + ;; Normalize the visibility of the inbox tree + (goto-char inbox-pos) + (hide-subtree) + (show-children) + (org-cycle-hide-drawers 'children) + + ;; Hooks and messages + (when org-feed-save-after-adding (save-buffer)) + (message "Added %d new item%s from feed %s to file %s, heading %s" + (length new) (if (> (length new) 1) "s" "") + name + (file-name-nondirectory file) headline) + (run-hooks 'org-feed-after-adding-hook) + (length new)))))) + +;;;###autoload +(defun org-feed-goto-inbox (feed) + "Go to the inbox that captures the feed named FEED." + (interactive + (list (if (= (length org-feed-alist) 1) + (car org-feed-alist) + (org-completing-read "Feed name: " org-feed-alist)))) + (if (stringp feed) (setq feed (assoc feed org-feed-alist))) + (unless feed + (error "No such feed in `org-feed-alist")) + (org-feed-goto-inbox-internal (nth 2 feed) (nth 3 feed))) + +;;;###autoload +(defun org-feed-show-raw-feed (feed) + "Show the raw feed buffer of a feed." + (interactive + (list (if (= (length org-feed-alist) 1) + (car org-feed-alist) + (org-completing-read "Feed name: " org-feed-alist)))) + (if (stringp feed) (setq feed (assoc feed org-feed-alist))) + (unless feed + (error "No such feed in `org-feed-alist")) + (switch-to-buffer + (org-feed-update feed 'retrieve-only)) + (goto-char (point-min))) + +(defun org-feed-goto-inbox-internal (file heading) + "Find or create HEADING in FILE. +Switch to that buffer, and return the position of that headline." + (find-file file) + (widen) + (goto-char (point-min)) + (if (re-search-forward + (concat "^\\*+[ \t]+" heading "[ \t]*\\(:.*?:[ \t]*\\)?$") + nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max)) + (insert "\n\n* " heading "\n\n") + (org-back-to-heading t)) + (point)) + +(defun org-feed-read-previous-status (pos drawer) + "Get the alist of old GUIDs from the entry at POS. +This will find DRAWER and extract the alist." + (save-excursion + (goto-char pos) + (let ((end (save-excursion (org-end-of-subtree t t)))) + (if (re-search-forward + (concat "^[ \t]*:" drawer ":[ \t]*\n\\([^\000]*?\\)\n[ \t]*:END:") + end t) + (read (match-string 1)) + nil)))) + +(defun org-feed-write-status (pos drawer status) + "Write the feed STATUS to DRAWER in entry at POS." + (save-excursion + (goto-char pos) + (let ((end (save-excursion (org-end-of-subtree t t))) + guid) + (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*\n") + end t) + (progn + (goto-char (match-end 0)) + (delete-region (point) + (save-excursion + (and (re-search-forward "^[ \t]*:END:" nil t) + (match-beginning 0))))) + (outline-next-heading) + (insert " :" drawer ":\n :END:\n") + (beginning-of-line 0)) + (insert (pp-to-string status))))) + +(defun org-feed-add-items (pos entries) + "Add the formatted items to the headline as POS." + (let (entry level) + (save-excursion + (goto-char pos) + (unless (looking-at org-complex-heading-regexp) + (error "Wrong position")) + (setq level (org-get-valid-level (length (match-string 1)) 1)) + (org-end-of-subtree t t) + (skip-chars-backward " \t\n") + (beginning-of-line 2) + (setq pos (point)) + (while (setq entry (pop entries)) + (org-paste-subtree level entry 'yank)) + (org-mark-ring-push pos)))) + +(defun org-feed-format-entry (entry template formatter) + "Format ENTRY so that it can be inserted into an Org file. +ENTRY is a property list. This function adds a `:formatted-for-org' property +and returns the full property list. +If that property is already present, nothing changes." + (if formatter + (funcall formatter entry) + (let (dlines fmt tmp indent time name + v-h v-t v-T v-u v-U v-a) + (setq dlines (org-split-string (or (plist-get entry :description) "???") + "\n") + v-h (or (plist-get entry :title) (car dlines) "???") + time (or (if (plist-get entry :pubDate) + (org-read-date t t (plist-get entry :pubDate))) + (current-time)) + v-t (format-time-string (org-time-stamp-format nil nil) time) + v-T (format-time-string (org-time-stamp-format t nil) time) + v-u (format-time-string (org-time-stamp-format nil t) time) + v-U (format-time-string (org-time-stamp-format t t) time) + v-a (if (setq tmp (or (and (plist-get entry :guid-permalink) + (plist-get entry :guid)) + (plist-get entry :link))) + (concat "[[" tmp "]]\n") + "")) + (with-temp-buffer + (insert template) + (goto-char (point-min)) + (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t) + (setq name (match-string 1)) + (cond + ((member name '("h" "t" "T" "u" "U" "a")) + (replace-match (symbol-value (intern (concat "v-" name))) t t)) + ((setq tmp (plist-get entry (intern (concat ":" name)))) + (save-excursion + (save-match-data + (beginning-of-line 1) + (when (looking-at (concat "^\\([ \t]*\\)%" name "[ \t]*$")) + (setq tmp (org-feed-make-indented-block + tmp (org-get-indentation)))))) + (replace-match tmp t t)))) + (buffer-string))))) + +(defun org-feed-make-indented-block (s n) + "Add indentaton of N spaces to a multiline string S." + (if (not (string-match "\n" s)) + s + (mapconcat 'identity + (org-split-string s "\n") + (concat "\n" (make-string n ?\ ))))) + +(defun org-feed-skip-http-headers (buffer) + "Remove HTTP headers from BUFFER, and return it. +Assumes headers are indeed present!" + (with-current-buffer buffer + (widen) + (goto-char (point-min)) + (search-forward "\n\n") + (delete-region (point-min) (point)) + buffer)) + +(defun org-feed-get-feed (url) + "Get the RSS feed file at URL and return the buffer." + (cond + ((eq org-feed-retrieve-method 'url-retrieve-synchronously) + (org-feed-skip-http-headers (url-retrieve-synchronously url))) + ((eq org-feed-retrieve-method 'curl) + (ignore-errors (kill-buffer org-feed-buffer)) + (call-process "curl" nil org-feed-buffer nil "--silent" url) + org-feed-buffer) + ((eq org-feed-retrieve-method 'wget) + (ignore-errors (kill-buffer org-feed-buffer)) + (call-process "wget" nil org-feed-buffer nil "-q" "-O" "-" url) + org-feed-buffer) + ((functionp org-feed-retrieve-method) + (funcall org-feed-retrieve-method url)))) + +(defun org-feed-parse-rss-feed (buffer) + "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) + (with-current-buffer buffer + (widen) + (goto-char (point-min)) + (while (re-search-forward "<item>" nil t) + (setq beg (point) + end (and (re-search-forward "</item>" nil t) + (match-beginning 0))) + (setq item (buffer-substring beg end) + guid (if (string-match "<guid\\>.*?>\\(.*?\\)</guid>" item) + (org-match-string-no-properties 1 item))) + (setq entry (list :guid guid :item-full-text item)) + (push entry entries) + (widen) + (goto-char end)) + (nreverse entries)))) + +(defun org-feed-parse-rss-entry (entry) + "Parse the `:item-full-text' field for xml tags and create new properties." + (with-temp-buffer + (insert (plist-get entry :item-full-text)) + (goto-char (point-min)) + (while (re-search-forward "<\\([a-zA-Z]+\\>\\).*?>\\([^\000]*?\\)</\\1>" + nil t) + (setq entry (plist-put entry + (intern (concat ":" (match-string 1))) + (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)))) + entry) + +(defun org-feed-parse-atom-feed (buffer) + "Parse BUFFER for Atom feed entries. +Returns a list of enttries, with each entry a property list, +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." + (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))) + (xml-get-children feed 'entry))))) + +(defun org-feed-parse-atom-entry (entry) + "Parse the `:item-full-text' as a sexp and create new properties." + (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))) + ;; Add <title/> as :title. + (setq entry (plist-put entry :title + (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))) + (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))))))) + entry)) + +(provide 'org-feed) + +;; arch-tag: 0929b557-9bc4-47f4-9633-30a12dbb5ae2 + +;;; org-feed.el ends here + diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index 3978d454d61..7da75b1989b 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -45,6 +45,7 @@ (declare-function org-show-context "org" (&optional key)) (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) +(defvar org-odd-levels-only) ;; defined in org.el (defconst org-footnote-re (concat "[^][\n]" ; to make sure it is not at the beginning of a line @@ -57,7 +58,7 @@ "\\]") "Regular expression for matching footnotes.") -(defconst org-footnote-definition-re +(defconst org-footnote-definition-re (org-re "^\\(\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]\\)") "Regular expression matching the definition of a footnote.") @@ -111,6 +112,23 @@ plain Automatically create plain number labels like [1]" (const :tag "Offer automatic [fn:N] for editing" confirm) (const :tag "Create automatic [N]" plain))) +(defcustom org-footnote-auto-adjust nil + "Non-nil means, automatically adjust footnotes after insert/delete. +When this is t, after each insertion or deletion of a footnote, +simple fn:N footnotes will be renumbered, and all footnotes will be sorted. +If you want to have just sorting or just renumbering, set this variable +to `sort' or `renumber'. + +The main values of this variable can be set with in-buffer options: + +#+STARTUP: fnadjust +#+STARTUP: nofnadjust" + :group 'org-footnote + :type '(choice + (const :tag "Renumber" renumber) + (const :tag "Sort" sort) + (const :tag "Renumber and Sort" t))) + (defcustom org-footnote-fill-after-inline-note-extraction nil "Non-nil means, fill paragraphs after extracting footnotes. When extracting inline footnotes, the lengths of lines can change a lot. @@ -246,10 +264,12 @@ or new, let the user edit the definition of the footnote." (message "New reference to existing note")) (org-footnote-define-inline (insert "[" label ": ]") - (backward-char 1)) + (backward-char 1) + (org-footnote-auto-adjust-maybe)) (t (insert "[" label "]") - (org-footnote-create-definition label))))) + (org-footnote-create-definition label) + (org-footnote-auto-adjust-maybe))))) (defun org-footnote-create-definition (label) "Start the definition of a footnote with label LABEL." @@ -295,11 +315,16 @@ With prefix arg SPECIAL, offer additional commands in a menu." (let (tmp c) (cond (special - (message "Footnotes: [s]ort | convert to [n]umeric | [d]elete") + (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s |->[n]umeric | [d]elete") (setq c (read-char-exclusive)) (cond ((equal c ?s) (org-footnote-normalize 'sort)) + ((equal c ?r) + (org-footnote-renumber-fn:N)) + ((equal c ?S) + (org-footnote-renumber-fn:N) + (org-footnote-normalize 'sort)) ((equal c ?n) (org-footnote-normalize)) ((equal c ?d) @@ -316,14 +341,24 @@ With prefix arg SPECIAL, offer additional commands in a menu." ;;;###autoload (defun org-footnote-normalize (&optional sort-only for-preprocessor) "Collect the footnotes in various formats and normalize them. -This find the different sorts of footnotes allowed in Org, and +This finds the different sorts of footnotes allowed in Org, and normalizes them to the usual [N] format that is understood by the Org-mode exporters. When SORT-ONLY is set, only sort the footnote definitions into the referenced sequence." ;; This is based on Paul's function, but rewritten. - (let ((count 0) ref def idef ref-table beg beg1 marker a before - ins-point) + (let* ((limit-level + (and (boundp 'org-inlinetask-min-level) + org-inlinetask-min-level + (1- org-inlinetask-min-level))) + (nstars (and limit-level + (if org-odd-levels-only + (and limit-level (1- (* limit-level 2))) + limit-level))) + (outline-regexp + (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))) + (count 0) + ref def idef ref-table beg beg1 marker a before ins-point) (save-excursion ;; Now find footnote references, and extract the definitions (goto-char (point-min)) @@ -362,8 +397,8 @@ referenced sequence." (and idef org-footnote-fill-after-inline-note-extraction (fill-paragraph))) - (if (not a) (push (list ref marker def) ref-table)))) - + (if (not a) (push (list ref marker def (if idef t nil)) ref-table)))) + ;; First find and remove the footnote section (goto-char (point-min)) (cond @@ -386,7 +421,7 @@ referenced sequence." (insert "* " org-footnote-section "\n") (setq ins-point (point)))))) (t - (if (re-search-forward + (if (re-search-forward (concat "^" (regexp-quote org-footnote-tag-for-non-org-mode-files) "[ \t]*$") @@ -397,16 +432,17 @@ referenced sequence." (delete-region (point) (point-max)) (insert "\n\n" org-footnote-tag-for-non-org-mode-files "\n") (setq ins-point (point)))) - + ;; Insert the footnotes again (goto-char (or ins-point (point-max))) (setq ref-table (reverse ref-table)) (when sort-only - ;; remove anonymous fotnotes from the list + ;; remove anonymous and inline footnotes from the list (setq ref-table (delq nil (mapcar (lambda (x) (and (car x) (not (equal (car x) "fn:")) + (not (nth 3 x)) x)) ref-table)))) ;; Make sure each footnote has a description, or an error message. @@ -451,12 +487,12 @@ ENTRY is (fn-label num-mark definition)." (defun org-footnote-goto-local-insertion-point () "Find insertion point for footnote, just before next outline heading." - (outline-next-heading) + (org-with-limited-levels (outline-next-heading)) (or (bolp) (newline)) (beginning-of-line 0) (while (and (not (bobp)) (= (char-after) ?#)) (beginning-of-line 0)) - (if (looking-at "#\\+TBLFM:") (beginning-of-line 2)) + (if (looking-at "[ \t]*#\\+TBLFM:") (beginning-of-line 2)) (end-of-line 1) (skip-chars-backward "\n\r\t ")) @@ -493,9 +529,42 @@ and all references of a footnote label." (goto-char (point-max))) (delete-region beg (point)) (incf ndef)))) + (org-footnote-auto-adjust-maybe) (message "%d definition(s) of and %d reference(s) of footnote %s removed" ndef nref label)))) +(defun org-footnote-renumber-fn:N () + "Renumber the simple footnotes like fn:17 into a sequence in the document." + (interactive) + (let (map i (n 0)) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward "\\[fn:\\([0-9]+\\)[]:]" nil t) + (setq i (string-to-number (match-string 1))) + (when (and (string-match "\\S-" (buffer-substring + (point-at-bol) (match-beginning 0))) + (not (assq i map))) + (push (cons i (number-to-string (incf n))) map))) + (goto-char (point-min)) + (while (re-search-forward "\\(\\[fn:\\)\\([0-9]+\\)\\([]:]\\)" nil t) + (replace-match (concat "\\1" (cdr (assq (string-to-number (match-string 2)) map)) "\\3"))))))) + +(defun org-footnote-auto-adjust-maybe () + "Renumber and/or sort footnotes according to user settings." + (when (memq org-footnote-auto-adjust '(t renumber)) + (org-footnote-renumber-fn:N)) + (when (memq org-footnote-auto-adjust '(t sort)) + (let ((label (nth 1 (org-footnote-at-definition-p)))) + (org-footnote-normalize 'sort) + (when label + (goto-char (point-min)) + (and (re-search-forward (concat "^\\[" (regexp-quote label) "\\]") + nil t) + (progn (insert " ") + (just-one-space))))))) + (provide 'org-footnote) ;; arch-tag: 1b5954df-fb5d-4da5-8709-78d944dbfc37 diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index 6ef5778d543..dbc4ee7db4c 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -53,6 +53,9 @@ negates this setting for the duration of the command." ;; Declare external functions and variables (declare-function gnus-article-show-summary "gnus-art" ()) (declare-function gnus-summary-last-subject "gnus-sum" ()) +(declare-function message-fetch-field "message" (header &optional not-all)) +(declare-function message-narrow-to-head-1 "message" nil) + (defvar gnus-other-frame-object) (defvar gnus-group-name) (defvar gnus-article-current) @@ -125,6 +128,11 @@ If `org-store-link' was called with a prefix arg the meaning of (header (with-current-buffer gnus-article-buffer (gnus-summary-toggle-header 1) (goto-char (point-min)) + ;; mbox files may contain a first line starting with + ;; "From" followed by a space, which cannot be parsed as + ;; header line, so we skip it. + (when (looking-at "From ") + (beginning-of-line 2)) (mail-header-extract-no-properties))) (from (mail-header 'from header)) (message-id (org-remove-angle-brackets @@ -134,7 +142,10 @@ If `org-store-link' was called with a prefix arg the meaning of (newsgroups (mail-header 'newsgroups header)) (x-no-archive (mail-header 'x-no-archive header)) (subject (if (eq major-mode 'gnus-article-mode) - (message-fetch-field "subject") + (save-restriction + (require 'message) + (message-narrow-to-head-1) + (message-fetch-field "subject")) (gnus-summary-subject-string))) desc link) (org-store-link-props :type "gnus" :from from :subject subject diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el new file mode 100644 index 00000000000..c321c71d816 --- /dev/null +++ b/lisp/org/org-html.el @@ -0,0 +1,2084 @@ +;;; org-html.el --- HTML export for Org-mode + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.29c +;; +;; 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: + +(require 'org-exp) + +(declare-function org-id-find-id-file "org-id" (id)) +(declare-function htmlize-region "ext:htmlize" (beg end)) + +(defgroup org-export-html nil + "Options specific for HTML export of Org-mode files." + :tag "Org Export HTML" + :group 'org-export) + +(defcustom org-export-html-footnotes-section "<div id=\"footnotes\"> +<h2 class=\"footnotes\">%s: </h2> +<div id=\"text-footnotes\"> +%s +</div> +</div>" + "Format for the footnotes section. +Should contain a two instances of %s. The first will be replaced with the +language-specific word for \"Footnotes\", the second one will be replaced +by the footnotes themselves." + :group 'org-export-html + :type 'string) + +(defcustom org-export-html-footnote-format "<sup>%s</sup>" + "The format for the footnote reference. +%s will be replaced by the footnote reference itself." + :group 'org-export-html + :type 'string) + +(defcustom org-export-html-coding-system nil + "Coding system for HTML export, defaults to buffer-file-coding-system." + :group 'org-export-html + :type 'coding-system) + +(defcustom org-export-html-extension "html" + "The extension for exported HTML files." + :group 'org-export-html + :type 'string) + +(defcustom org-export-html-xml-declaration + '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>") + ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>")) + "The extension for exported HTML files. +%s will be replaced with the charset of the exported file. +This may be a string, or an alist with export extensions +and corresponding declarations." + :group 'org-export-html + :type '(choice + (string :tag "Single declaration") + (repeat :tag "Dependent on extension" + (cons (string :tag "Extension") + (string :tag "Declaration"))))) + +(defcustom org-export-html-style-include-scripts t + "Non-nil means, include the javascript snippets in exported HTML files. +The actual script is defined in `org-export-html-scripts' and should +not be modified." + :group 'org-export-html + :type 'boolean) + +(defconst org-export-html-scripts +"<script type=\"text/javascript\"> +<!--/*--><![CDATA[/*><!--*/ + function CodeHighlightOn(elem, id) + { + var target = document.getElementById(id); + if(null != target) { + elem.cacheClassElem = elem.className; + elem.cacheClassTarget = target.className; + target.className = \"code-highlighted\"; + elem.className = \"code-highlighted\"; + } + } + function CodeHighlightOff(elem, id) + { + var target = document.getElementById(id); + if(elem.cacheClassElem) + elem.className = elem.cacheClassElem; + if(elem.cacheClassTarget) + target.className = elem.cacheClassTarget; + } +/*]]>*///--> +</script>" +"Basic javascript that is needed by HTML files produced by Org-mode.") + +(defconst org-export-html-style-default +"<style type=\"text/css\"> + <!--/*--><![CDATA[/*><!--*/ + html { font-family: Times, serif; font-size: 12pt; } + .title { text-align: center; } + .todo { color: red; } + .done { color: green; } + .tag { background-color: #add8e6; font-weight:normal } + .target { } + .timestamp { color: #bebebe; } + .timestamp-kwd { color: #5f9ea0; } + p.verse { margin-left: 3% } + pre { + border: 1pt solid #AEBDCC; + background-color: #F3F5F7; + padding: 5pt; + font-family: courier, monospace; + font-size: 90%; + overflow:auto; + } + table { border-collapse: collapse; } + td, th { vertical-align: top; } + dt { font-weight: bold; } + div.figure { padding: 0.5em; } + div.figure p { text-align: center; } + .linenr { font-size:smaller } + .code-highlighted {background-color:#ffff00;} + .org-info-js_info-navigation { border-style:none; } + #org-info-js_console-label { font-size:10px; font-weight:bold; + white-space:nowrap; } + .org-info-js_search-highlight {background-color:#ffff00; color:#000000; + font-weight:bold; } + /*]]>*/--> +</style>" + "The default style specification for exported HTML files. +Please use the variables `org-export-html-style' and +`org-export-html-style-extra' to add to this style. If you wish to not +have the default style included, customize the variable +`org-export-html-style-include-default'.") + +(defcustom org-export-html-style-include-default t + "Non-nil means, include the default style in exported HTML files. +The actual style is defined in `org-export-html-style-default' and should +not be modified. Use the variables `org-export-html-style' to add +your own style information." + :group 'org-export-html + :type 'boolean) +;;;###autoload +(put 'org-export-html-style 'safe-local-variable 'booleanp) + +(defcustom org-export-html-style "" + "Org-wide style definitions for exported HTML files. + +This variable needs to contain the full HTML structure to provide a style, +including the surrounding HTML tags. If you set the value of this variable, +you should consider to include definitions for the following classes: + title, todo, done, timestamp, timestamp-kwd, tag, target. + +For example, a valid value would be: + + <style type=\"text/css\"> + <![CDATA[ + p { font-weight: normal; color: gray; } + h1 { color: black; } + .title { text-align: center; } + .todo, .timestamp-kwd { color: red; } + .done { color: green; } + ]]> + </style> + +If you'd like to refer to en external style file, use something like + + <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> + +As the value of this option simply gets inserted into the HTML <head> header, +you can \"misuse\" it to add arbitrary text to the header. +See also the variable `org-export-html-style-extra'." + :group 'org-export-html + :type 'string) +;;;###autoload +(put 'org-export-html-style 'safe-local-variable 'stringp) + +(defcustom org-export-html-style-extra "" + "Additional style information for HTML export. +The value of this variable is inserted into the HTML buffer right after +the value of `org-export-html-style'. Use this variable for per-file +settings of style information, and do not forget to surround the style +settings with <style>...</style> tags." + :group 'org-export-html + :type 'string) +;;;###autoload +(put 'org-export-html-style-extra 'safe-local-variable 'stringp) + +(defcustom org-export-html-tag-class-prefix "" + "Prefix to clas 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." + :group 'org-export-html + :type 'string) + +(defcustom org-export-html-todo-kwd-class-prefix "" + "Prefix to clas 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." + :group 'org-export-html + :type 'string) + +(defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n" + "Format for typesetting the document title in HTML export." + :group 'org-export-html + :type 'string) + +(defcustom org-export-html-home/up-format + "<div style=\"text-align:right;font-size:70%%;white-space:nowrap;\"> + <a accesskey=\"h\" href=\"%s\"> UP </a> + | + <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." + :group 'org-export-html + :type 'string) + +(defcustom org-export-html-toplevel-hlevel 2 + "The <H> level for level 1 headings in HTML export. +This is also important for the classes that will be wrapped around headlines +and outline structure. If this variable is 1, the top-level headlines will +be <h1>, and the corresponding classes will be outline-1, section-number-1, +and outline-text-1. If this is 2, all of these will get a 2 instead. +The default for this variable is 2, because we use <h1> for formatting the +document title." + :group 'org-export-html + :type 'string) + +(defcustom org-export-html-link-org-files-as-html t + "Non-nil means, make file links to `file.org' point to `file.html'. +When org-mode is exporting an org-mode file to HTML, links to +non-html files are directly put into a href tag in HTML. +However, links to other Org-mode files (recognized by the +extension `.org.) should become links to the corresponding html +file, assuming that the linked org-mode file will also be +converted to HTML. +When nil, the links still point to the plain `.org' file." + :group 'org-export-html + :type 'boolean) + +(defcustom org-export-html-inline-images 'maybe + "Non-nil means, inline images into exported HTML pages. +This is done using an <img> tag. When nil, an anchor with href is used to +link to the image. If this option is `maybe', then images in links with +an empty description will be inlined, while images with a description will +be linked only." + :group 'org-export-html + :type '(choice (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "When there is no description" maybe))) + +(defcustom org-export-html-inline-image-extensions + '("png" "jpeg" "jpg" "gif") + "Extensions of image files that can be inlined into HTML." + :group 'org-export-html + :type '(repeat (string :tag "Extension"))) + +(defcustom org-export-html-table-tag + "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">" + "The HTML tag that is used to start a table. +This must be a <table> tag, but you may change the options like +borders and spacing." + :group 'org-export-html + :type 'string) + +(defcustom org-export-table-header-tags '("<th scope=\"%s\">" . "</th>") + "The opening tag for table header fields. +This is customizable so that alignment options can be specified. +%s will be filled with the scope of the field, either row or col. +See also the variable `org-export-html-table-use-header-tags-for-first-column'." + :group 'org-export-tables + :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) + +(defcustom org-export-table-data-tags '("<td>" . "</td>") + "The opening tag for table data fields. +This is customizable so that alignment options can be specified." + :group 'org-export-tables + :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) + +(defcustom org-export-table-row-tags '("<tr>" . "</tr>") + "The opening tag for table data fields. +This is customizable so that alignment options can be specified. +Instead of strings, these can be Lisp forms that will be evaluated +for each row in order to construct the table row tags. During evaluation, +the variable `head' will be true when this is a header line, nil when this +is a body line. And the variable `nline' will contain the line number, +starting from 1 in the first header line. For example + + (setq org-export-table-row-tags + (cons '(if head + \"<tr>\" + (if (= (mod nline 2) 1) + \"<tr class=\\\"tr-odd\\\">\" + \"<tr class=\\\"tr-even\\\">\")) + \"</tr>\")) + +will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"." + :group 'org-export-tables + :type '(cons + (choice :tag "Opening tag" + (string :tag "Specify") + (sexp)) + (choice :tag "Closing tag" + (string :tag "Specify") + (sexp)))) + + + +(defcustom org-export-html-table-use-header-tags-for-first-column nil + "Non-nil means, format column one in tables with header tags. +When nil, also column one will use data tags." + :group 'org-export-tables + :type 'boolean) + +(defcustom org-export-html-validation-link nil + "Non-nil means, add validationlink to postamble of HTML exported files." + :group 'org-export-html + :type '(choice + (const :tag "Nothing" nil) + (const :tag "XHTML 1.0" "<p class=\"xhtml-validation\"><a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a></p>") + (string :tag "Specify full HTML"))) + + +(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." + :group 'org-export-html + :type 'boolean) + +(defcustom org-export-html-html-helper-timestamp + "<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n" + "The HTML tag used as timestamp delimiter for HTML-helper-mode." + :group 'org-export-html + :type 'string) + +(defgroup org-export-htmlize nil + "Options for processing examples with htmlize.el." + :tag "Org Export Htmlize" + :group 'org-export-html) + +(defcustom org-export-htmlize-output-type 'inline-css + "Output type to be used by htmlize when formatting code snippets. +We use as default `inline-css', in order to make the resulting +HTML self-containing. +However, this will fail when using Emacs in batch mode for export, because +then no rich font definitions are in place. It will also not be good if +people with different Emacs setup contribute HTML files to a website, +because the fonts will represent the individual setups. In these cases, +it is much better to let Org/Htmlize assign classes only, and to use +a style file to define the look of these classes. +To get a start for your css file, start Emacs session and make sure that +all the faces you are interested in are defined, for example by loading files +in all modes you want. Then, use the command +\\[org-export-htmlize-generate-css] to extract class definitions." + :group 'org-export-htmlize + :type '(choice (const css) (const inline-css))) + +(defcustom org-export-htmlize-css-font-prefix "org-" + "The prefix for CSS class names for htmlize font specifications." + :group 'org-export-htmlize + :type 'string) + +(defcustom org-export-htmlized-org-css-url nil + "URL pointing to a CSS file defining text colors for htmlized Emacs buffers. +Normally when creating an htmlized version of an Org buffer, htmlize will +create CSS to define the font colors. However, this does not work when +converting in batch mode, and it also can look bad if different people +with different fontification setup work on the same website. +When this variable is non-nil, creating an htmlized version of an Org buffer +using `org-export-as-org' will remove the internal CSS section and replace it +with a link to this URL." + :group 'org-export-htmlize + :type '(choice + (const :tag "Keep internal css" nil) + (string :tag "URL or local href"))) + +;;; Variables, constants, and parameter plists + +(defvar org-export-html-preamble nil + "Preamble, to be inserted just before <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. +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.") +(defvar org-export-html-auto-postamble t + "Should default postamble be inserted? Set by publishing functions.") + +;;; Hooks + +(defvar org-export-html-after-blockquotes-hook nil + "Hook run during HTML export, after blockquote, verse, center are done.") + +;;; HTML export + +(defun org-export-html-preprocess (parameters) + ;; Convert LaTeX fragments to images + (when (and org-current-export-file + (plist-get parameters :LaTeX-fragments)) + (org-format-latex + (concat "ltxpng/" (file-name-sans-extension + (file-name-nondirectory + org-current-export-file))) + org-current-export-dir nil "Creating LaTeX image %s")) + (message "Exporting...")) + +;;;###autoload +(defun org-export-as-html-and-open (arg) + "Export the outline as HTML and immediately open it with a browser. +If there is an active region, export only the region. +The prefix ARG specifies how many levels of the outline should become +headlines. The default is 3. Lower levels will become bulleted lists." + (interactive "P") + (org-export-as-html arg 'hidden) + (org-open-file buffer-file-name)) + +;;;###autoload +(defun org-export-as-html-batch () + "Call `org-export-as-html', may be used in batch processing as +emacs --batch + --load=$HOME/lib/emacs/org.el + --eval \"(setq org-export-headline-levels 2)\" + --visit=MyFile --funcall org-export-as-html-batch" + (org-export-as-html org-export-headline-levels 'hidden)) + +;;;###autoload +(defun org-export-as-html-to-buffer (arg) + "Call `org-export-as-html` with output to a temporary buffer. +No file is created. The prefix ARG is passed through to `org-export-as-html'." + (interactive "P") + (org-export-as-html arg nil nil "*Org HTML Export*") + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window "*Org HTML Export*"))) + +;;;###autoload +(defun org-replace-region-by-html (beg end) + "Assume the current region has org-mode syntax, and convert it to HTML. +This can be used in any buffer. For example, you could write an +itemized list in org-mode syntax in an HTML buffer and then use this +command to convert it." + (interactive "r") + (let (reg html buf pop-up-frames) + (save-window-excursion + (if (org-mode-p) + (setq html (org-export-region-as-html + beg end t 'string)) + (setq reg (buffer-substring beg end) + buf (get-buffer-create "*Org tmp*")) + (with-current-buffer buf + (erase-buffer) + (insert reg) + (org-mode) + (setq html (org-export-region-as-html + (point-min) (point-max) t 'string))) + (kill-buffer buf))) + (delete-region beg end) + (insert html))) + +;;;###autoload +(defun org-export-region-as-html (beg end &optional body-only buffer) + "Convert region from BEG to END in org-mode buffer to HTML. +If prefix arg BODY-ONLY is set, omit file header, footer, and table of +contents, and only produce the region of converted text, useful for +cut-and-paste operations. +If BUFFER is a buffer or a string, use/create that buffer as a target +of the converted HTML. If BUFFER is the symbol `string', return the +produced HTML as a string and leave not buffer behind. For example, +a Lisp program could call this function in the following way: + + (setq html (org-export-region-as-html beg end t 'string)) + +When called interactively, the output buffer is selected, and shown +in a window. A non-interactive call will only return the buffer." + (interactive "r\nP") + (when (interactive-p) + (setq buffer "*Org HTML Export*")) + (let ((transient-mark-mode t) (zmacs-regions t) + ext-plist rtn) + (setq ext-plist (plist-put ext-plist :ignore-subree-p t)) + (goto-char end) + (set-mark (point)) ;; to activate the region + (goto-char beg) + (setq rtn (org-export-as-html + nil nil ext-plist + buffer body-only)) + (if (fboundp 'deactivate-mark) (deactivate-mark)) + (if (and (interactive-p) (bufferp rtn)) + (switch-to-buffer-other-window rtn) + rtn))) + +(defvar html-table-tag nil) ; dynamically scoped into this. +(defvar org-par-open nil) +;;;###autoload +(defun org-export-as-html (arg &optional hidden ext-plist + to-buffer body-only pub-dir) + "Export the outline as a pretty HTML file. +If there is an active region, export only the region. The prefix +ARG specifies how many levels of the outline should become +headlines. The default is 3. Lower levels will become bulleted +lists. HIDDEN is obsolete and does nothing. +EXT-PLIST is a property list with external parameters overriding +org-mode's default settings, but still inferior to file-local +settings. When TO-BUFFER is non-nil, create a buffer with that +name and export to that buffer. If TO-BUFFER is the symbol +`string', don't leave any buffer behind but just return the +resulting HTML as a string. When BODY-ONLY is set, don't produce +the file header and footer, simply return the content of +<body>...</body>, without even the body tags themselves. When +PUB-DIR is set, use this as the publishing directory." + (interactive "P") + + ;; Make sure we have a file name when we need it. + (when (and (not (or to-buffer body-only)) + (not buffer-file-name)) + (if (buffer-base-buffer) + (org-set-local 'buffer-file-name + (with-current-buffer (buffer-base-buffer) + buffer-file-name)) + (error "Need a file name to be able to export."))) + + (message "Exporting...") + (setq-default org-todo-line-regexp org-todo-line-regexp) + (setq-default org-deadline-line-regexp org-deadline-line-regexp) + (setq-default org-done-keywords org-done-keywords) + (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp) + (let* ((opt-plist + (org-export-process-option-filters + (org-combine-plists (org-default-export-plist) + ext-plist + (org-infile-export-plist)))) + (body-only (or body-only (plist-get opt-plist :body-only))) + (style (concat (if (plist-get opt-plist :style-include-default) + org-export-html-style-default) + (plist-get opt-plist :style) + (plist-get opt-plist :style-extra) + "\n" + (if (plist-get opt-plist :style-include-scripts) + org-export-html-scripts))) + (html-extension (plist-get opt-plist :html-extension)) + (link-validate (plist-get opt-plist :link-validation-function)) + valid thetoc have-headings first-heading-pos + (odd org-odd-levels-only) + (region-p (org-region-active-p)) + (rbeg (and region-p (region-beginning))) + (rend (and region-p (region-end))) + (subtree-p + (if (plist-get opt-plist :ignore-subree-p) + nil + (when region-p + (save-excursion + (goto-char rbeg) + (and (org-at-heading-p) + (>= (org-end-of-subtree t t) rend)))))) + (level-offset (if subtree-p + (save-excursion + (goto-char rbeg) + (+ (funcall outline-level) + (if org-odd-levels-only 1 0))) + 0)) + (opt-plist (setq org-export-opt-plist + (if subtree-p + (org-export-add-subtree-options opt-plist rbeg) + opt-plist))) + ;; The following two are dynamically scoped into other + ;; routines below. + (org-current-export-dir + (or pub-dir (org-export-directory :html opt-plist))) + (org-current-export-file buffer-file-name) + (level 0) (line "") (origline "") txt todo + (umax nil) + (umax-toc nil) + (filename (if to-buffer nil + (expand-file-name + (concat + (file-name-sans-extension + (or (and subtree-p + (org-entry-get (region-beginning) + "EXPORT_FILE_NAME" t)) + (file-name-nondirectory buffer-file-name))) + "." html-extension) + (file-name-as-directory + (or pub-dir (org-export-directory :html opt-plist)))))) + (current-dir (if buffer-file-name + (file-name-directory buffer-file-name) + default-directory)) + (buffer (if to-buffer + (cond + ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*")) + (t (get-buffer-create to-buffer))) + (find-file-noselect filename))) + (org-levels-open (make-vector org-level-max nil)) + (date (plist-get opt-plist :date)) + (author (plist-get opt-plist :author)) + (title (or (and subtree-p (org-export-get-title-from-subtree)) + (plist-get opt-plist :title) + (and (not + (plist-get opt-plist :skip-before-1st-heading)) + (org-export-grab-title-from-buffer)) + (and buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name))) + "UNTITLED")) + (link-up (and (plist-get opt-plist :link-up) + (string-match "\\S-" (plist-get opt-plist :link-up)) + (plist-get opt-plist :link-up))) + (link-home (and (plist-get opt-plist :link-home) + (string-match "\\S-" (plist-get opt-plist :link-home)) + (plist-get opt-plist :link-home))) + (dummy (setq opt-plist (plist-put opt-plist :title title))) + (html-table-tag (plist-get opt-plist :html-table-tag)) + (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) + (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)")) + (inquote nil) + (infixed nil) + (inverse nil) + (in-local-list nil) + (local-list-type nil) + (local-list-indent nil) + (llt org-plain-list-ordered-item-terminator) + (email (plist-get opt-plist :email)) + (language (plist-get opt-plist :language)) + (keywords (plist-get opt-plist :keywords)) + (description (plist-get opt-plist :description)) + (lang-words nil) + (head-count 0) cnt + (start 0) + (coding-system (and (boundp 'buffer-file-coding-system) + buffer-file-coding-system)) + (coding-system-for-write (or org-export-html-coding-system + coding-system)) + (save-buffer-coding-system (or org-export-html-coding-system + coding-system)) + (charset (and coding-system-for-write + (fboundp 'coding-system-get) + (coding-system-get coding-system-for-write + 'mime-charset))) + (region + (buffer-substring + (if region-p (region-beginning) (point-min)) + (if region-p (region-end) (point-max)))) + (lines + (org-split-string + (org-export-preprocess-string + region + :emph-multiline t + :for-html t + :skip-before-1st-heading + (plist-get opt-plist :skip-before-1st-heading) + :drawers (plist-get opt-plist :drawers) + :todo-keywords (plist-get opt-plist :todo-keywords) + :tags (plist-get opt-plist :tags) + :priority (plist-get opt-plist :priority) + :footnotes (plist-get opt-plist :footnotes) + :timestamps (plist-get opt-plist :timestamps) + :archived-trees + (plist-get opt-plist :archived-trees) + :select-tags (plist-get opt-plist :select-tags) + :exclude-tags (plist-get opt-plist :exclude-tags) + :add-text + (plist-get opt-plist :text) + :LaTeX-fragments + (plist-get opt-plist :LaTeX-fragments)) + "[\r\n]")) + table-open type + table-buffer table-orig-buffer + ind item-type starter didclose + rpl path attr desc descp desc1 desc2 link + snumber fnc item-tag + footnotes footref-seen + id-file href + ) + + (let ((inhibit-read-only t)) + (org-unmodified + (remove-text-properties (point-min) (point-max) + '(:org-license-to-kill t)))) + + (message "Exporting...") + + (setq org-min-level (org-get-min-level lines level-offset)) + (setq org-last-level org-min-level) + (org-init-section-numbers) + + (cond + ((and date (string-match "%" date)) + (setq date (format-time-string date))) + (date) + (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) + + ;; Get the language-dependent settings + (setq lang-words (or (assoc language org-export-language-setup) + (assoc "en" org-export-language-setup))) + + ;; Switch to the output buffer + (set-buffer buffer) + (let ((inhibit-read-only t)) (erase-buffer)) + (fundamental-mode) + (org-install-letbind) + + (and (fboundp 'set-buffer-file-coding-system) + (set-buffer-file-coding-system coding-system-for-write)) + + (let ((case-fold-search nil) + (org-odd-levels-only odd)) + ;; create local variables for all options, to make sure all called + ;; functions get the correct information + (mapc (lambda (x) + (set (make-local-variable (nth 2 x)) + (plist-get opt-plist (car x)))) + org-export-plist-vars) + (setq umax (if arg (prefix-numeric-value arg) + org-export-headline-levels)) + (setq umax-toc (if (integerp org-export-with-toc) + (min org-export-with-toc umax) + umax)) + (unless body-only + ;; File header + (insert (format + "%s +<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" + \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"> +<html xmlns=\"http://www.w3.org/1999/xhtml\" +lang=\"%s\" xml:lang=\"%s\"> +<head> +%s +<title>%s</title> +<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/> +<meta name=\"generator\" content=\"Org-mode\"/> +<meta name=\"generated\" content=\"%s\"/> +<meta name=\"author\" content=\"%s\"/> +<meta name=\"description\" content=\"%s\"/> +<meta name=\"keywords\" content=\"%s\"/> +%s +</head> +<body> +<div id=\"content\"> +" + (format + (or (and (stringp org-export-html-xml-declaration) + org-export-html-xml-declaration) + (cdr (assoc html-extension org-export-html-xml-declaration)) + (cdr (assoc "html" org-export-html-xml-declaration)) + + "") + (or charset "iso-8859-1")) + language language + (if (or link-up link-home) + (concat + (format org-export-html-home/up-format + (or link-up link-home) + (or link-home link-up)) + "\n") + "") + (org-html-expand title) + (or charset "iso-8859-1") + date author description keywords + style)) + + (org-export-html-insert-plist-item opt-plist :preamble opt-plist) + + (when (plist-get opt-plist :auto-preamble) + (if title (insert (format org-export-html-title-format + (org-html-expand title)))))) + + (if (and org-export-with-toc (not body-only)) + (progn + (push (format "<h%d>%s</h%d>\n" + org-export-html-toplevel-hlevel + (nth 3 lang-words) + org-export-html-toplevel-hlevel) + thetoc) + (push "<div id=\"text-table-of-contents\">\n" thetoc) + (push "<ul>\n<li>" thetoc) + (setq lines + (mapcar '(lambda (line) + (if (string-match org-todo-line-regexp line) + ;; This is a headline + (progn + (setq have-headings t) + (setq level (- (match-end 1) (match-beginning 1) + level-offset) + level (org-tr-level level) + txt (save-match-data + (org-html-expand + (org-export-cleanup-toc-line + (match-string 3 line)))) + todo + (or (and org-export-mark-todo-in-toc + (match-beginning 2) + (not (member (match-string 2 line) + org-done-keywords))) + ; TODO, not DONE + (and org-export-mark-todo-in-toc + (= level umax-toc) + (org-search-todo-below + line lines level)))) + (if (string-match + (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) + (setq txt (replace-match " <span class=\"tag\"> \\1</span>" t nil txt))) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) + (setq snumber (org-section-number level)) + (if org-export-with-section-numbers + (setq txt (concat snumber " " txt))) + (if (<= level (max umax umax-toc)) + (setq head-count (+ head-count 1))) + (if (<= level umax-toc) + (progn + (if (> level org-last-level) + (progn + (setq cnt (- level org-last-level)) + (while (>= (setq cnt (1- cnt)) 0) + (push "\n<ul>\n<li>" thetoc)) + (push "\n" thetoc))) + (if (< level org-last-level) + (progn + (setq cnt (- org-last-level level)) + (while (>= (setq cnt (1- cnt)) 0) + (push "</li>\n</ul>" thetoc)) + (push "\n" thetoc))) + ;; Check for targets + (while (string-match org-any-target-regexp line) + (setq line (replace-match + (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") + t t line))) + (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) + (setq txt (replace-match "" t t txt))) + (setq href (format "sec-%s" snumber)) + (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href)) + (push + (format + (if todo + "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>" + "</li>\n<li><a href=\"#%s\">%s</a>") + href txt) thetoc) + + (setq org-last-level level)) + ))) + line) + lines)) + (while (> org-last-level (1- org-min-level)) + (setq org-last-level (1- org-last-level)) + (push "</li>\n</ul>\n" thetoc)) + (push "</div>\n" thetoc) + (setq thetoc (if have-headings (nreverse thetoc) nil)))) + + (setq head-count 0) + (org-init-section-numbers) + + (org-open-par) + + (while (setq line (pop lines) origline line) + (catch 'nextline + + ;; end of quote section? + (when (and inquote (string-match "^\\*+ " line)) + (insert "</pre>\n") + (org-open-par) + (setq inquote nil)) + ;; inside a quote section? + (when inquote + (insert (org-html-protect line) "\n") + (throw 'nextline nil)) + + ;; Fixed-width, verbatim lines (examples) + (when (and org-export-with-fixed-width + (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line)) + (when (not infixed) + (setq infixed t) + (org-close-par-maybe) + + (insert "<pre class=\"example\">\n")) + (insert (org-html-protect (match-string 3 line)) "\n") + (when (or (not lines) + (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" + (car lines)))) + (setq infixed nil) + (insert "</pre>\n") + (org-open-par)) + (throw 'nextline nil)) + + (org-export-html-close-lists-maybe line) + + ;; Protected HTML + (when (get-text-property 0 'org-protected line) + (let (par (ind (get-text-property 0 'original-indentation line))) + (when (re-search-backward + "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t) + (setq par (match-string 1)) + (replace-match "\\2\n")) + (insert line "\n") + (while (and lines + (or (= (length (car lines)) 0) + (not ind) + (equal ind (get-text-property 0 'original-indentation (car lines)))) + (or (= (length (car lines)) 0) + (get-text-property 0 'org-protected (car lines)))) + (insert (pop lines) "\n")) + (and par (insert "<p>\n"))) + (throw 'nextline nil)) + + ;; Blockquotes, verse, and center + (when (equal "ORG-BLOCKQUOTE-START" line) + (org-close-par-maybe) + (insert "<blockquote>\n") + (org-open-par) + (throw 'nextline nil)) + (when (equal "ORG-BLOCKQUOTE-END" line) + (org-close-par-maybe) + (insert "\n</blockquote>\n") + (org-open-par) + (throw 'nextline nil)) + (when (equal "ORG-VERSE-START" line) + (org-close-par-maybe) + (insert "\n<p class=\"verse\">\n") + (setq inverse t) + (throw 'nextline nil)) + (when (equal "ORG-VERSE-END" line) + (insert "</p>\n") + (org-open-par) + (setq inverse nil) + (throw 'nextline nil)) + (when (equal "ORG-CENTER-START" line) + (org-close-par-maybe) + (insert "\n<div style=\"text-align: center\">") + (org-open-par) + (throw 'nextline nil)) + (when (equal "ORG-CENTER-END" line) + (org-close-par-maybe) + (insert "\n</div>") + (org-open-par) + (throw 'nextline nil)) + (run-hooks 'org-export-html-after-blockquotes-hook) + (when inverse + (let ((i (org-get-string-indentation line))) + (if (> i 0) + (setq line (concat (mapconcat 'identity + (make-list (* 2 i) "\\nbsp") "") + " " (org-trim line)))) + (unless (string-match "\\\\\\\\[ \t]*$" line) + (setq line (concat line "\\\\"))))) + + ;; make targets to anchors + (while (string-match + "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line) + (cond + ((match-end 2) + (setq line (replace-match + (format + "@<a name=\"%s\" id=\"%s\">@</a>" + (org-solidify-link-text (match-string 1 line)) + (org-solidify-link-text (match-string 1 line))) + t t line))) + ((and org-export-with-toc (equal (string-to-char line) ?*)) + ;; FIXME: NOT DEPENDENT on TOC????????????????????? + (setq line (replace-match + (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") +; (concat "@<i>" (match-string 1 line) "@</i> ") + t t line))) + (t + (setq line (replace-match + (concat "@<a name=\"" + (org-solidify-link-text (match-string 1 line)) + "\" class=\"target\">" (match-string 1 line) "@</a> ") + t t line))))) + + (setq line (org-html-handle-time-stamps line)) + + ;; replace "&" by "&", "<" and ">" by "<" and ">" + ;; handle @<..> HTML tags (replace "@>..<" by "<..>") + ;; Also handle sub_superscripts and checkboxes + (or (string-match org-table-hline-regexp line) + (setq line (org-html-expand line))) + + ;; Format the links + (setq start 0) + (while (string-match org-bracket-link-analytic-regexp++ line start) + (setq start (match-beginning 0)) + (setq path (save-match-data (org-link-unescape + (match-string 3 line)))) + (setq type (cond + ((match-end 2) (match-string 2 line)) + ((save-match-data + (or (file-name-absolute-p path) + (string-match "^\\.\\.?/" path))) + "file") + (t "internal"))) + (setq path (org-extract-attributes (org-link-unescape path))) + (setq attr (get-text-property 0 'org-attributes path)) + (setq desc1 (if (match-end 5) (match-string 5 line)) + desc2 (if (match-end 2) (concat type ":" path) path) + descp (and desc1 (not (equal desc1 desc2))) + desc (or desc1 desc2)) + ;; Make an image out of the description if that is so wanted + (when (and descp (org-file-image-p + desc org-export-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>"))) + ((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>")))) + ((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>")))) + ((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>"))) + + ((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)))))) + + ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) + ;; The link protocol has a function for format the link + (setq rpl + (save-match-data + (funcall fnc (org-link-unescape path) desc1 'html)))) + + ((string= type "file") + ;; FILE link + (let* ((filename path) + (abs-p (file-name-absolute-p filename)) + thefile file-is-image-p search) + (save-match-data + (if (string-match "::\\(.*\\)" filename) + (setq search (match-string 1 filename) + filename (replace-match "" t nil filename))) + (setq valid + (if (functionp link-validate) + (funcall link-validate filename current-dir) + t)) + (setq file-is-image-p + (org-file-image-p + filename org-export-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 "#" + (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)))) + + (t + ;; just publish the path, as default + (setq rpl (concat "<i><" type ":" + (save-match-data (org-link-unescape path)) + "></i>")))) + (setq line (replace-match rpl t t line) + start (+ start (length rpl)))) + + ;; TODO items + (if (and (string-match org-todo-line-regexp line) + (match-beginning 2)) + + (setq line + (concat (substring line 0 (match-beginning 2)) + "<span class=\"" + (if (member (match-string 2 line) + org-done-keywords) + "done" "todo") + " " (match-string 2 line) + "\"> " (org-export-html-get-todo-kwd-class-name + (match-string 2 line)) + "</span>" (substring line (match-end 2))))) + + ;; Does this contain a reference to a footnote? + (when org-export-with-footnotes + (setq start 0) + (while (string-match "\\([^* \t].*\\)?\\[\\([0-9]+\\)\\]" line start) + (if (get-text-property (match-beginning 2) 'org-protected line) + (setq start (match-end 2)) + (let ((n (match-string 2 line)) extra a) + (if (setq a (assoc n footref-seen)) + (progn + (setcdr a (1+ (cdr a))) + (setq extra (format ".%d" (cdr a)))) + (setq extra "") + (push (cons n 1) footref-seen)) + (setq line + (replace-match + (format + (concat (if (match-string 1 line) "%s" "") + (format org-export-html-footnote-format + "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>")) + (match-string 1 line) n extra n n) + t t line)))))) + + (cond + ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) + ;; This is a headline + (setq level (org-tr-level (- (match-end 1) (match-beginning 1) + level-offset)) + txt (match-string 2 line)) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) + (if (<= level (max umax umax-toc)) + (setq head-count (+ head-count 1))) + (when in-local-list + ;; Close any local lists before inserting a new header line + (while local-list-type + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type)) + (setq local-list-indent nil + in-local-list nil)) + (setq first-heading-pos (or first-heading-pos (point))) + (org-html-level-start level txt umax + (and org-export-with-toc (<= level umax)) + head-count) + + ;; QUOTES + (when (string-match quote-re line) + (org-close-par-maybe) + (insert "<pre>") + (setq inquote t))) + + ((string-match "^[ \t]*- __+[ \t]*$" line) + ;; Explicit list closure + (when local-list-type + (let ((ind (org-get-indentation line))) + (while (and local-list-indent + (<= ind (car local-list-indent))) + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type) + (pop local-list-indent)) + (or local-list-indent (setq in-local-list nil)))) + (throw 'nextline nil)) + + ((and org-export-with-tables + (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) + (when (not table-open) + ;; New table starts + (setq table-open t table-buffer nil table-orig-buffer nil)) + + ;; Accumulate lines + (setq table-buffer (cons line table-buffer) + table-orig-buffer (cons origline table-orig-buffer)) + (when (or (not lines) + (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" + (car lines)))) + (setq table-open nil + table-buffer (nreverse table-buffer) + table-orig-buffer (nreverse table-orig-buffer)) + (org-close-par-maybe) + (insert (org-format-table-html table-buffer table-orig-buffer)))) + (t + ;; Normal lines + (when (string-match + (cond + ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") + ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") + ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") + (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) + line) + (setq ind (or (get-text-property 0 'original-indentation line) + (org-get-string-indentation line)) + item-type (if (match-beginning 4) "o" "u") + starter (if (match-beginning 2) + (substring (match-string 2 line) 0 -1)) + line (substring line (match-beginning 5)) + item-tag nil) + (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) + (setq item-type "d" + item-tag (match-string 1 line) + line (substring line (match-end 0)))) + (when (and (not (equal item-type "d")) + (not (string-match "[^ \t]" line))) + ;; empty line. Pretend indentation is large. + (setq ind (if org-empty-line-terminates-plain-lists + 0 + (1+ (or (car local-list-indent) 1))))) + (setq didclose nil) + (while (and in-local-list + (or (and (= ind (car local-list-indent)) + (not starter)) + (< ind (car local-list-indent)))) + (setq didclose t) + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type) (pop local-list-indent) + (setq in-local-list local-list-indent)) + (cond + ((and starter + (or (not in-local-list) + (> ind (car local-list-indent)))) + ;; 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 "d") + (format "<dl>\n<dt>%s</dt><dd>\n" item-tag)))) + (push item-type local-list-type) + (push ind local-list-indent) + (setq in-local-list t)) + (starter + ;; continue current list + (org-close-li (car local-list-type)) + (insert (cond + ((equal (car local-list-type) "d") + (format "<dt>%s</dt><dd>\n" (or item-tag "???"))) + (t "<li>\n")))) + (didclose + ;; we did close a list, normal text follows: need <p> + (org-open-par))) + (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) + (setq line + (replace-match + (if (equal (match-string 1 line) "X") + "<b>[X]</b>" + "<b>[<span style=\"visibility:hidden;\">X</span>]</b>") + t t line)))) + + ;; Horizontal line + (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) + (if org-par-open + (insert "\n</p>\n<hr/>\n<p>\n") + (insert "\n<hr/>\n")) + (throw 'nextline nil)) + + ;; Empty lines start a new paragraph. If hand-formatted lists + ;; are not fully interpreted, lines starting with "-", "+", "*" + ;; also start a new paragraph. + (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par)) + + ;; Is this the start of a footnote? + (when org-export-with-footnotes + (when (and (boundp 'footnote-section-tag-regexp) + (string-match (concat "^" footnote-section-tag-regexp) + line)) + ;; ignore this line + (throw 'nextline nil)) + (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line) + (org-close-par-maybe) + (let ((n (match-string 1 line))) + (setq org-par-open t + line (replace-match + (concat "<p class=\"footnote\">" + (format org-export-html-footnote-format + "<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>" + n n n) t t line)))))) + ;; Check if the line break needs to be conserved + (cond + ((string-match "\\\\\\\\[ \t]*$" line) + (setq line (replace-match "<br/>" t t line))) + (org-export-preserve-breaks + (setq line (concat line "<br/>")))) + + ;; Check if a paragraph should be started + (let ((start 0)) + (while (and org-par-open + (string-match "\\\\par\\>" line start)) + ;; Leave a space in the </p> so that the footnote matcher + ;; does not see this. + (if (not (get-text-property (match-beginning 0) + 'org-protected line)) + (setq line (replace-match "</p ><p >" t t line))) + (setq start (match-end 0)))) + + (insert line "\n"))))) + + ;; Properly close all local lists and other lists + (when inquote + (insert "</pre>\n") + (org-open-par)) + (when in-local-list + ;; Close any local lists before inserting a new header line + (while local-list-type + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type)) + (setq local-list-indent nil + in-local-list nil)) + (org-html-level-start 1 nil umax + (and org-export-with-toc (<= level umax)) + head-count) + ;; the </div> to close the last text-... div. + (when (and (> umax 0) first-heading-pos) (insert "</div>\n")) + + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "<p class=\"footnote\">[^\000]*?\\(</p>\\|\\'\\)" nil t) + (push (match-string 0) footnotes) + (replace-match "" t t))) + (when footnotes + (insert (format org-export-html-footnotes-section + (nth 4 lang-words) + (mapconcat 'identity (nreverse footnotes) "\n")) + "\n")) + (let ((bib (org-export-html-get-bibliography))) + (when bib + (insert "\n" bib "\n"))) + (unless body-only + (when (plist-get opt-plist :auto-postamble) + (insert "<div id=\"postamble\">\n") + (when (and org-export-author-info author) + (insert "<p class=\"author\"> " + (nth 1 lang-words) ": " author "\n") + (when email + (if (listp (split-string email ",+ *")) + (mapc (lambda(e) + (insert "<a href=\"mailto:" e "\"><" + e "></a>\n")) + (split-string email ",+ *")) + (insert "<a href=\"mailto:" email "\"><" + email "></a>\n"))) + (insert "</p>\n")) + (when (and date org-export-time-stamp-file) + (insert "<p class=\"date\"> " + (nth 2 lang-words) ": " + date "</p>\n")) + (when org-export-creator-info + (insert (format "<p class=\"creator\">HTML generated by org-mode %s in emacs %s</p>\n" + org-version emacs-major-version))) + (when org-export-html-validation-link + (insert org-export-html-validation-link "\n")) + (insert "</div>")) + + (if org-export-html-with-timestamp + (insert org-export-html-html-helper-timestamp)) + (org-export-html-insert-plist-item opt-plist :postamble opt-plist) + (insert "\n</div>\n</body>\n</html>\n")) + + (unless (plist-get opt-plist :buffer-will-be-killed) + (normal-mode) + (if (eq major-mode default-major-mode) (html-mode))) + + ;; insert the table of contents + (goto-char (point-min)) + (when thetoc + (if (or (re-search-forward + "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t) + (re-search-forward + "\\[TABLE-OF-CONTENTS\\]" nil t)) + (progn + (goto-char (match-beginning 0)) + (replace-match "")) + (goto-char first-heading-pos) + (when (looking-at "\\s-*</p>") + (goto-char (match-end 0)) + (insert "\n"))) + (insert "<div id=\"table-of-contents\">\n") + (mapc 'insert thetoc) + (insert "</div>\n")) + ;; remove empty paragraphs and lists + (goto-char (point-min)) + (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t) + (replace-match "")) + ;; Convert whitespace place holders + (goto-char (point-min)) + (let (beg end n) + (while (setq beg (next-single-property-change (point) 'org-whitespace)) + (setq n (get-text-property beg 'org-whitespace) + end (next-single-property-change beg 'org-whitespace)) + (goto-char beg) + (delete-region beg end) + (insert (format "<span style=\"visibility:hidden;\">%s</span>" + (make-string n ?x))))) + (or to-buffer (save-buffer)) + (goto-char (point-min)) + (or (org-export-push-to-kill-ring "HTML") + (message "Exporting... done")) + (if (eq to-buffer 'string) + (prog1 (buffer-substring (point-min) (point-max)) + (kill-buffer (current-buffer))) + (current-buffer))))) + +(defun org-export-html-insert-plist-item (plist key &rest args) + (let ((item (plist-get plist key))) + (cond ((functionp item) + (apply item args)) + (item + (insert item))))) + +(defun org-export-html-format-href (s) + "Make sure the S is valid as a href reference in an XHTML document." + (save-match-data + (let ((start 0)) + (while (string-match "&" s start) + (setq start (+ (match-beginning 0) 3) + s (replace-match "&" t t s))))) + s) + +(defun org-export-html-format-desc (s) + "Make sure the S is valid as a description in a link." + (if (and s (not (get-text-property 1 'org-protected s))) + (save-match-data + (org-html-do-expand s)) + s)) + +(defun org-export-html-format-image (src par-open) + "Create image tag with source and attributes." + (save-match-data + (if (string-match "^ltxpng/" src) + (format "<img src=\"%s\"/>" src) + (let* ((caption (org-find-text-property-in-string 'org-caption src)) + (attr (org-find-text-property-in-string 'org-attributes src)) + (label (org-find-text-property-in-string 'org-label src))) + (format "%s<div %sclass=\"figure\"> +<p><img src=\"%s\"%s /></p>%s +</div>%s" + (if org-par-open "</p>\n" "") + (if label (format "id=\"%s\" " label) "") + src + (if (string-match "\\<alt=" (or attr "")) + (concat " " attr ) + (concat " " attr " alt=\"" src "\"")) + (if caption (concat "\n<p>" caption "</p>") "") + (if org-par-open "\n<p>" "")))))) + +(defun org-export-html-get-bibliography () + "Find bibliography, cut it out and return it." + (catch 'exit + (let (beg end (cnt 1) bib) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^[ \t]*<div \\(id\\|class\\)=\"bibliography\"" nil t) + (setq beg (match-beginning 0)) + (while (re-search-forward "</?div\\>" nil t) + (setq cnt (+ cnt (if (string= (match-string 0) "<div") +1 -1))) + (when (= cnt 0) + (and (looking-at ">") (forward-char 1)) + (setq bib (buffer-substring beg (point))) + (delete-region beg (point)) + (throw 'exit bib)))) + nil)))) + +(defvar org-table-number-regexp) ; defined in org-table.el +(defun org-format-table-html (lines olines) + "Find out which HTML converter to use and return the HTML code." + (if (stringp lines) + (setq lines (org-split-string lines "\n"))) + (if (string-match "^[ \t]*|" (car lines)) + ;; A normal org table + (org-format-org-table-html lines) + ;; Table made by table.el - test for spanning + (let* ((hlines (delq nil (mapcar + (lambda (x) + (if (string-match "^[ \t]*\\+-" x) x + nil)) + lines))) + (first (car hlines)) + (ll (and (string-match "\\S-+" first) + (match-string 0 first))) + (re (concat "^[ \t]*" (regexp-quote ll))) + (spanning (delq nil (mapcar (lambda (x) (not (string-match re x))) + hlines)))) + (if (and (not spanning) + (not org-export-prefer-native-exporter-for-tables)) + ;; We can use my own converter with HTML conversions + (org-format-table-table-html lines) + ;; Need to use the code generator in table.el, with the original text. + (org-format-table-table-html-using-table-generate-source olines))))) + +(defvar org-table-number-fraction) ; defined in org-table.el +(defun org-format-org-table-html (lines &optional splice) + "Format a table into HTML." + (require 'org-table) + ;; Get rid of hlines at beginning and end + (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) + (setq lines (nreverse lines)) + (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) + (setq lines (nreverse lines)) + (when org-export-table-remove-special-lines + ;; Check if the table has a marking column. If yes remove the + ;; column and the special lines + (setq lines (org-table-clean-before-export lines))) + + (let* ((caption (or (get-text-property 0 'org-caption (car lines)) + (get-text-property (or (next-single-property-change + 0 'org-caption (car lines)) + 0) + 'org-caption (car lines)))) + (attributes (or (get-text-property 0 'org-attributes (car lines)) + (get-text-property (or (next-single-property-change + 0 'org-attributes (car lines)) + 0) + 'org-attributes (car lines)))) + (html-table-tag (org-export-splice-attributes + html-table-tag attributes)) + (head (and org-export-highlight-first-table-line + (delq nil (mapcar + (lambda (x) (string-match "^[ \t]*|-" x)) + (cdr lines))))) + + (nline 0) fnum i + tbopen line fields html gr colgropen rowstart rowend) + (if splice (setq head nil)) + (unless splice (push (if head "<thead>" "<tbody>") html)) + (setq tbopen t) + (while (setq line (pop lines)) + (catch 'next-line + (if (string-match "^[ \t]*|-" line) + (progn + (unless splice + (push (if head "</thead>" "</tbody>") html) + (if lines (push "<tbody>" html) (setq tbopen nil))) + (setq head nil) ;; head ends here, first time around + ;; ignore this line + (throw 'next-line t))) + ;; Break the line into fields + (setq fields (org-split-string line "[ \t]*|[ \t]*")) + (unless fnum (setq fnum (make-vector (length fields) 0))) + (setq nline (1+ nline) i -1 + rowstart (eval (car org-export-table-row-tags)) + rowend (eval (cdr org-export-table-row-tags))) + (push (concat rowstart + (mapconcat + (lambda (x) + (setq i (1+ i)) + (if (and (< i nline) + (string-match org-table-number-regexp x)) + (incf (aref fnum i))) + (cond + (head + (concat + (format (car org-export-table-header-tags) "col") + x + (cdr org-export-table-header-tags))) + ((and (= i 0) org-export-html-table-use-header-tags-for-first-column) + (concat + (format (car org-export-table-header-tags) "row") + x + (cdr org-export-table-header-tags))) + (t + (concat (car org-export-table-data-tags) x + (cdr org-export-table-data-tags))))) + fields "") + rowend) + html))) + (unless splice (if tbopen (push "</tbody>" html))) + (unless splice (push "</table>\n" html)) + (setq html (nreverse html)) + (unless splice + ;; Put in col tags with the alignment (unfortuntely often ignored...) + (unless (car org-table-colgroup-info) + (setq org-table-colgroup-info + (cons :start (cdr org-table-colgroup-info)))) + (push (mapconcat + (lambda (x) + (setq gr (pop org-table-colgroup-info)) + (format "%s<col align=\"%s\"></col>%s" + (if (memq gr '(:start :startend)) + (prog1 + (if colgropen "</colgroup>\n<colgroup>" "<colgroup>") + (setq colgropen t)) + "") + (if (> (/ (float x) nline) org-table-number-fraction) + "right" "left") + (if (memq gr '(:end :startend)) + (progn (setq colgropen nil) "</colgroup>") + ""))) + fnum "") + html) + (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html))))) + ;; Since the output of HTML table formatter can also be used in + ;; DocBook document, we want to always include the caption to make + ;; DocBook XML file valid. + (push (format "<caption>%s</caption>" (or caption "")) html) + (push html-table-tag html)) + (concat (mapconcat 'identity html "\n") "\n"))) + +(defun org-export-splice-attributes (tag attributes) + "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG." + (if (not attributes) + tag + (let (oldatt newatt) + (setq oldatt (org-extract-attributes-from-string tag) + tag (pop oldatt) + newatt (cdr (org-extract-attributes-from-string attributes))) + (while newatt + (setq oldatt (plist-put oldatt (pop newatt) (pop newatt)))) + (if (string-match ">" tag) + (setq tag + (replace-match (concat (org-attributes-to-string oldatt) ">") + t t tag))) + tag))) + +(defun org-format-table-table-html (lines) + "Format a table generated by table.el into HTML. +This conversion does *not* use `table-generate-source' from table.el. +This has the advantage that Org-mode's HTML conversions can be used. +But it has the disadvantage, that no cell- or row-spanning is allowed." + (let (line field-buffer + (head org-export-highlight-first-table-line) + fields html empty i) + (setq html (concat html-table-tag "\n")) + (while (setq line (pop lines)) + (setq empty " ") + (catch 'next-line + (if (string-match "^[ \t]*\\+-" line) + (progn + (if field-buffer + (progn + (setq + html + (concat + html + "<tr>" + (mapconcat + (lambda (x) + (if (equal x "") (setq x empty)) + (if head + (concat + (format (car org-export-table-header-tags) "col") + x + (cdr org-export-table-header-tags)) + (concat (car org-export-table-data-tags) x + (cdr org-export-table-data-tags)))) + field-buffer "\n") + "</tr>\n")) + (setq head nil) + (setq field-buffer nil))) + ;; Ignore this line + (throw 'next-line t))) + ;; Break the line into fields and store the fields + (setq fields (org-split-string line "[ \t]*|[ \t]*")) + (if field-buffer + (setq field-buffer (mapcar + (lambda (x) + (concat x "<br/>" (pop fields))) + field-buffer)) + (setq field-buffer fields)))) + (setq html (concat html "</table>\n")) + html)) + +(defun org-format-table-table-html-using-table-generate-source (lines) + "Format a table into html, using `table-generate-source' from table.el. +This has the advantage that cell- or row-spanning is allowed. +But it has the disadvantage, that Org-mode's HTML conversions cannot be used." + (require 'table) + (with-current-buffer (get-buffer-create " org-tmp1 ") + (erase-buffer) + (insert (mapconcat 'identity lines "\n")) + (goto-char (point-min)) + (if (not (re-search-forward "|[^+]" nil t)) + (error "Error processing table")) + (table-recognize-table) + (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) + (table-generate-source 'html " org-tmp2 ") + (set-buffer " org-tmp2 ") + (buffer-substring (point-min) (point-max)))) + +(defun org-export-splice-style (style extra) + "Splice EXTRA into STYLE, just before \"</style>\"." + (if (and (stringp extra) + (string-match "\\S-" extra) + (string-match "</style>" style)) + (concat (substring style 0 (match-beginning 0)) + "\n" extra "\n" + (substring style (match-beginning 0))) + style)) + +(defun org-html-handle-time-stamps (s) + "Format time stamps in string S, or remove them." + (catch 'exit + (let (r b) + (while (string-match org-maybe-keyword-time-regexp s) + (or b (setq b (substring s 0 (match-beginning 0)))) + (setq r (concat + r (substring s 0 (match-beginning 0)) + " @<span class=\"timestamp-wrapper\">" + (if (match-end 1) + (format "@<span class=\"timestamp-kwd\">%s @</span>" + (match-string 1 s))) + (format " @<span class=\"timestamp\">%s@</span>" + (substring + (org-translate-time (match-string 3 s)) 1 -1)) + "@</span>") + s (substring s (match-end 0)))) + ;; Line break if line started and ended with time stamp stuff + (if (not r) + s + (setq r (concat r s)) + (unless (string-match "\\S-" (concat b s)) + (setq r (concat r "@<br/>"))) + r)))) + +(defvar htmlize-buffer-places) ; from htmlize.el +(defun org-export-htmlize-region-for-paste (beg end) + "Convert the region to HTML, using htmlize.el. +This is much like `htmlize-region-for-paste', only that it uses +the settings define in the org-... variables." + (let* ((htmlize-output-type org-export-htmlize-output-type) + (htmlize-css-name-prefix org-export-htmlize-css-font-prefix) + (htmlbuf (htmlize-region beg end))) + (unwind-protect + (with-current-buffer htmlbuf + (buffer-substring (plist-get htmlize-buffer-places 'content-start) + (plist-get htmlize-buffer-places 'content-end))) + (kill-buffer htmlbuf)))) + +;;;###autoload +(defun org-export-htmlize-generate-css () + "Create the CSS for all font definitions in the current Emacs session. +Use this to create face definitions in your CSS style file that can then +be used by code snippets transformed by htmlize. +This command just produces a buffer that contains class definitions for all +faces used in the current Emacs session. You can copy and paste the ones you +need into your CSS file. + +If you then set `org-export-htmlize-output-type' to `css', calls to +the function `org-export-htmlize-region-for-paste' will produce code +that uses these same face definitions." + (interactive) + (require 'htmlize) + (and (get-buffer "*html*") (kill-buffer "*html*")) + (with-temp-buffer + (let ((fl (face-list)) + (htmlize-css-name-prefix "org-") + (htmlize-output-type 'css) + f i) + (while (setq f (pop fl) + i (and f (face-attribute f :inherit))) + (when (and (symbolp f) (or (not i) (not (listp i)))) + (insert (org-add-props (copy-sequence "1") nil 'face f)))) + (htmlize-region (point-min) (point-max)))) + (switch-to-buffer "*html*") + (goto-char (point-min)) + (if (re-search-forward "<style" nil t) + (delete-region (point-min) (match-beginning 0))) + (if (re-search-forward "</style>" nil t) + (delete-region (1+ (match-end 0)) (point-max))) + (beginning-of-line 1) + (if (looking-at " +") (replace-match "")) + (goto-char (point-min))) + +(defun org-html-protect (s) + ;; convert & to &, < to < and > to > + (let ((start 0)) + (while (string-match "&" s start) + (setq s (replace-match "&" t t s) + start (1+ (match-beginning 0)))) + (while (string-match "<" s) + (setq s (replace-match "<" t t s))) + (while (string-match ">" s) + (setq s (replace-match ">" t t s))) +; (while (string-match "\"" s) +; (setq s (replace-match """ t t s))) + ) + s) + +(defun org-html-expand (string) + "Prepare STRING for HTML export. Applies all active conversions. +If there are links in the string, don't modify these." + (let* ((re (concat org-bracket-link-regexp "\\|" + (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) + m s l res) + (while (setq m (string-match re string)) + (setq s (substring string 0 m) + l (match-string 0 string) + string (substring string (match-end 0))) + (push (org-html-do-expand s) res) + (push l res)) + (push (org-html-do-expand string) res) + (apply 'concat (nreverse res)))) + +(defun org-html-do-expand (s) + "Apply all active conversions to translate special ASCII to HTML." + (setq s (org-html-protect s)) + (if org-export-html-expand + (while (string-match "@<\\([^&]*\\)>" s) + (setq s (replace-match "<\\1>" t nil s)))) + (if org-export-with-emphasize + (setq s (org-export-html-convert-emphasize s))) + (if org-export-with-special-strings + (setq s (org-export-html-convert-special-strings s))) + (if org-export-with-sub-superscripts + (setq s (org-export-html-convert-sub-super s))) + (if org-export-with-TeX-macros + (let ((start 0) wd ass) + (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?" + s start)) + (if (get-text-property (match-beginning 0) 'org-protected s) + (setq start (match-end 0)) + (setq wd (match-string 1 s)) + (if (setq ass (assoc wd org-html-entities)) + (setq s (replace-match (or (cdr ass) + (concat "&" (car ass) ";")) + t t s)) + (setq start (+ start (length wd)))))))) + s) + +(defconst org-export-html-special-string-regexps + '(("\\\\-" . "­") + ("---\\([^-]\\)" . "—\\1") + ("--\\([^-]\\)" . "–\\1") + ("\\.\\.\\." . "…")) + "Regular expressions for special string conversion.") + +(defun org-export-html-convert-special-strings (string) + "Convert special characters in STRING to HTML." + (let ((all org-export-html-special-string-regexps) + e a re rpl start) + (while (setq a (pop all)) + (setq re (car a) rpl (cdr a) start 0) + (while (string-match re string start) + (if (get-text-property (match-beginning 0) 'org-protected string) + (setq start (match-end 0)) + (setq string (replace-match rpl t nil string))))) + string)) + +(defun org-export-html-convert-sub-super (string) + "Convert sub- and superscripts in STRING to HTML." + (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) + (while (string-match org-match-substring-regexp string s) + (cond + ((and requireb (match-end 8)) (setq s (match-end 2))) + ((get-text-property (match-beginning 2) 'org-protected string) + (setq s (match-end 2))) + (t + (setq s (match-end 1) + key (if (string= (match-string 2 string) "_") "sub" "sup") + c (or (match-string 8 string) + (match-string 6 string) + (match-string 5 string)) + string (replace-match + (concat (match-string 1 string) + "<" key ">" c "</" key ">") + t t string))))) + (while (string-match "\\\\\\([_^]\\)" string) + (setq string (replace-match (match-string 1 string) t t string))) + string)) + +(defun org-export-html-convert-emphasize (string) + "Apply emphasis." + (let ((s 0) rpl) + (while (string-match org-emph-re string s) + (if (not (equal + (substring string (match-beginning 3) (1+ (match-beginning 3))) + (substring string (match-beginning 4) (1+ (match-beginning 4))))) + (setq s (match-beginning 0) + rpl + (concat + (match-string 1 string) + (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) + (match-string 4 string) + (nth 3 (assoc (match-string 3 string) + org-emphasis-alist)) + (match-string 5 string)) + string (replace-match rpl t t string) + s (+ s (- (length rpl) 2))) + (setq s (1+ s)))) + string)) + +(defun org-open-par () + "Insert <p>, but first close previous paragraph if any." + (org-close-par-maybe) + (insert "\n<p>") + (setq org-par-open t)) +(defun org-close-par-maybe () + "Close paragraph if there is one open." + (when org-par-open + (insert "</p>") + (setq org-par-open nil))) +(defun org-close-li (&optional type) + "Close <li> if necessary." + (org-close-par-maybe) + (insert (if (equal type "d") "</dd>\n" "</li>\n"))) + +(defvar in-local-list) +(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) + (when ind + (while (and in-local-list + (<= ind (car local-list-indent))) + (setq didclose t) + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type) (pop local-list-indent) + (setq in-local-list local-list-indent)) + (and didclose (org-open-par))))) + +(defvar body-only) ; dynamically scoped into this. +(defun org-html-level-start (level title umax with-toc head-count) + "Insert a new level in HTML export. +When TITLE is nil, just close all open levels." + (org-close-par-maybe) + (let* ((target (and title (org-get-text-property-any 0 'target title))) + (extra-targets (assoc target org-export-target-aliases)) + (preferred (cdr (assoc target org-export-preferred-target-alist))) + (remove (or preferred target)) + (l org-level-max) + snumber href suffix) + (setq extra-targets (remove remove extra-targets)) + (setq extra-targets + (mapconcat (lambda (x) + (if (org-uuidgen-p x) (setq x (concat "ID-" x))) + (format "<a name=\"%s\" id=\"%s\"></a>" + x x)) + extra-targets + "")) + (while (>= l level) + (if (aref org-levels-open (1- l)) + (progn + (org-html-level-close l umax) + (aset org-levels-open (1- l) nil))) + (setq l (1- l))) + (when title + ;; If title is nil, this means this function is called to close + ;; all levels, so the rest is done only if title is given + (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (setq title (replace-match + (if org-export-with-tags + (save-match-data + (concat + " <span class=\"tag\">" + (mapconcat + (lambda (x) + (format "<span class=\"%s\">%s</span>" + (org-export-html-get-tag-class-name x) + x)) + (org-split-string (match-string 1 title) ":") + " ") + "</span>")) + "") + t t title))) + (if (> level umax) + (progn + (if (aref org-levels-open (1- level)) + (progn + (org-close-li) + (if target + (insert (format "<li id=\"%s\">" target) extra-targets title "<br/>\n") + (insert "<li>" title "<br/>\n"))) + (aset org-levels-open (1- level) t) + (org-close-par-maybe) + (if target + (insert (format "<ul>\n<li id=\"%s\">" target) + 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 level (+ level org-export-html-toplevel-hlevel -1)) + (if (and org-export-with-section-numbers (not body-only)) + (setq title (concat + (format "<span class=\"section-number-%d\">%s</span>" + 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))) + (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n" + suffix level level href + extra-targets + title level level suffix)) + (org-open-par))))) + +(defun org-export-html-get-tag-class-name (tag) + "Turn tag into a valid class name. +Replaces invalid characters with \"_\" and then prepends a prefix." + (save-match-data + (while (string-match "[^a-zA-Z0-9_]" tag) + (setq tag (replace-match "_" t t tag)))) + (concat org-export-html-tag-class-prefix tag)) + +(defun org-export-html-get-todo-kwd-class-name (kwd) + "Turn todo keyword into a valid class name. +Replaces invalid characters with \"_\" and then prepends a prefix." + (save-match-data + (while (string-match "[^a-zA-Z0-9_]" kwd) + (setq kwd (replace-match "_" t t kwd)))) + (concat org-export-html-todo-kwd-class-prefix kwd)) + +(defun org-html-level-close (level max-outline-level) + "Terminate one level in HTML export." + (if (<= level max-outline-level) + (insert "</div>\n") + (org-close-li) + (insert "</ul>\n"))) + +(provide 'org-html) + +;; arch-tag: 8109d84d-eb8f-460b-b1a8-f45f3a6c7ea1 + +;;; org-html.el ends here diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el new file mode 100644 index 00000000000..dfc57908fd3 --- /dev/null +++ b/lisp/org/org-icalendar.el @@ -0,0 +1,581 @@ +;;; org-icalendar.el --- iCalendar export for Org-mode + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.29c +;; +;; 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: + +(require 'org-exp) + +(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) + +(defgroup org-export-icalendar nil + "Options specific for iCalendar export of Org-mode files." + :tag "Org Export iCalendar" + :group 'org-export) + +(defcustom org-combined-agenda-icalendar-file "~/org.ics" + "The file name for the iCalendar file covering all agenda files. +This file is created with the command \\[org-export-icalendar-all-agenda-files]. +The file name should be absolute, the file will be overwritten without warning." + :group 'org-export-icalendar + :type 'file) + +(defcustom org-icalendar-combined-name "OrgMode" + "Calendar name for the combined iCalendar representing all agenda files." + :group 'org-export-icalendar + :type 'string) + +(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due) + "Contexts where iCalendar export should use a deadline time stamp. +This is a list with several symbols in it. Valid symbol are: + +event-if-todo Deadlines in TODO entries become calendar events. +event-if-not-todo Deadlines in non-TODO entries become calendar events. +todo-due Use deadlines in TODO entries as due-dates" + :group 'org-export-icalendar + :type '(set :greedy t + (const :tag "Deadlines in non-TODO entries become events" + event-if-not-todo) + (const :tag "Deadline in TODO entries become events" + event-if-todo) + (const :tag "Deadlines in TODO entries become due-dates" + todo-due))) + +(defcustom org-icalendar-use-scheduled '(todo-start) + "Contexts where iCalendar export should use a scheduling time stamp. +This is a list with several symbols in it. Valid symbol are: + +event-if-todo Scheduling time stamps in TODO entries become an event. +event-if-not-todo Scheduling time stamps in non-TODO entries become an event. +todo-start Scheduling time stamps in TODO entries become start date. + Some calendar applications show TODO entries only after + that date." + :group 'org-export-icalendar + :type '(set :greedy t + (const :tag + "SCHEDULED timestamps in non-TODO entries become events" + event-if-not-todo) + (const :tag "SCHEDULED timestamps in TODO entries become events" + event-if-todo) + (const :tag "SCHEDULED in TODO entries become start date" + todo-start))) + +(defcustom org-icalendar-categories '(local-tags category) + "Items that should be entered into the categories field. +This is a list of symbols, the following are valid: + +category The Org-mode category of the current file or tree +todo-state The todo state, if any +local-tags The tags, defined in the current line +all-tags All tags, including inherited ones." + :group 'org-export-icalendar + :type '(repeat + (choice + (const :tag "The file or tree category" category) + (const :tag "The TODO state" todo-state) + (const :tag "Tags defined in current line" local-tags) + (const :tag "All tags, including inherited ones" all-tags)))) + +(defcustom org-icalendar-include-todo nil + "Non-nil means, export to iCalendar files should also cover TODO items. +Valid values are: +nil don't inlcude any TODO items +t include all TODO items that are not in a DONE state +unblocked include all TODO idems that are not blocked +all include both done and not done items." + :group 'org-export-icalendar + :type '(choice + (const :tag "None" nil) + (const :tag "Unfinished" t) + (const :tag "Unblocked" unblocked) + (const :tag "All" all))) + +(defcustom org-icalendar-include-bbdb-anniversaries nil + "Non-nil means, a combined iCalendar files should include anniversaries. +The anniversaries are define in the BBDB database." + :group 'org-export-icalendar + :type 'boolean) + +(defcustom org-icalendar-include-sexps t + "Non-nil means, export to iCalendar files should also cover sexp entries. +These are entries like in the diary, but directly in an Org-mode file." + :group 'org-export-icalendar + :type 'boolean) + +(defcustom org-icalendar-include-body 100 + "Amount of text below headline to be included in iCalendar export. +This is a number of characters that should maximally be included. +Properties, scheduling and clocking lines will always be removed. +The text will be inserted into the DESCRIPTION field." + :group 'org-export-icalendar + :type '(choice + (const :tag "Nothing" nil) + (const :tag "Everything" t) + (integer :tag "Max characters"))) + +(defcustom org-icalendar-store-UID nil + "Non-nil means, store any created UIDs in properties. +The iCalendar standard requires that all entries have a unique identifier. +Org will create these identifiers as needed. When this variable is non-nil, +the created UIDs will be stored in the ID property of the entry. Then the +next time this entry is exported, it will be exported with the same UID, +superceding the previous form of it. This is essential for +synchronization services. +This variable is not turned on by default because we want to avoid creating +a property drawer in every entry if people are only playing with this feature, +or if they are only using it locally." + :group 'org-export-icalendar + :type 'boolean) + +(defcustom org-icalendar-timezone (getenv "TZ") + "The time zone string for iCalendar export. +When nil of the empty string, use the abbreviation retrieved from Emacs." + :group 'org-export-icalendar + :type '(choice + (const :tag "Unspecified" nil) + (string :tag "Time zone"))) + +;;; iCalendar export + +;;;###autoload +(defun org-export-icalendar-this-file () + "Export current file as an iCalendar file. +The iCalendar file will be located in the same directory as the Org-mode +file, but with extension `.ics'." + (interactive) + (org-export-icalendar nil buffer-file-name)) + +;;;###autoload +(defun org-export-icalendar-all-agenda-files () + "Export all files in `org-agenda-files' to iCalendar .ics files. +Each iCalendar file will be located in the same directory as the Org-mode +file, but with extension `.ics'." + (interactive) + (apply 'org-export-icalendar nil (org-agenda-files t))) + +;;;###autoload +(defun org-export-icalendar-combine-agenda-files () + "Export all files in `org-agenda-files' to a single combined iCalendar file. +The file is stored under the name `org-combined-agenda-icalendar-file'." + (interactive) + (apply 'org-export-icalendar t (org-agenda-files t))) + +(defun org-export-icalendar (combine &rest files) + "Create iCalendar files for all elements of FILES. +If COMBINE is non-nil, combine all calendar entries into a single large +file and store it under the name `org-combined-agenda-icalendar-file'." + (save-excursion + (org-prepare-agenda-buffers files) + (let* ((dir (org-export-directory + :ical (list :publishing-directory + org-export-publishing-directory))) + file ical-file ical-buffer category started org-agenda-new-buffers) + (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*")) + (when combine + (setq ical-file + (if (file-name-absolute-p org-combined-agenda-icalendar-file) + org-combined-agenda-icalendar-file + (expand-file-name org-combined-agenda-icalendar-file dir)) + ical-buffer (org-get-agenda-file-buffer ical-file)) + (set-buffer ical-buffer) (erase-buffer)) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (set-buffer (org-get-agenda-file-buffer file)) + (unless combine + (setq ical-file (concat (file-name-as-directory dir) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ".ics")) + (setq ical-buffer (org-get-agenda-file-buffer ical-file)) + (with-current-buffer ical-buffer (erase-buffer))) + (setq category (or org-category + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)))) + (if (symbolp category) (setq category (symbol-name category))) + (let ((standard-output ical-buffer)) + (if combine + (and (not started) (setq started t) + (org-start-icalendar-file org-icalendar-combined-name)) + (org-start-icalendar-file category)) + (org-print-icalendar-entries combine) + (when (or (and combine (not files)) (not combine)) + (when (and combine org-icalendar-include-bbdb-anniversaries) + (require 'org-bbdb) + (org-bbdb-anniv-export-ical)) + (org-finish-icalendar-file) + (set-buffer ical-buffer) + (run-hooks 'org-before-save-iCalendar-file-hook) + (save-buffer) + (run-hooks 'org-after-save-iCalendar-file-hook) + (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)) + )))) + (org-release-buffers org-agenda-new-buffers)))) + +(defvar org-before-save-iCalendar-file-hook nil + "Hook run before an iCalendar file has been saved. +This can be used to modify the result of the export.") + +(defvar org-after-save-iCalendar-file-hook nil + "Hook run after an iCalendar file has been saved. +The iCalendar buffer is still current when this hook is run. +A good way to use this is to tell a desktop calendar application to re-read +the iCalendar file.") + +(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el +(defun org-print-icalendar-entries (&optional combine) + "Print iCalendar entries for the current Org-mode file to `standard-output'. +When COMBINE is non nil, add the category to each line." + (require 'org-agenda) + (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) + (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) + (dts (org-ical-ts-to-string + (format-time-string (cdr org-time-stamp-formats) (current-time)) + "DTSTART")) + hd ts ts2 state status (inc t) pos b sexp rrule + scheduledp deadlinep todo prefix due start + tmp pri categories location summary desc uid + (sexp-buffer (get-buffer-create "*ical-tmp*"))) + (org-refresh-category-properties) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward re1 nil t) + (catch :skip + (org-agenda-skip) + (when (boundp 'org-icalendar-verify-function) + (unless (funcall org-icalendar-verify-function) + (outline-next-heading) + (backward-char 1) + (throw :skip nil))) + (setq pos (match-beginning 0) + ts (match-string 0) + inc t + hd (condition-case nil + (org-icalendar-cleanup-string + (org-get-heading)) + (error (throw :skip nil))) + summary (org-icalendar-cleanup-string + (org-entry-get nil "SUMMARY")) + desc (org-icalendar-cleanup-string + (or (org-entry-get nil "DESCRIPTION") + (and org-icalendar-include-body (org-get-entry))) + t org-icalendar-include-body) + location (org-icalendar-cleanup-string + (org-entry-get nil "LOCATION" 'selective)) + uid (if org-icalendar-store-UID + (org-id-get-create) + (or (org-id-get) (org-id-new))) + categories (org-export-get-categories) + deadlinep nil scheduledp nil) + (if (looking-at re2) + (progn + (goto-char (match-end 0)) + (setq ts2 (match-string 1) + inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2)))) + (setq tmp (buffer-substring (max (point-min) + (- pos org-ds-keyword-length)) + pos) + ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) + (progn + (setq inc nil) + (replace-match "\\1" t nil ts)) + ts) + deadlinep (string-match org-deadline-regexp tmp) + scheduledp (string-match org-scheduled-regexp tmp) + todo (org-get-todo-state) + ;; donep (org-entry-is-done-p) + )) + (when (and + deadlinep + (if todo + (not (memq 'event-if-todo org-icalendar-use-deadline)) + (not (memq 'event-if-not-todo org-icalendar-use-deadline)))) + (throw :skip t)) + (when (and + scheduledp + (if todo + (not (memq 'event-if-todo org-icalendar-use-scheduled)) + (not (memq 'event-if-not-todo org-icalendar-use-scheduled)))) + (throw :skip t)) + (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-"))) + (if (or (string-match org-tr-regexp hd) + (string-match org-ts-regexp hd)) + (setq hd (replace-match "" t t hd))) + (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts) + (setq rrule + (concat "\nRRULE:FREQ=" + (cdr (assoc + (match-string 2 ts) + '(("d" . "DAILY")("w" . "WEEKLY") + ("m" . "MONTHLY")("y" . "YEARLY")))) + ";INTERVAL=" (match-string 1 ts))) + (setq rrule "")) + (setq summary (or summary hd)) + (if (string-match org-bracket-link-regexp summary) + (setq summary + (replace-match (if (match-end 3) + (match-string 3 summary) + (match-string 1 summary)) + t t summary))) + (if deadlinep (setq summary (concat "DL: " summary))) + (if scheduledp (setq summary (concat "S: " summary))) + (if (string-match "\\`<%%" ts) + (with-current-buffer sexp-buffer + (insert (substring ts 1 -1) " " summary "\n")) + (princ (format "BEGIN:VEVENT +UID: %s +%s +%s%s +SUMMARY:%s%s%s +CATEGORIES:%s +END:VEVENT\n" + (concat prefix uid) + (org-ical-ts-to-string ts "DTSTART") + (org-ical-ts-to-string ts2 "DTEND" inc) + rrule summary + (if (and desc (string-match "\\S-" desc)) + (concat "\nDESCRIPTION: " desc) "") + (if (and location (string-match "\\S-" location)) + (concat "\nLOCATION: " location) "") + categories))))) + (when (and org-icalendar-include-sexps + (condition-case nil (require 'icalendar) (error nil)) + (fboundp 'icalendar-export-region)) + ;; Get all the literal sexps + (goto-char (point-min)) + (while (re-search-forward "^&?%%(" nil t) + (catch :skip + (org-agenda-skip) + (setq b (match-beginning 0)) + (goto-char (1- (match-end 0))) + (forward-sexp 1) + (end-of-line 1) + (setq sexp (buffer-substring b (point))) + (with-current-buffer sexp-buffer + (insert sexp "\n")))) + (princ (org-diary-to-ical-string sexp-buffer)) + (kill-buffer sexp-buffer)) + + (when org-icalendar-include-todo + (setq prefix "TODO-") + (goto-char (point-min)) + (while (re-search-forward org-todo-line-regexp nil t) + (catch :skip + (org-agenda-skip) + (when (boundp 'org-icalendar-verify-function) + (unless (save-match-data + (funcall org-icalendar-verify-function)) + (outline-next-heading) + (backward-char 1) + (throw :skip nil))) + (setq state (match-string 2)) + (setq status (if (member state org-done-keywords) + "COMPLETED" "NEEDS-ACTION")) + (when (and state + (cond + ;; check if the state is one we should use + ((eq org-icalendar-include-todo 'all) + ;; all should be included + t) + ((eq org-icalendar-include-todo 'unblocked) + ;; only undone entries that are not blocked + (and (member state org-not-done-keywords) + (or (not org-blocker-hook) + (save-match-data + (run-hook-with-args-until-failure + 'org-blocker-hook + (list :type 'todo-state-change + :position (point-at-bol) + :from 'todo + :to 'done)))))) + ((eq org-icalendar-include-todo t) + ;; include everything that is not done + (member state org-not-done-keywords)))) + (setq hd (match-string 3) + summary (org-icalendar-cleanup-string + (org-entry-get nil "SUMMARY")) + desc (org-icalendar-cleanup-string + (or (org-entry-get nil "DESCRIPTION") + (and org-icalendar-include-body (org-get-entry))) + t org-icalendar-include-body) + location (org-icalendar-cleanup-string + (org-entry-get nil "LOCATION" 'selective)) + due (and (member 'todo-due org-icalendar-use-deadline) + (org-entry-get nil "DEADLINE")) + start (and (member 'todo-start org-icalendar-use-scheduled) + (org-entry-get nil "SCHEDULED")) + categories (org-export-get-categories) + uid (if org-icalendar-store-UID + (org-id-get-create) + (or (org-id-get) (org-id-new)))) + (and due (setq due (org-ical-ts-to-string due "DUE"))) + (and start (setq start (org-ical-ts-to-string start "DTSTART"))) + + (if (string-match org-bracket-link-regexp hd) + (setq hd (replace-match (if (match-end 3) (match-string 3 hd) + (match-string 1 hd)) + t t hd))) + (if (string-match org-priority-regexp hd) + (setq pri (string-to-char (match-string 2 hd)) + hd (concat (substring hd 0 (match-beginning 1)) + (substring hd (match-end 1)))) + (setq pri org-default-priority)) + (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri)) + (- org-lowest-priority org-highest-priority)))))) + + (princ (format "BEGIN:VTODO +UID: %s +%s +SUMMARY:%s%s%s%s +CATEGORIES:%s +SEQUENCE:1 +PRIORITY:%d +STATUS:%s +END:VTODO\n" + (concat prefix uid) + (or start dts) + (or summary hd) + (if (and location (string-match "\\S-" location)) + (concat "\nLOCATION: " location) "") + (if (and desc (string-match "\\S-" desc)) + (concat "\nDESCRIPTION: " desc) "") + (if due (concat "\n" due) "") + categories + pri status))))))))) + +(defun org-export-get-categories () + "Get categories according to `org-icalendar-categories'." + (let ((cs org-icalendar-categories) c rtn tmp) + (while (setq c (pop cs)) + (cond + ((eq c 'category) (push (org-get-category) rtn)) + ((eq c 'todo-state) + (setq tmp (org-get-todo-state)) + (and tmp (push tmp rtn))) + ((eq c 'local-tags) + (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn))) + ((eq c 'all-tags) + (setq rtn (append (nreverse (org-get-tags-at (point))) rtn))))) + (mapconcat 'identity (nreverse rtn) ","))) + +(defun org-icalendar-cleanup-string (s &optional is-body maxlength) + "Take out stuff and quote what needs to be quoted. +When IS-BODY is non-nil, assume that this is the body of an item, clean up +whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH +characters." + (if (not s) + nil + (when is-body + (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) + (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) + (while (string-match re s) (setq s (replace-match "" t t s))) + (while (string-match re2 s) (setq s (replace-match "" t t s))))) + (let ((start 0)) + (while (string-match "\\([,;]\\)" s start) + (setq start (+ (match-beginning 0) 2) + s (replace-match "\\\\\\1" nil nil s)))) + (setq s (org-trim s)) + (when is-body + (while (string-match "[ \t]*\n[ \t]*" s) + (setq s (replace-match "\\n" t t s)))) + (if is-body + (if maxlength + (if (and (numberp maxlength) + (> (length s) maxlength)) + (setq s (substring s 0 maxlength))))) + s)) + +(defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength) + "Take out stuff and quote what needs to be quoted. +When IS-BODY is non-nil, assume that this is the body of an item, clean up +whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH +characters. +This seems to be more like RFC 2455, but it causes problems, so it is +not used right now." + (if (not s) + nil + (if is-body + (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) + (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) + (while (string-match re s) (setq s (replace-match "" t t s))) + (while (string-match re2 s) (setq s (replace-match "" t t s))) + (setq s (org-trim s)) + (while (string-match "[ \t]*\n[ \t]*" s) + (setq s (replace-match "\\n" t t s))) + (if maxlength + (if (and (numberp maxlength) + (> (length s) maxlength)) + (setq s (substring s 0 maxlength))))) + (setq s (org-trim s))) + (while (string-match "\"" s) (setq s (replace-match "''" t t s))) + (when (string-match "[;,:]" s) (setq s (concat "\"" s "\""))) + s)) + +(defun org-start-icalendar-file (name) + "Start an iCalendar file by inserting the header." + (let ((user user-full-name) + (name (or name "unknown")) + (timezone (if (> (length org-icalendar-timezone) 0) + org-icalendar-timezone + (cadr (current-time-zone))))) + (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)))) + +(defun org-finish-icalendar-file () + "Finish an iCalendar file by inserting the END statement." + (princ "END:VCALENDAR\n")) + +(defun org-ical-ts-to-string (s keyword &optional inc) + "Take a time string S and convert it to iCalendar format. +KEYWORD is added in front, to make a complete line like DTSTART.... +When INC is non-nil, increase the hour by two (if time string contains +a time), or the day by one (if it does not contain a time)." + (let ((t1 (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)))) + +(provide 'org-icalendar) + +;; arch-tag: 2dee2b6e-9211-4aee-8a47-a3c7e5bc30cf + +;;; org-icalendar.el ends here diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index fd17562ef5a..189865ffe67 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -79,11 +79,16 @@ :tag "Org ID" :group 'org) +(defcustom org-id-uuid-program "uuidgen" + "The uuidgen program." + :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 "uuidgen"))) + (org-trim (shell-command-to-string + org-id-uuid-program))) 'uuidgen 'org) (error 'org)) @@ -197,7 +202,7 @@ With optional argument FORCE, force the creation of a new ID." "Copy the ID of the entry at point to the kill ring. Create an ID if necessary." (interactive) - (kill-new (org-id-get nil 'create))) + (org-kill-new (org-id-get nil 'create))) ;;;###autoload (defun org-id-get (&optional pom create prefix) @@ -228,6 +233,7 @@ It returns the ID of the entry. If necessary, the ID is created." (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10))))) (org-refile-use-outline-path (if (caar org-refile-targets) 'file t)) + (org-refile-target-verify-function nil) (spos (org-refile-get-location "Entry: ")) (pom (and spos (move-marker (make-marker) (nth 3 spos) (get-file-buffer (nth 1 spos)))))) @@ -300,7 +306,7 @@ So a typical ID could look like \"Org:4nd91V40HI\"." (if (equal prefix ":") (setq prefix "")) (cond ((eq org-id-method 'uuidgen) - (setq unique (org-trim (shell-command-to-string "uuidgen")))) + (setq unique (org-trim (shell-command-to-string org-id-uuid-program)))) ((eq org-id-method 'org) (let* ((etime (org-id-reverse-string (org-id-time-to-b36))) (postfix (if org-id-include-domain @@ -571,11 +577,22 @@ optional argument MARKERP, return the position as a new marker." (defun org-id-open (id) "Go to the entry with id ID." (org-mark-ring-push) - (let ((m (org-id-find id 'marker))) + (let ((m (org-id-find id 'marker)) + cmd) (unless m (error "Cannot find entry with ID \"%s\"" id)) + ;; Use a buffer-switching command in analogy to finding files + (setq cmd + (or + (cdr + (assq + (cdr (assq 'file org-link-frame-setup)) + '((find-file . switch-to-buffer) + (find-file-other-window . switch-to-buffer-other-window) + (find-file-other-frame . switch-to-buffer-other-frame)))) + 'switch-to-buffer-other-window)) (if (not (equal (current-buffer) (marker-buffer m))) - (switch-to-buffer-other-window (marker-buffer m))) + (funcall cmd (marker-buffer m))) (goto-char m) (move-marker m nil) (org-show-context))) diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el new file mode 100644 index 00000000000..e0de21d802c --- /dev/null +++ b/lisp/org/org-indent.el @@ -0,0 +1,283 @@ +;;; org-indent.el --- Dynamic indentation for Org-mode +;; Copyright (C) 2008 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.29c +;; +;; This file is part of GNU Emacs. +;; +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This is an implementation of dynamic virtual indentation. It works +;; by adding text properties to a buffer to make sure lines are +;; indented according to outline structure. + +(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 Structure" + :group 'org) + +(defconst org-indent-max 40 + "Maximum indentation in characters") +(defconst org-indent-max-levels 40 + "Maximum indentation in characters") + +(defvar org-indent-strings nil + "Vector with all indentation strings. +It will be set in `org-indent-initialize'.") +(defvar org-indent-stars nil + "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") + +(defcustom org-indent-boundary-char ?\ ; comment to protect space char + "The end of the virtual indentation strings, a single-character string. +The default is just a space, but if you wish, you can use \"|\" or so. +This can be useful on a terminal window - under a windowing system, +it may be prettier to customize the org-indent face." + :group 'org-indent + :set (lambda (var val) + (set var val) + (and org-indent-strings (org-indent-initialize))) + :type 'character) + +(defcustom org-indent-mode-turns-off-org-adapt-indentation t + "Non-nil means, turning on org-indent-mode turns 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'." + :group 'org-indent + :type 'boolean) + +(defcustom org-indent-indentation-per-level 2 + "Indentation per level in number of characters." + :group 'org-indent + :type 'integer) + +(defcustom org-indent-fix-section-after-idle-time 0.2 + "Seconds of idle time before fixing virtual indentation of section. +The hooking-in of virtual indentation is not yet perfect. Occasionally, +a change does not trigger to proper change of indentation. For this we +have a timer action that fixes indentation in the current section after +a short amount idle time. If we ever get the integration to work perfectly, +this variable can be set to nil to get rid of the timer." + :group 'org-indent + :type '(choice + (const "Do not install idle timer" nil) + (number :tag "Idle time"))) + +(defun org-indent-initialize () + "Initialize the indentation strings and set the idle timer." + ;; We use an idle timer to "repair" the current section, because the + ;; redisplay seems to have some problems. + (unless org-indent-strings + (when org-indent-fix-section-after-idle-time + (run-with-idle-timer + org-indent-fix-section-after-idle-time + t 'org-indent-refresh-section))) + ;; Initialize the indentation and star vectors + (setq org-indent-strings (make-vector (1+ org-indent-max) nil)) + (setq org-indent-stars (make-vector (1+ org-indent-max) nil)) + (aset org-indent-strings 0 "") + (aset org-indent-stars 0 "") + (loop for i from 1 to org-indent-max do + (aset org-indent-strings i + (org-add-props + (concat (make-string (1- i) ?\ ) + (char-to-string org-indent-boundary-char)) + nil 'face 'org-indent))) + (loop for i from 1 to org-indent-max-levels do + (aset org-indent-stars i + (org-add-props (make-string i ?*) + nil 'face 'org-hide)))) + +;;;###autoload +(define-minor-mode org-indent-mode + "When active, indent text according to outline structure. + +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)))))) + + +(defface org-indent + (org-compatible-face nil nil) + "Face for outline indentation. +The default is to make it look like whitespace. But you may find it +useful to make it evver so slightly different." + :group 'org-faces) + +(defun org-indent-indent-buffer () + "Add indentation properties for the whole buffer." + (interactive) + (when org-indent-mode + (save-excursion + (save-restriction + (widen) + (org-indent-remove-properties (point-min) (point-max)) + (org-indent-add-properties (point-min) (point-max)))))) + +(defun org-indent-remove-properties (beg end) + "Remove indentations between BEG and END." + (org-unmodified + (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) + +(defun org-indent-remove-properties-from-string (string) + "Remove indentations between BEG and END." + (remove-text-properties 0 (length string) + '(line-prefix nil wrap-prefix nil) string) + string) + +(defvar org-indent-outline-re (concat "^" org-outline-regexp) + "Outline heading regexp.") + +(defun org-indent-add-properties (beg end) + "Add indentation properties between BEG and END. +Assumes that BEG is at the beginning of a line." + (when (or t org-indent-mode) + (let (ov b e n level exit nstars) + (org-unmodified + (save-excursion + (goto-char beg) + (while (not exit) + (setq e end) + (if (not (re-search-forward org-indent-outline-re nil t)) + (setq e (point-max) exit t) + (setq e (match-beginning 0)) + (if (>= e end) (setq exit t)) + (setq level (- (match-end 0) (match-beginning 0) 1)) + (setq nstars (- (* (1- level) org-indent-indentation-per-level) + (1- level))) + (add-text-properties + (point-at-bol) (point-at-eol) + (list 'line-prefix + (aref org-indent-stars nstars) + 'wrap-prefix + (aref org-indent-strings + (* level org-indent-indentation-per-level))))) + (when (and b (> e b)) + (add-text-properties + b e (list 'line-prefix (aref org-indent-strings n) + 'wrap-prefix (aref org-indent-strings n)))) + (setq b (1+ (point-at-eol)) + n (* level org-indent-indentation-per-level)))))))) + +(defun org-indent-refresh-section () + "Refresh indentation properties in the current outline section. +Point is assumed to be at the beginning of a headline." + (interactive) + (when org-indent-mode + (let (beg end) + (save-excursion + (when (ignore-errors (org-back-to-heading)) + (setq beg (point)) + (setq end (or (save-excursion (or (outline-next-heading) (point))))) + (org-indent-remove-properties beg end) + (org-indent-add-properties beg end)))))) + +(defun org-indent-refresh-to (limit) + "Refresh indentation properties in the current outline section. +Point is assumed to be at the beginning of a headline." + (interactive) + (when org-indent-mode + (let ((beg (point)) (end limit)) + (save-excursion + (and (ignore-errors (org-back-to-heading t)) + (setq beg (point)))) + (org-indent-remove-properties beg end) + (org-indent-add-properties beg end))) + (goto-char limit)) + +(defun org-indent-refresh-subtree () + "Refresh indentation properties in the current outline subtree. +Point is assumed to be at the beginning of a headline." + (interactive) + (when org-indent-mode + (save-excursion + (let (beg end) + (setq beg (point)) + (setq end (save-excursion (org-end-of-subtree t t))) + (org-indent-remove-properties beg end) + (org-indent-add-properties beg end))))) + +(defun org-indent-refresh-buffer () + "Refresh indentation properties in the current outline subtree. +Point is assumed to be at the beginning of a headline." + (interactive) + (when org-indent-mode + (org-indent-mode -1) + (org-indent-mode 1))) + +(provide 'org-indent) + +;;; org-indent.el ends here + + diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index 1b6de745d49..8599404020a 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el new file mode 100644 index 00000000000..3b3e31e2e57 --- /dev/null +++ b/lisp/org/org-inlinetask.el @@ -0,0 +1,199 @@ +;;; org-inlinetask.el --- Tasks independent of outline hierarchy +;; Copyright (C) 2009 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.29c +;; +;; This file is not yet 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, 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; This module implements inline tasks in Org-mode. Inline tasks are +;; tasks that have all the properties of normal outline nodes, including +;; the ability to store meta data like scheduling dates, TODO state, tags +;; and properties. However, these nodes are treated specially by the +;; visibility cycling and export commands. +;; +;; 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 orther commands to show/hide +;; entries, you will occasionally find these tasks to behave like +;; all other outline nodes, seemingly splitting the text of the parent +;; into children. +;; +;; Export commands do not treat these nodes as part of the sectioning +;; structure, but as a special inline text that is either removed, or +;; formatted in some special way. +;; +;; Special fontification of inline tasks, so that they can be immediately +;; recognized. From the stars of the headline, only the first and the +;; last two will be visible, the others will be hidden using the +;; `org-hide' face. +;; +;; An inline task is identified solely by a minimum outline level, given +;; by the variable `org-inlinetask-min-level', default 15. +;; +;; Inline tasks are normally assumed to contain at most a time planning +;; line (DEADLINE etc) after it, and then any number of drawers, for +;; example LOGBOOK of PROPERTIES. No empty lines are allowed. +;; If you need to have normal text as part of an inline task, you +;; can do so by adding an "END" headline with the same number of stars, +;; for example +;; +;; **************** TODO some small task +;; DEADLINE: <2009-03-30 Mon> +;; :PROPERTIES: +;; :SOMETHING: or other +;; :END: +;; And here is some extra text +;; **************** END +;; +;; Also, if you want to use refiling and archiving for inline tasks, +;; The END line must be present to make things work properly. +;; +;; This package installs one new comand: +;; +;; C-c C-x t Insert a new inline task with END line + + +;;; Code + +(require 'org) + +(defgroup org-inlinetask nil + "Options concerning inline tasks in Org mode." + :tag "Org Inline Tasks" + :group 'org-structure) + +(defcustom org-inlinetask-min-level 15 + "Minimum level a headline must have before it is treated as an inline task. +It is strongly recommended that you set `org-cycle-max-level' not at all, +or to a number smaller than this one. In fact, when `org-cycle-max-level' is +not set, it will be assumed to be one less than the value of smaller than +the value of this variable." + :group 'org-inlinetask + :type 'boolean) + +(defcustom org-inlinetask-export 'arrow+content + "What should be done with inlinetasks upon export? +Possible values: + +nil Remove entirely, headline and \"content\" +arrow Insert heading in bold, preceeded by an arrow +arrow+content Insert arrow and headline, add content below in an + #+begin_example box (ugly, but works for now) + +The \"content\" of an inline task is the material below the planning +line and any drawers, up to a lines wit the same number of stars, +but containing only the word END." + :group 'org-inlinetask + :group 'org-export-general + :type '(choice + (const :tag "Remove entirely" nil) + (const :tag "Headline preceeded by arrow" arrow) + (const :tag "Arrow, headline, + content" arrow+content))) + +(defvar org-odd-levels-only) +(defvar org-keyword-time-regexp) +(defvar org-drawer-regexp) +(defvar org-complex-heading-regexp) +(defvar org-property-end-re) + +(defun org-inlinetask-insert-task () + "Insert an inline task." + (interactive) + (or (bolp) (newline)) + (insert (make-string org-inlinetask-min-level ?*) " \n" + (make-string org-inlinetask-min-level ?*) " END\n") + (end-of-line -1)) +(define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task) + +(defun org-inlinetask-export-handler () + "Handle headlines with level larger or equal to `org-inlinetask-min-level'. +Either remove headline and meta data, or do special formatting." + (goto-char (point-min)) + (let* ((nstars (if org-odd-levels-only + (1- (* 2 (or org-inlinetask-min-level 200))) + (or org-inlinetask-min-level 200))) + (re1 (format "^\\(\\*\\{%d,\\}\\) .*\n" nstars)) + (re2 (concat "^[ \t]*" org-keyword-time-regexp)) + headline beg end stars content) + (while (re-search-forward re1 nil t) + (setq headline (match-string 0) + stars (match-string 1) + content nil) + (replace-match "") + (while (looking-at re2) + (delete-region (point) (1+ (point-at-eol)))) + (while (looking-at org-drawer-regexp) + (setq beg (point)) + (if (re-search-forward org-property-end-re nil t) + (delete-region beg (1+ (match-end 0))))) + (setq beg (point)) + (when (and (re-search-forward "^\\(\\*+\\) " nil t) + (= (length (match-string 1)) (length stars)) + (progn (goto-char (match-end 0)) + (looking-at "END[ \t]*$"))) + (setq content (buffer-substring beg (1- (point-at-bol)))) + (delete-region beg (1+ (match-end 0)))) + (goto-char beg) + (when (and org-inlinetask-export + (string-match org-complex-heading-regexp headline)) + (when (memq org-inlinetask-export '(arrow+content arrow)) + (insert "\n\n\\Rightarrow\\Rightarrow\\Rightarrow *" + (if (match-end 2) (concat (match-string 2 headline) " ") "") + (match-string 4 headline) "*\n")) + (when (and content (eq org-inlinetask-export 'arrow+content)) + (insert "#+BEGIN_EXAMPLE\n" content "\n#+END_EXAMPLE\n")) + (insert "\n"))))) + +(defun org-inlinetask-fontify (limit) + "Fontify the inline tasks." + (let* ((nstars (if org-odd-levels-only + (1- (* 2 (or org-inlinetask-min-level 200))) + (or org-inlinetask-min-level 200))) + (re (concat "^\\(\\*\\)\\(\\*\\{" + (format "%d" (- nstars 3)) + ",\\}\\)\\(\\*\\* .*\\)"))) + (while (re-search-forward re limit t) + (add-text-properties (match-beginning 1) (match-end 1) + '(face org-warning font-lock-fontified t)) + (add-text-properties (match-beginning 2) (match-end 2) + '(face org-hide font-lock-fontified t)) + (add-text-properties (match-beginning 3) (match-end 3) + '(face shadow font-lock-fontified t))))) + +(defun org-inlinetask-remove-END-maybe () + "Remove an END line when present." + (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$" + org-inlinetask-min-level)) + (replace-match ""))) + +(eval-after-load "org-exp" + '(add-hook 'org-export-preprocess-after-tree-selection-hook + 'org-inlinetask-export-handler)) +(eval-after-load "org" + '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify)) + +(provide 'org-inlinetask) + +;;; org-inlinetask.el ends here + diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index a5bb2bb270d..ac40ec606bd 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el index b7b7b6c7780..b5632fc85d0 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -41,6 +41,7 @@ ;;; Code: (require 'org-exp) +(require 'org-html) (add-to-list 'org-export-inbuffer-options-extra '("INFOJS_OPT" :infojs-opt)) (add-hook 'org-export-options-filters 'org-infojs-handle-options) @@ -110,7 +111,7 @@ means to use the maximum value consistent with other options." <!--/*--><![CDATA[/*><!--*/ %MANAGER_OPTIONS org_html_manager.setup(); // activate after the parameters are set -/*]]>*/--> +/*]]>*///--> </script>" "The template for the export style additions when org-info.js is used. Option settings will replace the %MANAGER-OPTIONS cookie." diff --git a/lisp/org/org-export-latex.el b/lisp/org/org-latex.el index ab266aafd7f..896a0073190 100644 --- a/lisp/org/org-export-latex.el +++ b/lisp/org/org-latex.el @@ -1,15 +1,14 @@ -;;; org-export-latex.el --- LaTeX exporter for org-mode +;;; org-latex.el --- LaTeX exporter for org-mode ;; ;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc. ;; ;; Emacs Lisp Archive Entry -;; Filename: org-export-latex.el -;; Version: 6.21b +;; Filename: org-latex.el +;; Version: 6.29c ;; Author: Bastien Guerry <bzg AT altern DOT org> -;; Maintainer: Bastien Guerry <bzg AT altern DOT org> +;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Keywords: org, wp, tex ;; Description: Converts an org-mode buffer into LaTeX -;; URL: http://www.cognition.ens.fr/~guerry/u/org-export-latex.el ;; This file is part of GNU Emacs. @@ -30,8 +29,7 @@ ;; ;; This library implements a LaTeX exporter for org-mode. ;; -;; Put this file into your load-path and the following into your ~/.emacs: -;; (require 'org-export-latex) +;; It is part of Org and will be autoloaded ;; ;; The interactive functions are similar to those of the HTML exporter: ;; @@ -58,6 +56,10 @@ (defvar org-export-latex-append-header nil) (defvar org-export-latex-options-plist nil) (defvar org-export-latex-todo-keywords-1 nil) +(defvar org-export-latex-complex-heading-re nil) +(defvar org-export-latex-not-done-keywords nil) +(defvar org-export-latex-done-keywords nil) +(defvar org-export-latex-display-custom-times nil) (defvar org-export-latex-all-targets-re nil) (defvar org-export-latex-add-level 0) (defvar org-export-latex-sectioning "") @@ -165,12 +167,14 @@ to represent the section title." ("/" "\\emph{%s}" nil) ("_" "\\underline{%s}" nil) ("+" "\\texttt{%s}" nil) - ("=" "\\verb=%s=" nil) - ("~" "\\verb~%s~" t)) + ("=" "\\verb" t) + ("~" "\\verb" t)) "Alist of LaTeX expressions to convert emphasis fontifiers. Each element of the list is a list of three elements. The first element is the character used as a marker for fontification. The second element is a formatting string to wrap fontified text with. +If it is \"\\verb\", Org will automatically select a deimiter +character that is not in the string. The third element decides whether to protect converted text from other conversions." :group 'org-export-latex @@ -184,19 +188,58 @@ argument." :group 'org-export-latex :type 'string) +(defcustom org-export-latex-import-inbuffer-stuff nil + "Non-nil means define TeX macros for Org's inbuffer definitions. +For example \orgTITLE for #+TITLE." + :group 'org-export-latex + :type 'boolean) + (defcustom org-export-latex-date-format "%d %B %Y" "Format string for \\date{...}." :group 'org-export-latex :type 'string) +(defcustom org-export-latex-todo-keyword-markup "\\textbf{%s}" + "Markup for TODO keywords, as a printf format. +This can be a single format for all keywords, a cons cell with separate +formats for not-done and done states, or an association list with setup +for individual keywords. If a keyword shows up for which there is no +markup defined, the first one in the association list will be used." + :group 'org-export-latex + :type '(choice + (string :tag "Default") + (cons :tag "Distinguish undone and done" + (string :tag "Not-DONE states") + (string :tag "DONE states")) + (repeat :tag "Per keyword markup" + (cons + (string :tag "Keyword") + (string :tag "Markup"))))) + +(defcustom org-export-latex-timestamp-markup "\\textit{%s}" + "A printf format string to be applied to time stamps." + :group 'org-export-latex + :type 'string) + +(defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}" + "A printf format string to be applied to time stamps." + :group 'org-export-latex + :type 'string) + (defcustom org-export-latex-tables-verbatim nil "When non-nil, tables are exported verbatim." :group 'org-export-latex :type 'boolean) +(defcustom org-export-latex-tables-centered t + "When non-nil, tables are exported in a center environment." + :group 'org-export-latex + :type 'boolean) + (defcustom org-export-latex-tables-column-borders nil - "When non-nil, group of columns are surrounded with borders." + "When non-nil, grouping columns can cause outer vertical lines in tables. +When nil, grouping causes only separation lines between groups." :group 'org-export-latex :type 'boolean) @@ -206,22 +249,35 @@ Each cell is of the forma \( \"option\" . \"package\" \)." :group 'org-export-latex :type 'alist) -(defcustom org-export-latex-low-levels 'description +(defcustom org-export-latex-low-levels 'itemize "How to convert sections below the current level of sectioning. This is specified by the `org-export-headline-levels' option or the value of \"H:\" in Org's #+OPTION line. -This can be either nil (skip the sections), 'description (convert -the sections as descriptive lists) or a string to be used instead -of \\section{%s}. In this latter case, the %s stands here for the -inserted headline and is mandatory." +This can be either nil (skip the sections), `description', `itemize', +or `enumerate' (convert the sections as the corresponding list type), or +a string to be used instead of \\section{%s}. In this latter case, +the %s stands here for the inserted headline and is mandatory. + +It may also be a list of three string to define a user-defined environment +that should be used. The first string should be the like +\"\\begin{itemize}\", the second should be like \"\\item %s %s\" with up +to two occurrences of %s for the title and a lable, respectively. The third +string should be like \"\\end{itemize\"." :group 'org-export-latex :type '(choice (const :tag "Ignore" nil) - (symbol :tag "Convert as descriptive list" description) + (const :tag "Convert as descriptive list" description) + (const :tag "Convert as itemized list" itemize) + (const :tag "Convert as enumerated list" enumerate) + (list :tag "User-defined environment" + :value ("\\begin{itemize}" "\\end{itemize}" "\\item %s") + (string :tag "Start") + (string :tag "End") + (string :tag "item")) (string :tag "Use a section string" :value "\\subparagraph{%s}"))) (defcustom org-export-latex-list-parameters - '(:cbon "\\texttt{[ ]}" :cboff "\\texttt{[ ]}") + '(:cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}") "Parameters for the LaTeX list exporter. These parameters will be passed on to `org-list-to-latex', which in turn will pass them (combined with the LaTeX default list parameters) to @@ -229,6 +285,18 @@ will pass them (combined with the LaTeX default list parameters) to :group 'org-export-latex :type 'plist) +(defcustom org-export-latex-verbatim-wrap + '("\\begin{verbatim}\n" . "\\end{verbatim}\n") + "Environment to be wrapped around a fixed-width section in LaTeX export. +This is a cons with two strings, to be added before and after the +fixed-with text. + +Defaults to \\begin{verbatim} and \\end{verbatim}." + :group 'org-export-translation + :group 'org-export-latex + :type '(cons (string :tag "Open") + (string :tag "Close"))) + (defcustom org-export-latex-remove-from-headlines '(:todo nil :priority nil :tags nil) "A plist of keywords to remove from headlines. OBSOLETE. @@ -248,13 +316,13 @@ and `org-export-with-tags' instead." :type 'string) (defcustom org-export-latex-inline-image-extensions - '("pdf" "jpeg" "jpg" "png") + '("pdf" "jpeg" "jpg" "png" "ps" "eps") "Extensions of image files that can be inlined into LaTeX. -Note that this depends on the way the LaTeX file is processed. -The default setting (pdf and jpg) assumes that pdflatex is doing the -processing. If you are using latex and dvips or something similar, -only postscript files can be included." - :group 'org-export-html +Note that the image extension *actually* allowed depend on the way the +LaTeX file is processed. When used with pdflatex, pdf, jpg and png images +are OK. When processing through dvi to Postscript, only ps and eps are +allowed. The default we use here encompasses both." + :group 'org-export-latex :type '(repeat (string :tag "Extension"))) (defcustom org-export-latex-coding-system nil @@ -268,12 +336,37 @@ only postscript files can be included." :group 'org-export-latex :group 'org-export) +(defcustom org-latex-to-pdf-process + '("pdflatex -interaction nonstopmode %s" + "pdflatex -interaction nonstopmode %s") + "Commands to process a LaTeX file to a PDF file. +This is a list of strings, each of them will be given to the shell +as a command. %s in the command will be replaced by the full file name, %b +by the file base name (i.e. without extension). +The reason why this is a list is that it usually takes several runs of +pdflatex, maybe mixed with a call to bibtex. Org does not have a clever +mechanism to detect whihc of these commands have to be run to get to a stable +result, and it also does not do any error checking. + +Alternatively, this may be a Lisp function that does the processing, so you +could use this to apply the machinery of AUCTeX or the Emacs LaTeX mode. +THis function should accept the file name as its single argument." + :group 'org-export-latex + :type '(choice (repeat :tag "Shell command sequence" + (string :tag "Shell command")) + (function))) + (defcustom org-export-pdf-remove-logfiles t "Non-nil means, remove the logfiles produced by PDF production. These are the .aux, .log, .out, and .toc files." - :group 'org-export-latex + :group 'org-export-pdf :type 'boolean) +;;; Hooks + +(defvar org-export-latex-after-blockquotes-hook nil + "Hook run during LaTeX export, after blockquote, verse, center are done.") + ;;; Autoload functions: ;;;###autoload @@ -293,7 +386,8 @@ emacs --batch No file is created. The prefix ARG is passed through to `org-export-as-latex'." (interactive "P") (org-export-as-latex arg nil nil "*Org LaTeX Export*") - (switch-to-buffer-other-window "*Org LaTeX Export*")) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window "*Org LaTeX Export*"))) ;;;###autoload (defun org-replace-region-by-latex (beg end) @@ -329,23 +423,24 @@ contents, and only produce the region of converted text, useful for cut-and-paste operations. If BUFFER is a buffer or a string, use/create that buffer as a target of the converted LaTeX. If BUFFER is the symbol `string', return the -produced LaTeX as a string and leave not buffer behind. For example, +produced LaTeX as a string and leave no buffer behind. For example, a Lisp program could call this function in the following way: (setq latex (org-export-region-as-latex beg end t 'string)) When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only retunr the buffer." +in a window. A non-interactive call will only return the buffer." (interactive "r\nP") (when (interactive-p) (setq buffer "*Org LaTeX Export*")) (let ((transient-mark-mode t) (zmacs-regions t) - rtn) + ext-plist rtn) + (setq ext-plist (plist-put ext-plist :ignore-subree-p t)) (goto-char end) (set-mark (point)) ;; to activate the region (goto-char beg) (setq rtn (org-export-as-latex - nil nil nil + nil nil ext-plist buffer body-only)) (if (fboundp 'deactivate-mark) (deactivate-mark)) (if (and (interactive-p) (bufferp rtn)) @@ -360,8 +455,9 @@ If there is an active region, export only the region. The prefix ARG specifies how many levels of the outline should become headlines. The default is 3. Lower levels will be exported depending on `org-export-latex-low-levels'. The default is to -convert them as description lists. When HIDDEN is non-nil, don't -display the LaTeX buffer. EXT-PLIST is a property list with +convert them as description lists. +HIDDEN is obsolete and does nothing. +EXT-PLIST is a property list with external parameters overriding org-mode's default settings, but still inferior to file-local settings. When TO-BUFFER is non-nil, create a buffer with that name and export to that @@ -382,8 +478,9 @@ when PUB-DIR is set, use this as the publishing directory." (error "Need a file name to be able to export"))) (message "Exporting to LaTeX...") - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill nil)) + (org-unmodified + (remove-text-properties (point-min) (point-max) + '(:org-license-to-kill nil))) (org-update-radio-target-regexp) (org-export-latex-set-initial-vars ext-plist arg) (let* ((wcf (current-window-configuration)) @@ -392,14 +489,17 @@ when PUB-DIR is set, use this as the publishing directory." (rbeg (and region-p (region-beginning))) (rend (and region-p (region-end))) (subtree-p - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend))))) - (opt-plist (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist)) + (if (plist-get opt-plist :ignore-subree-p) + nil + (when region-p + (save-excursion + (goto-char rbeg) + (and (org-at-heading-p) + (>= (org-end-of-subtree t t) rend)))))) + (opt-plist (setq org-export-opt-plist + (if subtree-p + (org-export-add-subtree-options opt-plist rbeg) + opt-plist))) ;; Make sure the variable contains the updated values. (org-export-latex-options-plist opt-plist) (title (or (and subtree-p (org-export-get-title-from-subtree)) @@ -434,8 +534,19 @@ when PUB-DIR is set, use this as the publishing directory." (region-p nil) (t (plist-get opt-plist :skip-before-1st-heading)))) (text (plist-get opt-plist :text)) + (org-export-preprocess-hook + (cons + `(lambda () (org-set-local 'org-complex-heading-regexp + ,org-export-latex-complex-heading-re)) + org-export-preprocess-hook)) (first-lines (if skip "" (org-export-latex-first-lines - opt-plist rbeg))) + opt-plist + (if subtree-p + (save-excursion + (goto-char rbeg) + (point-at-bol 2)) + rbeg) + (if region-p rend)))) (coding-system (and (boundp 'buffer-file-coding-system) buffer-file-coding-system)) (coding-system-for-write (or org-export-latex-coding-system @@ -464,6 +575,7 @@ when PUB-DIR is set, use this as the publishing directory." (set-buffer buffer) (erase-buffer) + (org-install-letbind) (and (fboundp 'set-buffer-file-coding-system) (set-buffer-file-coding-system coding-system-for-write)) @@ -479,7 +591,7 @@ when PUB-DIR is set, use this as the publishing directory." "\n\n")) ;; insert lines before the first headline - (unless (or skip (eq to-buffer 'string)) + (unless skip (insert first-lines)) ;; export the content of headlines @@ -496,9 +608,21 @@ when PUB-DIR is set, use this as the publishing directory." ;; finalization (unless body-only (insert "\n\\end{document}")) + + ;; Relocate the table of contents + (goto-char (point-min)) + (when (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t) + (goto-char (point-min)) + (while (re-search-forward "\\\\tableofcontents\\>[ \t]*\n?" nil t) + (replace-match "")) + (goto-char (point-min)) + (and (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t) + (replace-match "\\tableofcontents" t t))) + (or to-buffer (save-buffer)) (goto-char (point-min)) - (message "Exporting to LaTeX...done") + (or (org-export-push-to-kill-ring "LaTeX") + (message "Exporting to LaTeX...done")) (prog1 (if (eq to-buffer 'string) (prog1 (buffer-substring (point-min) (point-max)) @@ -517,13 +641,32 @@ when PUB-DIR is set, use this as the publishing directory." to-buffer body-only pub-dir)) (file (buffer-file-name lbuf)) (base (file-name-sans-extension (buffer-file-name lbuf))) - (pdffile (concat base ".pdf"))) + (pdffile (concat base ".pdf")) + (cmds org-latex-to-pdf-process) + (outbuf (get-buffer-create "*Org PDF LaTeX Output*")) + (bibtex-p (with-current-buffer lbuf + (save-excursion + (goto-char (point-min)) + (re-search-forward "\\\\bibliography{" nil t)))) + cmd) + (with-current-buffer outbuf (erase-buffer)) (and (file-exists-p pdffile) (delete-file pdffile)) (message "Processing LaTeX file...") - (shell-command (format "pdflatex -interaction nonstopmode %s" - (shell-quote-argument file))) - (shell-command (format "pdflatex -interaction nonstopmode %s" - (shell-quote-argument file))) + (if (and cmds (symbolp cmds)) + (funcall cmds 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 file)) + t t cmd))) + (shell-command cmd outbuf outbuf))) (message "Processing LaTeX file...done") (if (not (file-exists-p pdffile)) (error "PDF file was not produced") @@ -663,13 +806,46 @@ If NUM, export sections as numerical sections." ;; At a level under the hl option: we can drop this subsection ((> level org-export-latex-sectioning-depth) (cond ((eq org-export-latex-low-levels 'description) - (insert (format "\\begin{description}\n\n\\item[%s]%s\n\n" + (if (string-match "% ends low level$" + (buffer-substring (point-at-bol 0) (point))) + (delete-region (point-at-bol 0) (point)) + (insert "\\begin{description}\n")) + (insert (format "\n\\item[%s]%s~\n\n" heading (if label (format "\\label{%s}" label) ""))) (insert (org-export-latex-content content)) (cond ((stringp subcontent) (insert subcontent)) ((listp subcontent) (org-export-latex-sub subcontent))) - (insert "\\end{description}\n")) + (insert "\\end{description} % ends low level\n")) + ((memq org-export-latex-low-levels '(itemize enumerate)) + (if (string-match "% ends low level$" + (buffer-substring (point-at-bol 0) (point))) + (delete-region (point-at-bol 0) (point)) + (insert (format "\\begin{%s}\n" + (symbol-name org-export-latex-low-levels)))) + (insert (format "\n\\item %s\\\\\n%s\n" + heading + (if label (format "\\label{%s}" label) ""))) + (insert (org-export-latex-content content)) + (cond ((stringp subcontent) (insert subcontent)) + ((listp subcontent) (org-export-latex-sub subcontent))) + (insert (format "\\end{%s} %% ends low level\n" + (symbol-name org-export-latex-low-levels)))) + + ((listp org-export-latex-low-levels) + (if (string-match "% ends low level$" + (buffer-substring (point-at-bol 0) (point))) + (delete-region (point-at-bol 0) (point)) + (insert (car org-export-latex-low-levels) "\n")) + (insert (format (nth 2 org-export-latex-low-levels) + heading + (if label (format "\\label{%s}" label) ""))) + (insert (org-export-latex-content content)) + (cond ((stringp subcontent) (insert subcontent)) + ((listp subcontent) (org-export-latex-sub subcontent))) + (insert (nth 1 org-export-latex-low-levels) + " %% ends low level\n")) + ((stringp org-export-latex-low-levels) (insert (format org-export-latex-low-levels heading) "\n") (when label (insert (format "\\label{%s}\n" label))) @@ -683,6 +859,10 @@ If NUM, export sections as numerical sections." EXT-PLIST is an optional additional plist. LEVEL indicates the default depth for export." (setq org-export-latex-todo-keywords-1 org-todo-keywords-1 + org-export-latex-done-keywords org-done-keywords + org-export-latex-not-done-keywords org-not-done-keywords + org-export-latex-complex-heading-re org-complex-heading-regexp + org-export-latex-display-custom-times org-display-custom-times org-export-latex-all-targets-re (org-make-target-link-regexp (org-all-targets)) org-export-latex-options-plist @@ -726,7 +906,7 @@ OPT-PLIST is the options plist for current buffer." (if (plist-get opt-plist :time-stamp-file) (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) ;; insert LaTeX custom header - org-export-latex-header + (org-export-apply-macros-in-string org-export-latex-header) "\n" ;; insert information on LaTeX packages (when org-export-latex-packages-alist @@ -737,8 +917,9 @@ OPT-PLIST is the options plist for current buffer." (car p) (cadr p)))) org-export-latex-packages-alist "\n")) ;; insert additional commands in the header - (plist-get opt-plist :latex-header-extra) - org-export-latex-append-header + (org-export-apply-macros-in-string + (plist-get opt-plist :latex-header-extra)) + (org-export-apply-macros-in-string org-export-latex-append-header) ;; insert the title (format "\n\n\\title{%s}\n" @@ -748,7 +929,7 @@ OPT-PLIST is the options plist for current buffer." ;; insert author info (if (plist-get opt-plist :author-info) (format "\\author{%s}\n" - (or author user-full-name)) + (org-export-latex-fontify-headline (or author user-full-name)));???????????????????? (format "%%\\author{%s}\n" (or author user-full-name))) ;; insert the date @@ -759,9 +940,10 @@ OPT-PLIST is the options plist for current buffer." ;; beginning of the document "\n\\begin{document}\n\n" ;; insert the title command - (if (string-match "%s" org-export-latex-title-command) - (format org-export-latex-title-command title) - org-export-latex-title-command) + (when (string-match "\\S-" title) + (if (string-match "%s" org-export-latex-title-command) + (format org-export-latex-title-command title) + org-export-latex-title-command)) "\n\n" ;; table of contents (when (and org-export-with-toc @@ -772,16 +954,16 @@ OPT-PLIST is the options plist for current buffer." (toc (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n" (plist-get opt-plist :headline-levels)))))))) -(defun org-export-latex-first-lines (opt-plist &optional beg) +(defun org-export-latex-first-lines (opt-plist &optional beg end) "Export the first lines before first headline. -If BEG is non-nil, the is the beginning of he region." +If BEG is non-nil, it is the beginning of the region. +If END is non-nil, it is the end of the region." (save-excursion (goto-char (or beg (point-min))) - (if (org-at-heading-p) (beginning-of-line 2)) (let* ((pt (point)) - (end (if (re-search-forward "^\\*+ " nil t) + (end (if (re-search-forward "^\\*+ " end t) (goto-char (match-beginning 0)) - (goto-char (point-max))))) + (goto-char end)))) (prog1 (org-export-latex-content (org-export-preprocess-string @@ -794,8 +976,14 @@ If BEG is non-nil, the is the beginning of he region." :LaTeX-fragments nil :timestamps (plist-get opt-plist :timestamps) :footnotes (plist-get opt-plist :footnotes))) - (add-text-properties pt (max pt (1- end)) - '(:org-license-to-kill t)))))) + (org-unmodified + (add-text-properties pt (max pt (1- end)) + '(:org-license-to-kill t))))))) + +(defvar org-export-latex-header-defs nil + "The header definitions that might be used in the LaTeX body.") +(defvar org-export-latex-header-defs-re nil + "The header definitions that might be used in the LaTeX body.") (defun org-export-latex-content (content &optional exclude-list) "Convert CONTENT string to LaTeX. @@ -804,6 +992,8 @@ conversion types are: quotation-marks, emphasis, sub-superscript, links, keywords, lists, tables, fixed-width" (with-temp-buffer (insert content) + (unless (memq 'timestamps exclude-list) + (org-export-latex-time-stamps)) (unless (memq 'quotation-marks exclude-list) (org-export-latex-quotation-marks)) (unless (memq 'emphasis exclude-list) @@ -846,12 +1036,21 @@ links, keywords, lists, tables, fixed-width" "Maybe remove keywords depending on rules in REMOVE-LIST." (goto-char (point-min)) (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|")) - (case-fold-search nil)) + (case-fold-search nil) + (todo-markup org-export-latex-todo-keyword-markup) + fmt) ;; convert TODO keywords (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t) (if (plist-get remove-list :todo) (replace-match "") - (replace-match (format "\\textbf{%s}" (match-string 1)) t t))) + (setq fmt (cond + ((stringp todo-markup) todo-markup) + ((and (consp todo-markup) (stringp (car todo-markup))) + (if (member (match-string 1) org-export-latex-done-keywords) + (cdr todo-markup) (car todo-markup))) + (t (cdr (or (assoc (match-string 1) todo-markup) + (car todo-markup)))))) + (replace-match (format fmt (match-string 1)) t t))) ;; convert priority string (when (re-search-forward "\\[\\\\#.\\]" nil t) (if (plist-get remove-list :priority) @@ -885,6 +1084,18 @@ links, keywords, lists, tables, fixed-width" (org-export-latex-links) (org-trim (buffer-string)))) +(defun org-export-latex-time-stamps () + "Format time stamps." + (goto-char (point-min)) + (let ((org-display-custom-times org-export-latex-display-custom-times)) + (while (re-search-forward org-ts-regexp-both nil t) + (org-if-unprotected-at (1- (point)) + (replace-match + (org-export-latex-protect-string + (format org-export-latex-timestamp-markup + (substring (org-translate-time (match-string 0)) 1 -1))) + t t))))) + (defun org-export-latex-quotation-marks () "Export quotation marks depending on language conventions." (let* ((lang (plist-get org-export-latex-options-plist :language)) @@ -892,9 +1103,9 @@ links, keywords, lists, tables, fixed-width" '(("\\(\\s-\\)\"" "«~") ("\\(\\S-\\)\"" "~»") ("\\(\\s-\\)'" "`")) - '(("\\(\\s-\\)\"" "``") + '(("\\(\\s-\\|(\\)\"" "``") ("\\(\\S-\\)\"" "''") - ("\\(\\s-\\)'" "`"))))) + ("\\(\\s-\\|(\\)'" "`"))))) (mapc (lambda(l) (goto-char (point-min)) (while (re-search-forward (car l) nil t) (let ((rpl (concat (match-string 1) (cadr l)))) @@ -951,10 +1162,11 @@ See the `org-export-latex.el' code for a complete conversion table." sub-superscript (match-string 2) (match-string 1) - (match-string 3))) "") t t))))))) + (match-string 3))) "") t t) + (backward-char 1))))))) '(;"^\\([^\n$]*?\\|^\\)\\(\\\\?\\$\\)\\([^\n$]*\\)$" "\\(\\(\\\\?\\$\\)\\)" - "\\([a-za-z0-9]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\([a-za-z0-9]+\\|[ \t\n]\\|[:punct:]\\|{[a-za-z0-9]+}\\|([a-za-z0-9]+)\\)" + "\\([a-za-z0-9]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-za-z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-za-z0-9]+}\\|([a-za-z0-9]+)\\)" "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|[a-zA-Z&#%{}\"]+\\)" "\\(.\\|^\\)\\(&\\)" "\\(.\\|^\\)\\(#\\)" @@ -993,10 +1205,12 @@ Convert CHAR depending on STRING-BEFORE and STRING-AFTER." (or (eq subsup t) (and (equal subsup '{}) (eq (string-to-char string-after) ?\{))) (string-match "[({]?\\([^)}]+\\)[)}]?" string-after)) - (format "%s$%s{%s}$" string-before char - (if (> (match-end 1) (1+ (match-beginning 1))) - (concat "\\mathrm{" (match-string 1 string-after) "}") - (match-string 1 string-after)))) + (org-export-latex-protect-string + (format "%s$%s{%s}$" string-before char + (if (and (> (match-end 1) (1+ (match-beginning 1))) + (not (equal (substring string-after 0 2) "{\\"))) + (concat "\\mathrm{" (match-string 1 string-after) "}") + (match-string 1 string-after))))) ((eq subsup t) (concat string-before "$" char string-after "$")) (t (org-export-latex-protect-string (concat string-before "\\" char "{}" string-after))))) @@ -1033,11 +1247,14 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (defun org-export-latex-keywords () "Convert special keywords to LaTeX." (goto-char (point-min)) - (let ((re (concat org-export-latex-special-keyword-regexp - ".*" ; including the time stamp.... - ))) - (while (re-search-forward re nil t) - (replace-match (format "\\\\texttt{%s}" (match-string 0)) t)))) + (while (re-search-forward org-export-latex-special-keyword-regexp nil t) + (replace-match (format org-export-latex-timestamp-keyword-markup + (match-string 0)) t t) + (save-excursion + (beginning-of-line 1) + (unless (looking-at ".*\\\\newline[ \t]*$") + (end-of-line 1) + (insert "\\newline"))))) (defun org-export-latex-fixed-width (opt) "When OPT is non-nil convert fixed-width sections to LaTeX." @@ -1089,7 +1306,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr) (match-string 1 attr)) floatp (or caption label)) - (setq lines (split-string raw-table "\n" t)) + (setq lines (org-split-string raw-table "\n")) (apply 'delete-region (list beg end)) (when org-export-table-remove-special-lines (setq lines (org-table-clean-before-export lines 'maybe-quoted))) @@ -1104,10 +1321,10 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (lambda (x) (setq gr (pop org-table-colgroup-info)) (format "%s%%s%s" - (cond ((eq gr ':start) - (prog1 (if colgropen "|" "") + (cond ((eq gr :start) + (prog1 (if colgropen "|" "|") (setq colgropen t))) - ((eq gr ':startend) + ((eq gr :startend) (prog1 (if colgropen "|" "|") (setq colgropen nil))) (t "")) @@ -1132,7 +1349,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (mapcar (lambda(elem) (or (and (string-match "[ \t]*|-+" elem) 'hline) - (split-string (org-trim elem) "|" t))) + (org-split-string (org-trim elem) "|"))) lines)) (when insert (insert (org-export-latex-protect-string @@ -1146,7 +1363,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (if label (concat "\\\label{" label "}") "") (or caption ""))) (if longtblp "\\\\\n" "\n") - (if (not longtblp) "\\begin{center}\n") + (if (and org-export-latex-tables-centered (not longtblp)) + "\\begin{center}\n") (if (not longtblp) (concat "\\begin{tabular}{" align "}\n")) (orgtbl-to-latex lines @@ -1160,7 +1378,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." \\endlastfoot" (length org-table-last-alignment)) nil))) (if (not longtblp) (concat "\n\\end{tabular}")) - (if longtblp "\n" "\n\\end{center}\n") + (if longtblp "\n" (if org-export-latex-tables-centered + "\n\\end{center}\n" "\n")) (if longtblp "\\end{longtable}" (if floatp "\\end{table}")))) @@ -1176,6 +1395,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (beg (match-beginning 0)) (end (match-end 0)) rpl) + (unless emph + (message "`org-export-latex-emphasis-alist' has no entry for formatting triggered by \"%s\"" + (match-string 3))) (unless (or (get-text-property (1- (point)) 'org-protected) (save-excursion (goto-char (match-beginning 1)) @@ -1184,15 +1406,46 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (string-match "[|\n]" (buffer-substring beg end)))))) (setq rpl (concat (match-string 1) - (format (org-export-latex-protect-char-in-string - '("\\" "{" "}") (cadr emph)) - (match-string 4)) + (org-export-latex-emph-format (cadr emph) + (match-string 4)) (match-string 5))) (if (caddr emph) (setq rpl (org-export-latex-protect-string rpl))) (replace-match rpl t t))) (backward-char))) +(defvar org-export-latex-use-verb nil) +(defun org-export-latex-emph-format (format string) + "Format an emphasis string and handle the \\verb special case." + (when (equal format "\\verb") + (save-match-data + (if org-export-latex-use-verb + (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) + (catch 'exit + (loop for i from 0 to (1- (length ll)) do + (if (not (string-match (regexp-quote (substring ll i (1+ i))) + string)) + (progn + (setq format (concat "\\verb" (substring ll i (1+ i)) + "%s" (substring ll i (1+ i)))) + (throw 'exit nil)))))) + (let ((start 0) + (trans '(("\\" . "\\backslash") + ("~" . "\\ensuremath{\\sim}") + ("^" . "\\ensuremath{\\wedge}"))) + (rtn "") char) + (while (string-match "[\\{}$%&_#~^]" string) + (setq char (match-string 0 string)) + (if (> (match-beginning 0) 0) + (setq rtn (concat rtn (substring string + 0 (match-beginning 0))))) + (setq string (substring string (1+ (match-beginning 0)))) + (setq char (or (cdr (assoc char trans)) (concat "\\" char)) + rtn (concat rtn char))) + (setq string (concat rtn string) format "\\texttt{%s}"))))) + (setq string (org-export-latex-protect-string + (format format string)))) + (defun org-export-latex-links () ;; Make sure to use the LaTeX hyperref and graphicx package ;; or send some warnings. @@ -1212,7 +1465,8 @@ 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)) - (attr (org-find-text-property-in-string 'org-attributes 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)) (floatp (or label caption)) imgp radiop @@ -1231,7 +1485,9 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (expand-file-name raw-path) org-export-latex-inline-image-extensions) - (equal desc full-raw-path)) + (or (get-text-property 0 'org-no-description + raw-path) + (equal desc full-raw-path))) (setq imgp t) (progn (when (string-match "\\(.+\\)::.+" raw-path) (setq raw-path (match-string 1 raw-path))) @@ -1247,7 +1503,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (concat (if floatp "\\begin{figure}[htb]\n") (format "\\centerline{\\includegraphics[%s]{%s}}\n" - (or attr org-export-latex-image-default-option) + attr (if (file-name-absolute-p raw-path) (expand-file-name raw-path) raw-path)) @@ -1264,14 +1520,20 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (org-solidify-link-text raw-path) desc))) ((not type) (insert (format "\\hyperref[%s]{%s}" - (org-solidify-link-text raw-path) desc))) + (org-remove-initial-hash + (org-solidify-link-text raw-path)) desc))) (path (insert (format "\\href{%s}{%s}" path desc))) (t (insert "\\texttt{" desc "}"))))))) +(defun org-remove-initial-hash (s) + (if (string-match "\\`#" s) + (substring s 1) + 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 () +(defun org-export-latex-preprocess (parameters) "Clean stuff in the LaTeX export." ;; Preserve line breaks (goto-char (point-min)) @@ -1281,13 +1543,16 @@ 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) + (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\*?\\)}" nil t) (let* ((start (progn (beginning-of-line) (point))) - (end (or (and (re-search-forward - (concat "^[ \t]*\\\\end{" (match-string 1) "}") nil t) - (point-at-eol)) - (point-max)))) - (add-text-properties start end '(org-protected t)))) + (end (and (re-search-forward + (concat "^[ \t]*\\\\end{" + (regexp-quote (match-string 1)) + "}") nil t) + (point-at-eol)))) + (if end + (add-text-properties start end '(org-protected t)) + (goto-char (point-at-eol))))) ;; Preserve math snippets @@ -1316,18 +1581,39 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." ;; Convert blockquotes (goto-char (point-min)) (while (search-forward "ORG-BLOCKQUOTE-START" nil t) - (replace-match "\\begin{quote}" t t)) + (org-replace-match-keep-properties "\\begin{quote}" t t)) (goto-char (point-min)) (while (search-forward "ORG-BLOCKQUOTE-END" nil t) - (replace-match "\\end{quote}" t t)) + (org-replace-match-keep-properties "\\end{quote}" t t)) ;; Convert verse (goto-char (point-min)) (while (search-forward "ORG-VERSE-START" nil t) - (replace-match "\\begin{verse}" t t)) + (org-replace-match-keep-properties "\\begin{verse}" t t) + (beginning-of-line 2) + (while (and (not (looking-at "[ \t]*ORG-VERSE-END.*")) (not (eobp))) + (when (looking-at "\\([ \t]+\\)\\([^ \t\n]\\)") + (goto-char (match-end 1)) + (org-replace-match-keep-properties + (org-export-latex-protect-string + (concat "\\hspace*{1cm}" (match-string 2))) t t) + (beginning-of-line 1)) + (unless (looking-at ".*?[^ \t\n].*?\\\\\\\\[ \t]*$") + (end-of-line 1) + (insert "\\\\")) + (beginning-of-line 2)) + (and (looking-at "[ \t]*ORG-VERSE-END.*") + (org-replace-match-keep-properties "\\end{verse}" t t))) + + ;; Convert center + (goto-char (point-min)) + (while (search-forward "ORG-CENTER-START" nil t) + (org-replace-match-keep-properties "\\begin{center}" t t)) (goto-char (point-min)) - (while (search-forward "ORG-VERSE-END" nil t) - (replace-match "\\end{verse}" t t)) + (while (search-forward "ORG-CENTER-END" nil t) + (org-replace-match-keep-properties "\\end{center}" t t)) + + (run-hooks 'org-export-latex-after-blockquotes-hook) ;; Convert horizontal rules (goto-char (point-min)) @@ -1336,16 +1622,23 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (replace-match (org-export-latex-protect-string "\\hrule") t t))) ;; Protect LaTeX commands like \command[...]{...} or \command{...} - (goto-char (point-min)) - (while (re-search-forward "\\\\[a-zA-Z]+\\(?:\\[.*\\]\\)?{.*}" nil t) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))) + (let ((re (concat "\\\\[a-zA-Z]+\\(?:" + "\\[.*\\]" + "\\)?" + (org-create-multibrace-regexp "{" "}" 3)))) + (while (re-search-forward re nil t) + (add-text-properties (match-beginning 0) (match-end 0) + '(org-protected t)))) ;; Protect LaTeX entities (goto-char (point-min)) - (while (re-search-forward org-latex-entities-regexp nil t) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))) + (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))))) ;; Replace radio links (goto-char (point-min)) @@ -1525,6 +1818,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "\\medskip" "\\multicolumn" "\\multiput" + ("\\nbsp" "~") "\\newcommand" "\\newcounter" "\\newenvironment" @@ -1596,9 +1890,14 @@ 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-z][A-Z]$" x) (push x names) (push x rest))) @@ -1606,7 +1905,8 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "\\|\\(" (regexp-opt (nreverse rest)) "\\)"))) (provide 'org-export-latex) +(provide 'org-latex) ;; arch-tag: 23c2b87d-da04-4c2d-ad2d-1eb6487bc3ad -;;; org-export-latex.el ends here +;;; org-latex.el ends here diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 4dd69564403..6c775f7d5d0 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -36,6 +36,8 @@ (defvar org-blank-before-new-entry) (defvar org-M-RET-may-split-line) +(defvar org-complex-heading-regexp) +(defvar org-odd-levels-only) (declare-function org-invisible-p "org" ()) (declare-function org-on-heading-p "org" (&optional invisible-ok)) @@ -48,21 +50,57 @@ (declare-function org-get-indentation "org" (&optional line)) (declare-function org-timer-item "org-timer" (&optional arg)) (declare-function org-combine-plists "org" (&rest plists)) +(declare-function org-entry-get "org" (pom property &optional inherit)) +(declare-function org-narrow-to-subtree "org" ()) +(declare-function org-show-subtree "org" ()) (defgroup org-plain-lists nil "Options concerning plain lists in Org-mode." :tag "Org Plain lists" :group 'org-structure) -(defcustom org-cycle-include-plain-lists nil - "Non-nil means, include plain lists into visibility cycling. -This means that during cycling, plain list items will *temporarily* be -interpreted as outline headlines with a level given by 1000+i where i is the -indentation of the bullet. In all other operations, plain list items are -not seen as headlines. For example, you cannot assign a TODO keyword to -such an item." +(defcustom org-cycle-include-plain-lists t + "When t, make TAB cycle visibility on plain list items. + +Cycling plain lists works only when the cursor is on a plain list +item. When the cursor is on an outline heading, plain lists are +treated as text. This is the most stable way of handling this, +which is why it is the default. + +When this is the symbol `integrate', then during cycling, plain +list items will *temporarily* be interpreted as outline headlines +with a level given by 1000+i where i is the indentation of the +bullet. This setting can lead to strange effects when switching +visibility to `children', because the first \"child\" in a +subtree decides what children should be listed. If that first +\"child\" is a plain list item with an implied large level +number, all true children and grand children of the outline +heading will be exposed in a children' view." :group 'org-plain-lists - :type 'boolean) + :type '(choice + (const :tag "Never" nil) + (const :tag "With cursor in plain list (recommended)" t) + (const :tag "As children of outline headings" integrate))) + +(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." + :group 'org-plain-lists + :type '(repeat + (cons + (choice :tag "If the current bullet is " + (const "-") + (const "+") + (const "*") + (const "1.") + (const "1)")) + (choice :tag "demotion will change it to" + (const "-") + (const "+") + (const "*") + (const "1.") + (const "1)"))))) (defcustom org-plain-list-ordered-item-terminator t "The character that makes a line with leading number an ordered list item. @@ -103,9 +141,15 @@ use \\[org-ctrl-c-ctrl-c] to trigger renumbering." (defcustom org-provide-checkbox-statistics t "Non-nil means, update checkbox statistics after insert and toggle. -When this is set, checkbox statistics is updated each time you either insert -a new checkbox with \\[org-insert-todo-heading] or toggle a checkbox -with \\[org-ctrl-c-ctrl-c\\]." +When this is set, checkbox statistics is updated each time you +either insert a new checkbox with \\[org-insert-todo-heading] or +toggle a checkbox with \\[org-ctrl-c-ctrl-c]." + :group 'org-plain-lists + :type 'boolean) + +(defcustom org-hierarchical-checkbox-statistics t + "Non-nil means, checkbox statistics counts only the state of direct children. +When nil, all boxes below the cookie are counted." :group 'org-plain-lists :type 'boolean) @@ -117,7 +161,7 @@ When the indentation would be larger than this, it will become :type 'integer) (defvar org-list-beginning-re - "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +\\(.*\\)$") + "^\\([ \t]*\\)\\([-+]\\|[0-9]+[.)]\\) +\\(.*\\)$") (defcustom org-list-radio-list-templates '((latex-mode "% BEGIN RECEIVE ORGLST %n @@ -159,7 +203,7 @@ list, obtained by prompting the user." (cond ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") ((= llt ?.) "\\([ \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'"))))))) (defun org-at-item-bullet-p () @@ -208,7 +252,9 @@ Return t when things worked, nil when we are not in an item." descp)))) (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") (match-end 0))) - (blank-a (cdr (assq 'plain-list-item org-blank-before-new-entry))) + (blank-a (if org-empty-line-terminates-plain-lists + nil + (cdr (assq 'plain-list-item org-blank-before-new-entry)))) (blank (if (eq blank-a 'auto) empty-line-p blank-a)) pos) (if descp (setq checkbox nil)) @@ -251,6 +297,7 @@ Return t when things worked, nil when we are not in an item." (defun org-toggle-checkbox (&optional toggle-presence) "Toggle the checkbox in the current line. With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. +With double prefix, set checkbox to [-]. When there is an active region, toggle status or presence of the checkbox in the first line, and make every item in the region have the same status or presence, respectively. @@ -258,24 +305,27 @@ If the cursor is in a headline, apply this to all checkbox items in the text below the heading." (interactive "P") (catch 'exit - (let (beg end status first-present first-status) + (let (beg end status first-present first-status blocked) (cond ((org-region-active-p) (setq beg (region-beginning) end (region-end))) ((org-on-heading-p) (setq beg (point) end (save-excursion (outline-next-heading) (point)))) ((org-at-item-checkbox-p) - (let ((pos (point))) - (if toggle-presence + (save-excursion + (if (equal toggle-presence '(4)) (progn (replace-match "") (goto-char (match-beginning 0)) (just-one-space)) + (when (setq blocked (org-checkbox-blocked-p)) + (error "Checkbox blocked because of unchecked box in line %d" + blocked)) (replace-match - (cond ((member (match-string 0) '("[ ]" "[-]")) "[X]") + (cond ((equal toggle-presence '(16)) "[-]") + ((member (match-string 0) '("[ ]" "[-]")) "[X]") (t "[ ]")) - t t)) - (goto-char pos)) + t t))) (throw 'exit t)) ((org-at-item-p) ;; add a checkbox @@ -312,10 +362,53 @@ text below the heading." (beginning-of-line 2))))) (org-update-checkbox-count-maybe)) +(defun org-reset-checkbox-state-subtree () + "Reset all checkboxes in an entry subtree." + (interactive "*") + (save-restriction + (save-excursion + (org-narrow-to-subtree) + (org-show-subtree) + (goto-char (point-min)) + (let ((end (point-max))) + (while (< (point) end) + (when (org-at-item-checkbox-p) + (replace-match "[ ]" t t)) + (beginning-of-line 2)))) + (org-update-checkbox-count-maybe))) + +(defun org-checkbox-blocked-p () + "Is the current checkbox blocked from for being checked now? +A checkbox is blocked if all of the following conditions are fulfilled: + +1. The checkbox is not checked already. +2. The current entry has the ORDERED property set. +3. There is an unchecked checkbox in this entry before the current line." + (catch 'exit + (save-match-data + (save-excursion + (unless (org-at-item-checkbox-p) (throw 'exit nil)) + (when (equal (match-string 0) "[X]") + ;; the box is already checked! + (throw 'exit nil)) + (let ((end (point-at-bol))) + (condition-case nil (org-back-to-heading t) + (error (throw 'exit nil))) + (unless (org-entry-get nil "ORDERED") (throw 'exit nil)) + (if (re-search-forward "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t) + (org-current-line) + nil)))))) + +(defvar org-checkbox-statistics-hook nil + "Hook that is run whenever Org thinks checkbox statistics should be updated. +This hook runs even if `org-provide-checkbox-statistics' is nil, to it can +be used to implement alternative ways of collecting statistics information.") + (defun org-update-checkbox-count-maybe () "Update checkbox statistics unless turned off by user." (when org-provide-checkbox-statistics - (org-update-checkbox-count))) + (org-update-checkbox-count)) + (run-hooks 'org-checkbox-statistics-hook)) (defun org-update-checkbox-count (&optional all) "Update the checkbox statistics in the current section. @@ -335,6 +428,10 @@ the whole buffer." (re-find (concat re "\\|" re-box)) beg-cookie end-cookie is-percent c-on c-off lim eline curr-ind next-ind continue-from startsearch + (recursive + (or (not org-hierarchical-checkbox-statistics) + (string-match "\\<recursive\\>" + (or (org-entry-get nil "COOKIE_DATA") "")))) (cstat 0) ) (when all @@ -342,8 +439,15 @@ the whole buffer." (outline-next-heading) (setq beg (point) end (point-max))) (goto-char end) - ;; find each statistic cookie - (while (re-search-backward re-find beg t) + ;; find each statistics cookie + (while (and (re-search-backward re-find beg t) + (not (save-match-data + (and (org-on-heading-p) + (string-match "\\<todo\\>" + (downcase + (or (org-entry-get + nil "COOKIE_DATA") + ""))))))) (setq beg-cookie (match-beginning 1) end-cookie (match-end 1) cstat (+ cstat (if end-cookie 1 0)) @@ -365,17 +469,21 @@ the whole buffer." (org-beginning-of-item) (setq curr-ind (org-get-indentation)) (setq next-ind curr-ind) - (while (and (bolp) (org-at-item-p) (= curr-ind next-ind)) + (while (and (bolp) (org-at-item-p) + (if recursive + (<= curr-ind next-ind) + (= curr-ind next-ind))) (save-excursion (end-of-line) (setq eline (point))) (if (re-search-forward re-box eline t) (if (member (match-string 2) '("[ ]" "[-]")) (setq c-off (1+ c-off)) - (setq c-on (1+ c-on)) - ) - ) - (org-end-of-item) - (setq next-ind (org-get-indentation)) - ))) + (setq c-on (1+ c-on)))) + (if (not recursive) + (org-end-of-item) + (end-of-line) + (when (re-search-forward org-list-beginning-re lim t) + (beginning-of-line))) + (setq next-ind (org-get-indentation))))) (goto-char continue-from) ;; update cookie (when end-cookie @@ -408,11 +516,13 @@ the whole buffer." The face will be `org-done' when all relevant boxes are checked. Otherwise it will be `org-todo'." (if (match-end 1) - (if (equal (match-string 1) "100%") 'org-done 'org-todo) + (if (equal (match-string 1) "100%") + 'org-checkbox-statistics-done + 'org-checkbox-statistics-todo) (if (and (> (match-end 2) (match-beginning 2)) (equal (match-string 2) (match-string 3))) - 'org-done - 'org-todo))) + 'org-checkbox-statistics-done + 'org-checkbox-statistics-todo))) (defun org-beginning-of-item () "Go to the beginning of the current hand-formatted item. @@ -513,11 +623,12 @@ Error if not at a plain list, or if this is the first item in the list." (error "On first item"))))) (defun org-first-list-item-p () - "Is this heading the item in a plain list?" + "Is this heading the first item in a plain list?" (unless (org-at-item-p) (error "Not at a plain list item")) - (org-beginning-of-item) - (= (point) (save-excursion (org-beginning-of-item-list)))) + (save-excursion + (org-beginning-of-item) + (= (point) (save-excursion (org-beginning-of-item-list))))) (defun org-move-item-down () "Move the plain list item at point down, i.e. swap with following item. @@ -705,7 +816,7 @@ with something like \"1.\" or \"2)\"." (org-beginning-of-item-list) (setq bobp (bobp)) (looking-at "[ \t]*[0-9]+\\([.)]\\)") - (setq fmt (concat "%d" (match-string 1))) + (setq fmt (concat "%d" (or (match-string 1) "."))) (beginning-of-line 0) ;; walk forward and replace these numbers (catch 'exit @@ -726,7 +837,7 @@ with something like \"1.\" or \"2)\"." (goto-line line) (org-move-to-column col))) -(defun org-fix-bullet-type () +(defun org-fix-bullet-type (&optional force-bullet) "Make sure all items in this list have the same bullet as the first item. Also, fix the indentation." (interactive) @@ -740,7 +851,7 @@ Also, fix the indentation." (beginning-of-line 1) ;; find out what the bullet type is (looking-at "[ \t]*\\(\\S-+\\)") - (setq bullet (concat (match-string 1) " ")) + (setq bullet (concat (or force-bullet (match-string 1)) " ")) (if (and org-list-two-spaces-after-bullet-regexp (string-match org-list-two-spaces-after-bullet-regexp bullet)) (setq bullet (concat bullet " "))) @@ -759,7 +870,7 @@ Also, fix the indentation." (skip-chars-forward " \t") (looking-at "\\S-+ *") (setq oldbullet (match-string 0)) - (replace-match bullet) + (unless (equal bullet oldbullet) (replace-match bullet)) (org-shift-item-indentation (- (length bullet) (length oldbullet)))))) (goto-line line) (org-move-to-column col) @@ -807,7 +918,6 @@ I.e. to the first item in this list." (when (org-at-item-p) (setq pos (point-at-bol))))))) (goto-char pos))) - (defun org-end-of-item-list () "Go to the end of the current item list. I.e. to the text after the last item." @@ -822,7 +932,9 @@ I.e. to the text after the last item." (catch 'next (beginning-of-line 2) (if (looking-at "[ \t]*$") - (throw (if (eobp) 'exit 'next) t)) + (if (eobp) + (progn (setq pos (point)) (throw 'exit t)) + (throw 'next t))) (skip-chars-forward " \t") (setq ind1 (current-column)) (if (or (< ind1 ind) (and (= ind1 ind) @@ -845,22 +957,25 @@ I.e. to the text after the last item." (defun org-indent-item (arg) "Indent a local list item." (interactive "p") + (and (org-region-active-p) (org-cursor-to-region-beginning)) (unless (org-at-item-p) (error "Not on an item")) - (save-excursion - (let (beg end ind ind1 tmp delta ind-down ind-up) + (let (beg end ind ind1 ind-bul delta ind-down ind-up firstp) + (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)) (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) - (setq end (move-marker org-last-indent-end-marker (point)))) + (setq end (move-marker org-last-indent-end-marker (or end (point))))) (goto-char beg) - (setq tmp (org-item-indent-positions) - ind (car tmp) - ind-down (nth 2 tmp) - ind-up (nth 1 tmp) + (setq ind-bul (org-item-indent-positions) + ind (caar ind-bul) + ind-down (car (nth 2 ind-bul)) + ind-up (car (nth 1 ind-bul)) delta (if (> arg 0) (if ind-down (- ind-down ind) 2) (if ind-up (- ind-up ind) -2))) @@ -870,13 +985,16 @@ I.e. to the text after the last item." (skip-chars-forward " \t") (setq ind1 (current-column)) (delete-region (point-at-bol) (point)) (or (eolp) (org-indent-to-column (+ ind1 delta))) - (beginning-of-line 2)))) - (org-fix-bullet-type) - (org-maybe-renumber-ordered-list-safe) - (save-excursion - (beginning-of-line 0) - (condition-case nil (org-beginning-of-item) (error nil)) - (org-maybe-renumber-ordered-list-safe))) + (beginning-of-line 2))) + (org-fix-bullet-type + (and (> arg 0) + (not firstp) + (cdr (assoc (cdr (nth 0 ind-bul)) org-list-demote-modify-bullet)))) + (org-maybe-renumber-ordered-list-safe) + (save-excursion + (beginning-of-line 0) + (condition-case nil (org-beginning-of-item) (error nil)) + (org-maybe-renumber-ordered-list-safe)))) (defun org-item-indent-positions () "Return indentation for plain list items. @@ -885,13 +1003,15 @@ parent indentation and the indentation a child should have. Assumes cursor in item line." (let* ((bolpos (point-at-bol)) (ind (org-get-indentation)) - ind-down ind-up pos) + (bullet (org-get-bullet)) + ind-down ind-up bullet-up bullet-down pos) (save-excursion (org-beginning-of-item-list) (skip-chars-backward "\n\r \t") (when (org-in-item-p) (org-beginning-of-item) - (setq ind-up (org-get-indentation)))) + (setq ind-up (org-get-indentation)) + (setq bullet-up (org-get-bullet)))) (setq pos (point)) (save-excursion (cond @@ -899,14 +1019,30 @@ Assumes cursor in item line." (error nil)) (or (forward-char 1) t) (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t)) - (setq ind-down (org-get-indentation))) + (setq ind-down (org-get-indentation) + bullet-down (org-get-bullet))) ((and (goto-char pos) (org-at-item-p)) (goto-char (match-end 0)) (skip-chars-forward " \t") - (setq ind-down (current-column))))) - (list ind ind-up ind-down))) - + (setq ind-down (current-column) + bullet-down (org-get-bullet))))) + (if (and bullet-down (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-down)) + (setq bullet-down (concat "1" (match-string 1 bullet-down)))) + (if (and bullet-up (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-up)) + (setq bullet-up (concat "1" (match-string 1 bullet-up)))) + (if (and bullet (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet)) + (setq bullet (concat "1" (match-string 1 bullet)))) + (list (cons ind bullet) + (cons ind-up bullet-up) + (cons ind-down bullet-down)))) + +(defun org-get-bullet () + (save-excursion + (goto-char (point-at-bol)) + (and (looking-at + "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\(\\*\\)\\)\\( \\|$\\)") + (or (match-string 2) (match-string 4))))) ;;; Send and receive lists @@ -968,16 +1104,54 @@ cdr is the indentation string." (progn (goto-char (point-min)) (point)) (cons (match-beginning 0) (match-string 1))))) +(defun org-list-goto-true-beginning () + "Go to the beginning of the list at point." + (beginning-of-line 1) + (while (looking-at org-list-beginning-re) + (beginning-of-line 0)) + (progn + (re-search-forward org-list-beginning-re nil t) + (goto-char (match-beginning 0)))) + +(defun org-list-make-subtree () + "Convert the plain list at point into a subtree." + (interactive) + (org-list-goto-true-beginning) + (let ((list (org-list-parse-list t)) nstars) + (save-excursion + (if (condition-case nil + (org-back-to-heading) + (error nil)) + (progn (re-search-forward org-complex-heading-regexp nil t) + (setq nstars (length (match-string 1)))) + (setq nstars 0))) + (org-list-make-subtrees list (1+ nstars)))) + +(defun org-list-make-subtrees (list level) + "Convert LIST into subtrees starting at LEVEL." + (if (symbolp (car list)) + (org-list-make-subtrees (cdr list) level) + (mapcar (lambda (item) + (if (stringp item) + (insert (make-string + (if org-odd-levels-only + (1- (* 2 level)) level) ?*) " " item "\n") + (org-list-make-subtrees item (1+ level)))) + list))) + (defun org-list-end (indent) "Return the position of the end of the list. -INDENT is the indentation of the list." +INDENT is the indentation of the list, as a string." (save-excursion (catch 'exit (while (or (looking-at org-list-beginning-re) - (looking-at (concat "^" indent "[ \t]+\\|^$"))) + (looking-at (concat "^" indent "[ \t]+\\|^$")) + (> (or (get-text-property (point) 'original-indentation) -1) + (length indent))) (if (eq (point) (point-max)) (throw 'exit (point-max))) - (forward-line 1))) (point))) + (forward-line 1))) + (point))) (defun org-list-insert-radio-list () "Insert a radio list template appropriate for this major mode." @@ -1002,7 +1176,7 @@ this list." (catch 'exit (unless (org-at-item-p) (error "Not at a list")) (save-excursion - (goto-char (car (org-list-item-beginning))) + (org-list-goto-true-beginning) (beginning-of-line 0) (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") (if maybe @@ -1150,7 +1324,7 @@ with overruling parameters for `org-list-to-generic'." LIST is as returnd by `org-list-parse-list'. PARAMS is a property list with overruling parameters for `org-list-to-generic'." (org-list-to-generic - list + list (org-combine-plists '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize" :ustart "@enumerate" :uend "@end enumerate" diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el index ae91be9148c..ff33dc7de14 100644 --- a/lisp/org/org-mac-message.el +++ b/lisp/org/org-mac-message.el @@ -1,9 +1,11 @@ -;;; org-mac-message.el --- Support for links to Apple Mail messages from within Org-mode +;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode ;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> -;; Version: 6.21b +;; Christopher Suckling <suckling at gmail dot com> + +;; Version: 6.29c ;; Keywords: outlines, hypermedia, calendar, wp ;; This file is part of GNU Emacs. @@ -22,14 +24,39 @@ ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: -;; This file implements links to Apple Mail messages from within Org-mode. +;; This file implements links to Apple Mail.app messages from within Org-mode. ;; Org-mode does not load this module by default - if you would actually like ;; this to happen then configure the variable `org-modules'. +;; If you would like to create links to all flagged messages in an +;; Apple Mail.app account, please customize the variable +;; `org-mac-mail-account' and then call one of the following functions: + +;; (org-mac-message-insert-selected) copies a formatted list of links to +;; the kill ring. + +;; (org-mac-message-insert-selected) inserts at point links to any +;; 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 +;; message:// links within the first level of the heading are deleted +;; and replaced with links to flagged messages. + ;;; Code: (require 'org) +(defgroup org-mac-flagged-mail nil + "Options concerning linking to flagged Mail.app messages" + :tag "Org Mail.app" + :group 'org-link) + +(defcustom org-mac-mail-account "customize" + "The Mail.app account in which to search for flagged messages" + :group 'org-mac-flagged-mail + :type 'string) + (org-add-link-type "message" 'org-mac-message-open) ;; In mac.c, removed in Emacs 23. @@ -53,29 +80,138 @@ This will use the command `open' with the message URL." (start-process (concat "open message:" message-id) nil "open" (concat "message://<" (substring message-id 2) ">"))) -(defun org-mac-message-insert-link () - "Insert a link to the messages currently selected in Apple Mail. +(defun as-get-selected-mail () + "AppleScript to create links to selected messages in Mail.app" + (do-applescript + (concat + "tell application \"Mail\"\n" + "set theLinkList to {}\n" + "set theSelection to selection\n" + "repeat with theMessage in theSelection\n" + "set theID to message id of theMessage\n" + "set theSubject to subject of theMessage\n" + "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" + "copy theLink to end of theLinkList\n" + "end repeat\n" + "return theLinkList as string\n" + "end tell"))) + +(defun as-get-flagged-mail () + "AppleScript to create links to flagged messages in Mail.app" + (do-applescript + (concat + ;; Is Growl installed? + "tell application \"System Events\"\n" + "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n" + "if (count of growlHelpers) > 0 then\n" + "set growlHelperApp to item 1 of growlHelpers\n" + "else\n" + "set growlHelperApp to \"\"\n" + "end if\n" + "end tell\n" + + ;; Get links + "tell application \"Mail\"\n" + "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n" + "set theLinkList to {}\n" + "repeat with aMailbox in theMailboxes\n" + "set theSelection to (every message in aMailbox whose flagged status = true)\n" + "repeat with theMessage in theSelection\n" + "set theID to message id of theMessage\n" + "set theSubject to subject of theMessage\n" + "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" + "copy theLink to end of theLinkList\n" + + ;; Report progress through Growl + ;; This "double tell" idiom is described in detail at + ;; http://macscripter.net/viewtopic.php?id=24570 The + ;; script compiler needs static knowledge of the + ;; growlHelperApp. Hmm, since we're compiling + ;; on-the-fly here, this is likely to be way less + ;; portable than I'd hoped. It'll work when the name + ;; is still "GrowlHelperApp", though. + "if growlHelperApp is not \"\" then\n" + "tell application \"GrowlHelperApp\"\n" + "tell application growlHelperApp\n" + "set the allNotificationsList to {\"FlaggedMail\"}\n" + "set the enabledNotificationsList to allNotificationsList\n" + "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n" + "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n" + "end tell\n" + "end tell\n" + "end if\n" + "end repeat\n" + "end repeat\n" + "return theLinkList as string\n" + "end tell"))) + +(defun org-mac-message-get-links (&optional select-or-flag) + "Create links to the messages currently selected or flagged in Mail.app. +This will use AppleScript to get the message-id and the subject of the +messages in Mail.app and make a link out of it. +When SELECT-OR-FLAG is \"s\", get the selected messages (this is also +the default). When SELECT-OR-FLAG is \"f\", get the flagged messages. +The Org-syntax text will be pushed to the kill ring, and also returned." + (interactive "sLink to (s)elected or (f)lagged messages: ") + (setq select-or-flag (or select-or-flag "s")) + (message "AppleScript: searching mailboxes...") + (let* ((as-link-list + (if (string= select-or-flag "s") + (as-get-selected-mail) + (if (string= select-or-flag "f") + (as-get-flagged-mail) + (error "Please select \"s\" or \"f\"")))) + (link-list + (mapcar + (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x) + (split-string as-link-list "[\r\n]+"))) + split-link URL description orglink orglink-insert rtn orglink-list) + (while link-list + (setq split-link (split-string (pop link-list) "::split::")) + (setq URL (car split-link)) + (setq description (cadr split-link)) + (when (not (string= URL "")) + (setq orglink (org-make-link-string URL description)) + (push orglink orglink-list))) + (setq rtn (mapconcat 'identity orglink-list "\n")) + (kill-new rtn) + rtn)) + +(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 -active mail in AppleMail and make a link out of it." +active mail in Mail.app and make a link out of it." (interactive) - (insert (org-mac-message-get-link))) - -(defun org-mac-message-get-link () - "Insert a link to the messages currently selected in Apple Mail. -This will use applescript to get the message-id and the subject of the -active mail in AppleMail and make a link out of it." - (let ((subject (do-applescript "tell application \"Mail\" - set theMessages to selection - subject of beginning of theMessages -end tell")) - (message-id (do-applescript "tell application \"Mail\" - set theMessages to selection - message id of beginning of theMessages -end tell"))) - (org-make-link-string - (concat "message://" - (substring message-id 1 (1- (length message-id)))) - (substring subject 1 (1- (length subject)))))) + (insert (org-mac-message-get-links "s"))) + +;; The following line is for backward compatibility +(defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected) + +(defun org-mac-message-insert-flagged (org-buffer org-heading) + "Asks for an org buffer and a heading within it, and replace message links. +If heading exists, delete all message:// links within heading's first +level. If heading doesn't exist, create it at point-max. Insert +list of message:// links to flagged mail after heading." + (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ") + (save-excursion + (set-buffer org-buffer) + (goto-char (point-min)) + (let ((isearch-forward t) + (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]")) + (if (org-goto-local-search-headings org-heading nil t) + (if (not (eobp)) + (progn + (save-excursion + (while (re-search-forward + message-re (save-excursion (outline-next-heading)) t) + (delete-region (match-beginning 0) (match-end 0))) + (insert "\n" (org-mac-message-get-links "f"))) + (flush-lines "^$" (point) (outline-next-heading))) + (insert "\n" (org-mac-message-get-links "f"))) + (goto-char (point-max)) + (insert "\n") + (org-insert-heading) + (insert org-heading "\n" (org-mac-message-get-links "f")))))) (provide 'org-mac-message) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 4990b83d0b8..4e15566f4f6 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -33,14 +33,24 @@ ;;; Code: +(eval-and-compile + (unless (fboundp 'declare-function) + (defmacro declare-function (fn file &optional arglist fileonly)))) + +(declare-function org-add-props "org-compat" (string plist &rest props)) + (defmacro org-bound-and-true-p (var) "Return the value of symbol VAR if it is bound, else nil." `(and (boundp (quote ,var)) ,var)) (defmacro org-unmodified (&rest body) - "Execute body without changing `buffer-modified-p'." + "Execute body without changing `buffer-modified-p'. +Also, do not record undo information." `(set-buffer-modified-p - (prog1 (buffer-modified-p) ,@body))) + (prog1 (buffer-modified-p) + (let ((buffer-undo-list t) + before-change-functions after-change-functions) + ,@body)))) (defmacro org-re (s) "Replace posix classes in regular expression." @@ -73,10 +83,6 @@ ,@body) (if pc-mode (partial-completion-mode 1))))) -(eval-and-compile - (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly)))) - (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 @@ -110,6 +116,11 @@ We use a macro so that the test can happen at compilation time." `(unless (get-text-property (1- (point)) 'org-protected) ,@body)) +(defmacro org-if-unprotected-at (pos &rest body) + "Execute BODY if there is no `org-protected' text property at point-1." + `(unless (get-text-property ,pos 'org-protected) + ,@body)) + (defmacro org-with-remote-undo (_buffer &rest _body) "Execute BODY while recording undo information in two buffers." `(let ((_cline (org-current-line)) @@ -160,6 +171,18 @@ We use a macro so that the test can happen at compilation time." ((assoc key option) (cdr (assoc key option))) (t (cdr (assq 'default option))))) +(defsubst org-check-external-command (cmd &optional use no-error) + "Check if external progam CMD for USE exists, error if not. +When the program does exist, return it's path. +When it does not exist and NO-ERROR is set, return nil. +Otherwise, throw an error. The optional argument USE can describe what this +program is needed for, so that the error message can be more informative." + (or (executable-find cmd) + (if no-error + nil + (error "Can't find `%s'%s" cmd + (if use (format " (%s)" use) ""))))) + (defsubst org-inhibit-invisibility () "Modified `buffer-invisibility-spec' for Emacs 21. Some ops with invisible text do not work correctly on Emacs 21. For these @@ -168,7 +191,7 @@ we turn off invisibility temporarily. Use this in a `let' form." (defsubst org-set-local (var value) "Make VAR local in current buffer and set it to VALUE." - (set (make-variable-buffer-local var) value)) + (set (make-local-variable var) value)) (defsubst org-mode-p () "Check if the current buffer is in Org-mode." @@ -228,6 +251,31 @@ 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." + (setq newtext (org-add-props newtext (text-properties-at + (match-beginning 0) string))) + (replace-match newtext fixedcase literal string)) + +(defmacro org-with-limited-levels (&rest body) + "Execute BODY with limited number of outline levels." + `(let* ((outline-regexp (org-get-limited-outline-regexp))) + ,@body)) + +(defvar org-odd-levels-only) ; defined in org.el +(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 " + (if (or (not (org-mode-p)) (not (featurep 'org-inlinetask))) + + outline-regexp + (let* ((limit-level (1- org-inlinetask-min-level)) + (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) + (format "\\*\\{1,%d\\} " nstars)))) + (provide 'org-macs) ;; arch-tag: 7e6a73ce-aac9-4fc0-9b30-ce6f89dc6668 diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el index 75d087e01e9..9fe84fece87 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.21b +;; Version: 6.29c ;; This file is part of GNU Emacs. diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index 90e4468c728..ba408ef7c4f 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index 798fddb0c59..c911db9ad61 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -422,7 +422,17 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (loop for priority from ?A to org-lowest-priority collect (char-to-string priority))) +(defun org-mouse-todo-menu (state) + "Create the menu with TODO keywords." + (append + (let ((kwds org-todo-keywords-1)) + (org-mouse-keyword-menu + kwds + `(lambda (kwd) (org-todo kwd)) + (lambda (kwd) (equal state kwd)))))) + (defun org-mouse-tag-menu () ;todo + "Create the tags menu" (append (let ((tags (org-get-tags))) (org-mouse-keyword-menu @@ -441,7 +451,6 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ["Set Tags ..." (org-set-tags) t]))) - (defun org-mouse-set-tags (tags) (save-excursion ;; remove existing tags first @@ -621,9 +630,6 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (set-match-data ',match) (apply ',function rest))))) -(defun org-mouse-todo-keywords () - (if (boundp 'org-todo-keywords-1) org-todo-keywords-1 org-todo-keywords)) - (defun org-mouse-match-todo-keyword () (save-excursion (org-back-to-heading) @@ -691,10 +697,10 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (org-mouse-remove-match-and-spaces))))] ))) ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_") - (member (match-string 0) (org-mouse-todo-keywords))) + (member (match-string 0) org-todo-keywords-1)) (popup-menu `(nil - ,@(org-mouse-keyword-replace-menu (org-mouse-todo-keywords)) + ,@(org-mouse-todo-menu (match-string 0)) "--" ["Check TODOs" org-show-todo-tree t] ["List all TODO keywords" org-todo-list t] @@ -718,7 +724,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" ["Open" org-open-at-point t] ["Open in Emacs" (org-open-at-point t) t] "--" - ["Copy link" (kill-new (match-string 0))] + ["Copy link" (org-kill-new (match-string 0))] ["Cut link" (progn (kill-region (match-beginning 0) (match-end 0)) @@ -832,9 +838,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" "--" ,@(org-mouse-tag-menu)) ("TODO Status" - ,@(progn (org-mouse-match-todo-keyword) - (org-mouse-keyword-replace-menu (org-mouse-todo-keywords) - 1))) + ,@(org-mouse-todo-menu (org-get-todo-state))) ["Show Tags" (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags)) :visible (not org-mouse-direct)] @@ -1132,8 +1136,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (if (featurep 'xemacs) [button3] [mouse-3]) 'org-mouse-show-context-menu) (define-key org-agenda-keymap [down-mouse-3] 'org-mouse-move-tree-start) - (define-key org-agenda-keymap [C-mouse-4] 'org-agenda-earlier) - (define-key org-agenda-keymap [C-mouse-5] 'org-agenda-later) + (define-key org-agenda-keymap (if (featurep 'xemacs) [(control mouse-4)] [C-mouse-4]) 'org-agenda-earlier) + (define-key org-agenda-keymap (if (featurep 'xemacs) [(control mouse-5)] [C-mouse-5]) 'org-agenda-later) (define-key org-agenda-keymap [drag-mouse-3] '(lambda (event) (interactive "e") (case (org-mouse-get-gesture event) diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index c1704405505..3f40eafb8cd 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -64,6 +64,7 @@ Returns the resulting property list." ("file" . :file) ("labels" . :labels) ("map" . :map) + ("timeind" . :timeind) ("timefmt" . :timefmt))) (multiples '("set" "line")) (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)") @@ -181,9 +182,11 @@ and dependant variables." (setf back-edge "") (setf front-edge ""))))) row-vals)) -(defun org-plot/gnuplot-script (data-file num-cols params) +(defun org-plot/gnuplot-script (data-file num-cols params &optional preface) "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS. -NUM-COLS controls the number of columns plotted in a 2-d plot." +NUM-COLS controls the number of columns plotted in a 2-d plot. +Optional argument PREFACE returns only option parameters in a +manner suitable for prepending to a user-specified script." (let* ((type (plist-get params :plot-type)) (with (if (equal type 'grid) 'pm3d @@ -238,7 +241,8 @@ NUM-COLS controls the number of columns plotted in a 2-d plot." (add-to-script (concat "set timefmt \"" (or timefmt ;; timefmt passed to gnuplot "%Y-%m-%d-%H:%M:%S") "\""))) - (case type ;; plot command + (unless preface + (case type ;; plot command ('2d (dotimes (col num-cols) (unless (and (equal type '2d) (or (and ind (equal (+ 1 col) ind)) @@ -259,8 +263,8 @@ NUM-COLS controls the number of columns plotted in a 2-d plot." ('grid (setq plot-lines (list (format "'%s' with %s title ''" data-file with))))) - (add-to-script - (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n "))) + (add-to-script + (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n ")))) script))) ;;----------------------------------------------------------------------------- @@ -328,10 +332,13 @@ line directly before or after the table." ;; write script (with-temp-buffer (if (plist-get params :script) ;; user script - (progn (insert-file-contents (plist-get params :script)) - (goto-char (point-min)) - (while (re-search-forward "$datafile" nil t) - (replace-match data-file nil nil))) + (progn (insert + (org-plot/gnuplot-script data-file num-cols params t)) + (insert "\n") + (insert-file-contents (plist-get params :script)) + (goto-char (point-min)) + (while (re-search-forward "$datafile" nil t) + (replace-match data-file nil nil))) (insert (org-plot/gnuplot-script data-file num-cols params))) ;; graph table @@ -339,7 +346,7 @@ line directly before or after the table." (gnuplot-send-buffer-to-gnuplot)) ;; cleanup (bury-buffer (get-buffer "*gnuplot*")) - (delete-file data-file)))) + (run-with-idle-timer 0.1 nil (lambda () (delete-file data-file)))))) (provide 'org-plot) diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el new file mode 100644 index 00000000000..5ec67d76884 --- /dev/null +++ b/lisp/org/org-protocol.el @@ -0,0 +1,636 @@ +;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions. +;; +;; Copyright (c) 2008, 2009 +;; Free Software Foundation, Inc. +;; +;; Author: Bastien Guerry <bzg AT altern DOT org> +;; Author: Daniel M German <dmg AT uvic DOT org> +;; Author: Sebastian Rose <sebastian_rose AT gmx DOT de> +;; Author: Ross Patterson <me AT rpatterson DOT net> +;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de> +;; Keywords: org, emacsclient, wp +;; Version: 6.29c + +;; 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: +;; +;; 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 +;; `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'. +;; +;; Any application that supports calling external programs with an URL +;; as argument may be used with this functionality. +;; +;; +;; Usage: +;; ------ +;; +;; 1.) Add this to your init file (.emacs probably): +;; +;; (add-to-list 'load-path "/path/to/org-protocol/") +;; (require 'org-protocol) +;; +;; 3.) Ensure emacs-server is up and running. +;; 4.) Try this from the command line (adjust the URL as needed): +;; +;; $ emacsclient \ +;; org-protocol://store-link://http:%2F%2Flocalhost%2Findex.html/The%20title +;; +;; 5.) Optionally add custom sub-protocols and handlers: +;; +;; (setq org-protocol-protocol-alist +;; '(("my-protocol" +;; :protocol "my-protocol" +;; :function my-protocol-handler-fuction))) +;; +;; A "sub-protocol" will be found in URLs like this: +;; +;; org-protocol://sub-protocol://data +;; +;; If it works, you can now setup other applications for using this feature. +;; +;; +;; As of March 2009 Firefox users follow the steps documented on +;; http://kb.mozillazine.org/Register_protocol, Opera setup is described here: +;; http://www.opera.com/support/kb/view/535/ +;; +;; +;; Documentation +;; ------------- +;; +;; org-protocol.el comes with and installs handlers to open sources of published +;; online content, store and insert the browser's URLs and cite online content +;; by clicking on a bookmark in Firefox, Opera and probably other browsers and +;; applications: +;; +;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps +;; 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 +;; triggered through the sub-protocol \"store-link\". +;; +;; * Call `org-protocol-remember' by using the sub-protocol \"remember\". If +;; Org-mode is loaded, emacs will popup 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 +;; was select in the browser, that text will be the body of the entry. +;; +;; You may use the same bookmark URL for all those standard handlers and just +;; adjust the sub-protocol used: +;; +;; location.href='org-protocol://sub-protocol://'+ +;; encodeURIComponent(location.href)+'/'+ +;; encodeURIComponent(document.title)+'/'+ +;; encodeURIComponent(window.getSelection()) +;; +;; The handler for the sub-protocol \"remember\" detects an optional template +;; char that, if present, triggers the use of a special template. +;; Example: +;; +;; location.href='org-protocol://sub-protocol://x/'+ ... +;; +;; use template ?x. +;; +;; Note, that using double shlashes is optional from org-protocol.el's point of +;; view because emacsclient sqashes the slashes to one. +;; +;; +;; provides: 'org-protocol +;; +;;; Code: + +(require 'org) +(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" ()) + + +(defgroup org-protocol nil + "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 +`org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'." + :version "22.1" + :group 'convenience + :group 'org) + + +;;; Variables: + +(defconst org-protocol-protocol-alist-default + '(("org-remember" :protocol "remember" :function org-protocol-remember :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. +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.") + + +;;; 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 +unchanged." + :group 'org-protocol + :type 'boolean) + + +(defcustom org-protocol-project-alist nil + "* Map URLs to local filenames for `org-protocol-open-source' (open-source). + +Each element of this list must be of the form: + + (module-name :property value property: value ...) + +where module-name is an arbitrary name. All the values are strings. + +Possible properties are: + + :online-suffix - the suffix to strip from the published URLs + :working-suffix - the replacement for online-suffix + :base-url - the base URL, e.g. http://www.example.com/project/ + Last slash required. + :working-directory - the local working directory. This is, what base-url will + be replaced with. + +Example: + + (setq org-protocol-project-alist + '((\"http://orgmode.org/worg/\" + :online-suffix \".php\" + :working-suffix \".org\" + :base-url \"http://orgmode.org/worg/\" + :working-directory \"/home/user/org/Worg/\") + (\"http://localhost/org-notes/\" + :online-suffix \".html\" + :working-suffix \".org\" + :base-url \"http://localhost/org/\" + :working-directory \"/home/user/org/\"))) + +Consider using the interactive functions `org-protocol-create' and +`org-protocol-create-for-org' to help you filling this variable with valid contents." + :group 'org-protocol + :type 'alist) + + +(defcustom org-protocol-protocol-alist nil + "* Register custom handlers for org-protocol. + +Each element of this list must be of the form: + + (module-name :protocol protocol :function func :kill-client nil) + +protocol - protocol to detect in a filename without trailing colon and slashes. + See rfc1738 section 2.1 for more on this. + 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 + to one by emacsclient. + +function - function that handles requests with protocol and takes exactly one + argument: the filename with all protocols stripped. If the function + returns nil, emacsclient and -server do nothing. Any non-nil return + value is considered a valid filename and thus passed to the server. + + `org-protocol.el provides some support for handling those filenames, + if you stay with the conventions used for the standard handlers in + `org-protocol-protocol-alist-default'. See `org-protocol-split-data'. + +kill-client - If t, kill the client immediately, once the sub-protocol is + detected. This is neccessary for actions that can be interupted by + `C-g' to avoid dangeling 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. + +Here is an example: + + (setq org-protocol-protocol-alist + '((\"my-protocol\" + :protocol \"my-protocol\" + :function my-protocol-handler-fuction) + (\"your-protocol\" + :protocol \"your-protocol\" + :function your-protocol-handler-fuction)))" + :group 'org-protocol + :type '(alist)) + +(defcustom org-protocol-default-template-key "w" + "The default org-remember-templates key to use." + :group 'org-protocol + :type 'string) + + +;;; Helper functions: + +(defun org-protocol-sanitize-uri (uri) + "emacsclient compresses double and tripple slashes. +Slashes are sanitized to double slashes here." + (when (string-match "^\\([a-z]+\\):/" uri) + (let* ((splitparts (split-string uri "/+"))) + (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/"))))) + uri) + + +(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." + (let* ((sep (or separator "/+")) + (split-parts (split-string data sep))) + (if unhexify + (if (fboundp unhexify) + (mapcar unhexify split-parts) + (mapcar 'org-protocol-unhex-string split-parts)) + split-parts))) + +(defun org-protocol-unhex-string(str) + "Unhex hexified unicode strings as returned from the JavaScript function +encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ü'." + (setq str (or str "")) + (let ((tmp "") + (case-fold-search t)) + (while (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (hex (match-string 0 str)) + (replacement (org-protocol-unhex-compound hex))) + (setq tmp (concat tmp (substring str 0 start) replacement)) + (setq str (substring str end)))) + (setq tmp (concat tmp str)) + tmp)) + + +(defun org-protocol-unhex-compound (hex) + "Unhexify unicode hex-chars. E.g. `%C3%B6' is the german Umlaut `ü'." + (let* ((bytes (remove "" (split-string hex "%"))) + (ret "") + (eat 0) + (sum 0)) + (while bytes + (let* ((b (pop bytes)) + (a (elt b 0)) + (b (elt b 1)) + (c1 (if (> a ?9) (+ 10 (- a ?A)) (- a ?0))) + (c2 (if (> b ?9) (+ 10 (- b ?A)) (- b ?0))) + (val (+ (lsh c1 4) c2)) + (shift + (if (= 0 eat) ;; new byte + (if (>= val 252) 6 + (if (>= val 248) 5 + (if (>= val 240) 4 + (if (>= val 224) 3 + (if (>= val 192) 2 0))))) + 6)) + (xor + (if (= 0 eat) ;; new byte + (if (>= val 252) 252 + (if (>= val 248) 248 + (if (>= val 240) 240 + (if (>= val 224) 224 + (if (>= val 192) 192 0))))) + 128))) + (if (>= val 192) (setq eat shift)) + (setq val (logxor val xor)) + (setq sum (+ (lsh sum shift) val)) + (if (> eat 0) (setq eat (- eat 1))) + (when (= 0 eat) + (setq ret (concat ret (char-to-string sum))) + (setq sum 0)) + )) ;; end (while bytes + ret )) + +(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement) + "Greedy handlers might recieve a list like this from emacsclient: + '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") +where \"/dir/\" is the absolute path to emacsclients working directory. This +function transforms it into a flat list utilizing `org-protocol-flatten' and +transforms the elements of that list as follows: + +If strip-path is non-nil, remove the \"/dir/\" prefix from all members of +param-list. + +If replacement is string, replace the \"/dir/\" prefix with it. + +The first parameter, the one that contains the protocols, is always changed. +Everything up to the end of the protocols is stripped. + +Note, that this function will always behave as if +`org-protocol-reverse-list-of-files' was set to t and the returned list will +reflect that. I.e. emacsclients first parameter will be the first one in the +returned list." +(let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files + param-list + (reverse param-list)))) + (trigger (car l)) + (len 0) + dir + ret) + (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger) + (setq dir (match-string 1 trigger)) + (setq len (length dir)) + (setcar l (concat dir (match-string 3 trigger)))) + (if strip-path + (progn + (dolist (e l ret) + (setq ret + (append ret + (list + (if (stringp e) + (if (stringp replacement) + (setq e (concat replacement (substring e len))) + (setq e (substring e len))) + e))))) + ret) + l))) + + +(defun org-protocol-flatten (l) + "Greedy handlers might recieve a list like this from emacsclient: + '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") +where \"/dir/\" is the absolute path to emacsclients working directory. This +function transforms it into a flat list." + (if (null l) () + (if (listp l) + (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) + (list l)))) + +;;; 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'. + +The location for a browser's bookmark has to look like this: + + javascript:location.href='org-protocol://store-link://'+ \\ + encodeURIComponent(location.href) + encodeURIComponent(document.title)+'/'+ \\ + +Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page +could contain slashes and the location definitely will. + +The sub-protocol used to reach this function is set in +`org-protocol-protocol-alist'." + (let* ((splitparts (org-protocol-split-data fname t)) + (uri (org-protocol-sanitize-uri (car splitparts))) + (title (cadr splitparts)) + orglink) + (if (boundp 'org-stored-links) + (setq org-stored-links (cons (list uri title) org-stored-links))) + (kill-new uri) + (message "`%s' to insert new org-link, `%s' to insert `%s'" + (substitute-command-keys"\\[org-insert-link]") + (substitute-command-keys"\\[yank]") + uri)) + nil) + + +(defun org-protocol-remember (info) + "Process an org-protocol://remember:// style url. + +The sub-protocol used to reach this function is set in +`org-protocol-protocol-alist'. + +This function detects an URL, title and optinal text, separated by '/' +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()) + +By default, it uses the character `org-protocol-default-template-key', +which should be associated with a template in `org-remember-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/'+ ... + +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 (cadr parts)) + (region (caddr parts)) + (orglink (org-make-link-string url title)) + 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.")) + nil) + + +(defun org-protocol-open-source (fname) + "Process an org-protocol://open-source:// style url. + +Change a filename by mapping URLs to local filenames as set +in `org-protocol-project-alist'. + +The location for a browser's bookmark should look like this: + + javascript:location.href='org-protocol://open-source://'+ \\ + encodeURIComponent(location.href)" + + ;; As we enter this function for a match on our protocol, the return value + ;; defaults to nil. + (let ((result nil) + (f (org-protocol-unhex-string fname))) + (catch 'result + (dolist (prolist org-protocol-project-alist) + (let* ((base-url (plist-get (cdr prolist) :base-url)) + (wsearch (regexp-quote base-url))) + + (when (string-match wsearch f) + (let* ((wdir (plist-get (cdr prolist) :working-directory)) + (strip-suffix (plist-get (cdr prolist) :online-suffix)) + (add-suffix (plist-get (cdr prolist) :working-suffix)) + (start-pos (+ (string-match wsearch f) (length base-url))) + (end-pos (string-match + (concat (regexp-quote strip-suffix) "\\([?#].*\\)?$") f)) + (the-file (concat wdir (substring f start-pos end-pos) add-suffix))) + (if (file-readable-p the-file) + (throw 'result the-file)) + (if (file-exists-p the-file) + (message "%s: permission denied!" the-file) + (message "%s: no such file or directory." the-file)))))) + result))) + + +;;; Core functions: + +(defun org-protocol-check-filename-for-protocol (fname restoffiles client) + "Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname. +Sub-protocols are registered in `org-protocol-protocol-alist' and +`org-protocol-protocol-alist-default'. +This is, how the matching is done: + + (string-match \"protocol:/+sub-protocol:/+\" ...) + +protocol and sub-protocol are regexp-quoted. + +If a matching protcol is found, the protcol 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. +If the function returns a non nil value, that value is passed to the server +as filename." + (let ((sub-protocols (append org-protocol-protocol-alist org-protocol-protocol-alist-default))) + (catch 'fname + (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+"))) + (when (string-match the-protocol fname) + (dolist (prolist sub-protocols) + (let ((proto (concat the-protocol (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+"))) + (when (string-match proto fname) + (let* ((func (plist-get (cdr prolist) :function)) + (greedy (plist-get (cdr prolist) :greedy)) + (splitted (split-string fname proto)) + (result (if greedy restoffiles (cadr splitted)))) + (when (plist-get (cdr prolist) :kill-client) + (message "Greedy org-protocol handler. Killing client.") + (server-edit)) + (when (fboundp func) + (unless greedy + (throw 'fname (funcall func result))) + (funcall func result) + (throw 'fname t)))))))) + ;; (message "fname: %s" fname) + fname))) + + +(defadvice server-visit-files (before org-protocol-detect-protocol-server activate) + "Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'." + (let ((flist (if org-protocol-reverse-list-of-files + (reverse (ad-get-arg 0)) + (ad-get-arg 0))) + (client (ad-get-arg 1))) + (catch 'greedy + (dolist (var flist) + (let ((fname (expand-file-name (car var)))) ;; `\' to `/' on windows. FIXME: could this be done any better? + (setq fname (org-protocol-check-filename-for-protocol fname (member var flist) client)) + (if (eq fname t) ;; greedy? We need the `t' return value. + (progn + (ad-set-arg 0 nil) + (throw 'greedy t)) + (if (stringp fname) ;; probably filename + (setcar var fname) + (ad-set-arg 0 (delq var (ad-get-arg 0)))))) + )))) + +;;; Org specific functions: + +(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 +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?" + (substitute-command-keys"\\[org-protocol-create]"))))) + + +(defun org-protocol-create(&optional project-plist) + "Create a new org-protocol project interactively. +An org-protocol project is an entry in `org-protocol-project-alist' +which is used by `org-protocol-open-source'. +Optionally use project-plist to initialize the defaults for this worglet. If +project-plist is the CDR of an element in `org-publish-project-alist', reuse +:base-directory, :html-extension and :base-extension." + (interactive) + (let ((working-dir (expand-file-name(or (plist-get project-plist :base-directory) default-directory))) + (base-url "http://orgmode.org/worg/") + (strip-suffix (or (plist-get project-plist :html-extension) ".html")) + (working-suffix (if (plist-get project-plist :base-extension) + (concat "." (plist-get project-plist :base-extension)) + ".org")) + + (worglet-buffer nil) + + (insert-default-directory t) + (minibuffer-allow-text-properties nil)) + + (setq base-url (read-string "Base URL of published content: " base-url nil base-url t)) + (if (not (string-match "\\/$" base-url)) + (setq base-url (concat base-url "/"))) + + (setq working-dir + (expand-file-name + (read-directory-name "Local working directory: " working-dir working-dir t))) + (if (not (string-match "\\/$" working-dir)) + (setq working-dir (concat working-dir "/"))) + + (setq strip-suffix + (read-string + (concat "Extension to strip from published URLs ("strip-suffix"): ") + strip-suffix nil strip-suffix t)) + + (setq working-suffix + (read-string + (concat "Extension of editable files ("working-suffix"): ") + working-suffix nil working-suffix t)) + + (when (yes-or-no-p "Save the new worglet to your init file? ") + (setq org-protocol-project-alist + (cons `(,base-url . (:base-url ,base-url + :working-directory ,working-dir + :online-suffix ,strip-suffix + :working-suffix ,working-suffix)) + org-protocol-project-alist)) + (customize-save-variable 'org-protocol-project-alist org-protocol-project-alist)))) + +(provide 'org-protocol) +;;; org-protocol.el ends here diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el index 843608cb82f..e6b0218b178 100644 --- a/lisp/org/org-publish.el +++ b/lisp/org/org-publish.el @@ -2,9 +2,9 @@ ;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc. ;; Author: David O'Toole <dto@gnu.org> -;; Maintainer: Bastien Guerry <bzg AT altern DOT org> +;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com> ;; Keywords: hypermedia, outlines, wp -;; Version: 6.21b +;; Version: 6.29c ;; This file is part of GNU Emacs. ;; @@ -28,120 +28,14 @@ ;; ;; org-publish.el can do the following: ;; -;; + Publish all one's org-files to HTML or LaTeX +;; + Publish all one's org-files to HTML or PDF ;; + Upload HTML, images, attachments and other files to a web server ;; + Exclude selected private pages from publishing ;; + Publish a clickable index of pages ;; + Manage local timestamps for publishing only changed files ;; + Accept plugin functions to extend range of publishable content ;; -;; Special thanks to the org-mode maintainer Carsten Dominik for his -;; ideas, enthusiasm, and cooperation. - -;;; Installation: - -;; Put org-publish.el in your load path, byte-compile it, and then add -;; the following lines to your emacs initialization file: - -;; (autoload 'org-publish "org-publish" nil t) -;; (autoload 'org-publish "org-publish-all" nil t) -;; (autoload 'org-publish "org-publish-current-file" nil t) -;; (autoload 'org-publish "org-publish-current-project" nil t) - -;; NOTE: When org-publish.el is included with org.el, those forms are -;; already in the file org-install.el, and hence don't need to be put -;; in your emacs initialization file in this case. - -;;; Usage: -;; -;; The program's main configuration variable is -;; `org-publish-project-alist'. See below for example configurations -;; with commentary. - -;; The main interactive functions are: -;; -;; M-x org-publish -;; M-x org-publish-all -;; M-x org-publish-current-file -;; M-x org-publish-current-project - -;;;; Simple example configuration: - -;; (setq org-publish-project-alist -;; (list -;; '("org" . (:base-directory "~/org/" -;; :base-extension "org" -;; :publishing-directory "~/public_html" -;; :with-section-numbers nil -;; :table-of-contents nil -;; :recursive t -;; :style "<link rel="stylesheet" href=\"../other/mystyle.css\" type=\"text/css\">"))) - -;;;; More complex example configuration: - -;; Imagine your *.org files are kept in ~/org, your images in -;; ~/images, and stylesheets in ~/other. Now imagine you want to -;; publish the files through an ssh connection to a remote host, via -;; Tramp-mode. To maintain relative links from *.org files to /images -;; and /other, we should replicate the same directory structure in -;; your web server account's designated html root (in this case, -;; assumed to be ~/html) - -;; Once you've done created the proper directories, you can adapt the -;; following example configuration to your specific paths, run M-x -;; org-publish-all, and it should publish the files to the correct -;; directories on the web server, transforming the *.org files into -;; HTML, and leaving other files alone. - -;; (setq org-publish-project-alist -;; (list -;; '("orgfiles" :base-directory "~/org/" -;; :base-extension "org" -;; :publishing-directory "/ssh:user@host:~/html/notebook/" -;; :publishing-function org-publish-org-to-html -;; :exclude "PrivatePage.org" ;; regexp -;; :headline-levels 3 -;; :with-section-numbers nil -;; :table-of-contents nil -;; :style "<link rel="stylesheet" href=\"../other/mystyle.css\" type=\"text/css\">" -;; :auto-preamble t -;; :auto-postamble nil) -;; ("images" :base-directory "~/images/" -;; :base-extension "jpg\\|gif\\|png" -;; :publishing-directory "/ssh:user@host:~/html/images/" -;; :publishing-function org-publish-attachment) -;; ("other" :base-directory "~/other/" -;; :base-extension "css" -;; :publishing-directory "/ssh:user@host:~/html/other/" -;; :publishing-function org-publish-attachment) -;; ("website" :components ("orgfiles" "images" "other")))) - -;; For more information, see the documentation for the variable -;; `org-publish-project-alist'. - -;; Of course, you don't have to publish to remote directories from -;; within emacs. You can always just publish to local folders, and -;; then use the synchronization/upload tool of your choice. - -;;; List of user-visible changes since version 1.27 - -;; 1.78: Allow list-valued :publishing-function -;; 1.77: Added :preparation-function, this allows you to use GNU Make etc. -;; 1.65: Remove old "composite projects". They're redundant. -;; 1.64: Allow meta-projects with :components -;; 1.57: Timestamps flag is now called "org-publish-use-timestamps-flag" -;; 1.52: Properly set default for :index-filename -;; 1.48: Composite projects allowed. -;; :include keyword allowed. -;; 1.43: Index no longer includes itself in the index. -;; 1.42: Fix "function definition is void" error -;; when :publishing-function not set in org-publish-current-file. -;; 1.41: Fixed bug where index isn't published on first try. -;; 1.37: Added interactive function "org-publish". Prompts for particular -;; project name to publish. -;; 1.34: Added force-publish option to all interactive functions. -;; 1.32: Fixed "index.org has changed on disk" error during index publishing. -;; 1.30: Fixed startup error caused by (require 'em-unix) +;; Documentation for publishing is in the manual. ;;; Code: @@ -256,7 +150,7 @@ index of files or summary page for a given project. :auto-index Whether to publish an index during `org-publish-current-project' or `org-publish-all'. :index-filename Filename for output of index. Defaults - to 'index.org' (which becomes 'index.html'). + to 'sitemap.org' (which becomes 'sitemap.html'). :index-title Title of index page. Defaults to name of file. :index-function Plugin function to use for generation of index. Defaults to `org-publish-org-index', which @@ -282,30 +176,41 @@ When nil, do no timestamp checking and always publish all files." :group 'org-publish :type 'directory) +(defcustom org-publish-list-skipped-files t + "Non-nil means, show message about files *not* published." + :group 'org-publish + :type 'boolean) + (defcustom org-publish-before-export-hook nil "Hook run before export on the Org file. -If the functions in this hook modify the original Org buffer, the -modified buffer will be used for export, but the buffer will be -restored and saved back to its initial state after export." +The hook may modify the file in arbitrary ways before publishing happens. +The orgiginal version of the buffer will be restored after publishing." :group 'org-publish :type 'hook) (defcustom org-publish-after-export-hook nil "Hook run after export on the exported buffer. -If functions in this hook modify the buffer, it will be saved." +Any changes made by this hook will be saved." :group 'org-publish :type 'hook) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Timestamp-related functions -(defun org-publish-timestamp-filename (filename) +(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func) "Return path to timestamp file for filename FILENAME." + (setq filename (concat filename "::" (or pub-dir "") "::" + (format "%s" (or pub-func "")))) (concat (file-name-as-directory org-publish-timestamp-directory) "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) -(defun org-publish-needed-p (filename) - "Return `t' if FILENAME should be published." +(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 +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) @@ -315,20 +220,23 @@ If functions in this hook modify the buffer, it will be saved." org-publish-timestamp-directory) ;; there is a timestamp, check if FILENAME is newer (file-newer-than-file-p - filename (org-publish-timestamp-filename filename))) + filename (org-publish-timestamp-filename + filename pub-dir pub-func))) (make-directory org-publish-timestamp-directory) t) ;; don't use timestamps, always return t t))) (if rtn - (message "Publishing file %s" filename) - (message "Skipping unmodified file %s" filename)) + (message "Publishing file %s using `%s'" filename pub-func) + (when org-publish-list-skipped-files + (message "Skipping unmodified file %s" filename))) rtn)) -(defun org-publish-update-timestamp (filename) +(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)) + (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 @@ -340,7 +248,16 @@ If there is no timestamp, create one." (if (and (fboundp 'set-file-times) (not newly-created-timestamp)) (set-file-times timestamp-file) - (call-process "touch" nil 0 nil timestamp-file)))) + (call-process "touch" nil 0 nil (expand-file-name timestamp-file))))) + +(defun org-publish-remove-all-timestamps () + "Remove all files in the timstamp 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 "[^.]\\'"))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Mapping files to project names @@ -454,7 +371,9 @@ matching filenames." (include-list (plist-get project-plist :include)) (recurse (plist-get project-plist :recursive)) (extension (or (plist-get project-plist :base-extension) "org")) - (match (concat "^[^\\.].*\\.\\(" extension "\\)$"))) + (match (if (eq extension 'any) + "^[^\\.]" + (concat "^[^\\.].*\\.\\(" extension "\\)$")))) (setq org-publish-temp-files nil) (org-publish-get-base-files-1 base-dir recurse match ;; FIXME distinguish exclude regexp @@ -467,13 +386,14 @@ matching filenames." include-list) org-publish-temp-files)) -(defun org-publish-get-project-from-filename (filename) +(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)))) - (dolist (prj org-publish-project-alist) - (if (member project-name (plist-get (cdr prj) :components)) - (setq project-name (car prj)))) + (when up + (dolist (prj org-publish-project-alist) + (if (member project-name (plist-get (cdr prj) :components)) + (setq project-name (car prj))))) (assoc project-name org-publish-project-alist))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -534,54 +454,67 @@ See `org-publish-org-to' to the list of arguments." See `org-publish-org-to' to the list of arguments." (org-publish-org-to "html" plist filename pub-dir)) +(defun org-publish-org-to-org (plist filename pub-dir) + "Publish an org file to HTML. +See `org-publish-org-to' to the list of arguments." + (org-publish-org-to "org" plist filename pub-dir)) + (defun org-publish-attachment (plist filename pub-dir) "Publish a file with no transformation of any kind. See `org-publish-org-to' to the list of arguments." ;; make sure eshell/cp code is loaded (unless (file-directory-p pub-dir) (make-directory pub-dir t)) - (copy-file filename pub-dir t)) + (or (equal (expand-file-name (file-name-directory filename)) + (file-name-as-directory (expand-file-name pub-dir))) + (copy-file filename + (expand-file-name (file-name-nondirectory filename) pub-dir) + t))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Publishing files, sets of files, and indices (defun org-publish-file (filename &optional project) "Publish file FILENAME from PROJECT." - (when (org-publish-needed-p filename) - (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"))))) - (project-plist (cdr project)) - (ftname (file-truename filename)) - (publishing-function - (or (plist-get project-plist :publishing-function) - 'org-publish-org-to-html)) - (base-dir (file-name-as-directory - (file-truename (plist-get project-plist :base-directory)))) - (pub-dir (file-name-as-directory - (file-truename (plist-get project-plist :publishing-directory)))) - tmp-pub-dir) - (setq tmp-pub-dir - (file-name-directory - (concat pub-dir - (and (string-match (regexp-quote base-dir) ftname) - (substring ftname (match-end 0)))))) - (if (listp publishing-function) - ;; allow chain of publishing functions - (mapc (lambda (f) - (funcall f project-plist filename tmp-pub-dir)) - publishing-function) - (funcall publishing-function project-plist filename tmp-pub-dir))) - (org-publish-update-timestamp filename))) + (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"))))) + (project-plist (cdr project)) + (ftname (file-truename filename)) + (publishing-function + (or (plist-get project-plist :publishing-function) + 'org-publish-org-to-html)) + (base-dir (file-name-as-directory + (file-truename (plist-get project-plist :base-directory)))) + (pub-dir (file-name-as-directory + (file-truename (plist-get project-plist :publishing-directory)))) + tmp-pub-dir) + (setq tmp-pub-dir + (file-name-directory + (concat pub-dir + (and (string-match (regexp-quote base-dir) ftname) + (substring ftname (match-end 0)))))) + (if (listp publishing-function) + ;; allow chain of publishing functions + (mapc (lambda (f) + (when (org-publish-needed-p filename pub-dir f tmp-pub-dir) + (funcall f project-plist filename tmp-pub-dir) + (org-publish-update-timestamp filename pub-dir f))) + publishing-function) + (when (org-publish-needed-p filename pub-dir publishing-function + tmp-pub-dir) + (funcall publishing-function project-plist filename tmp-pub-dir) + (org-publish-update-timestamp + filename pub-dir publishing-function))))) (defun org-publish-projects (projects) "Publish all files belonging to the PROJECTS alist. @@ -593,7 +526,7 @@ If :auto-index is set, publish the index too." (exclude-regexp (plist-get project-plist :exclude)) (index-p (plist-get project-plist :auto-index)) (index-filename (or (plist-get project-plist :index-filename) - "index.org")) + "sitemap.org")) (index-function (or (plist-get project-plist :index-function) 'org-publish-org-index)) (preparation-function (plist-get project-plist :preparation-function)) @@ -609,7 +542,7 @@ If :auto-index is set, publish the index too." (defun org-publish-org-index (project &optional index-filename) "Create an index of pages in set defined by PROJECT. Optionally set the filename of the index with INDEX-FILENAME. -Default for INDEX-FILENAME is 'index.org'." +Default for INDEX-FILENAME is 'sitemap.org'." (let* ((project-plist (cdr project)) (dir (file-name-as-directory (plist-get project-plist :base-directory))) @@ -617,7 +550,7 @@ Default for INDEX-FILENAME is 'index.org'." (indent-str (make-string 2 ?\ )) (exclude-regexp (plist-get project-plist :exclude)) (files (nreverse (org-publish-get-base-files project exclude-regexp))) - (index-filename (concat dir (or index-filename "index.org"))) + (index-filename (concat dir (or index-filename "sitemap.org"))) (index-title (or (plist-get project-plist :index-title) (concat "Index for project " (car project)))) (index-style (or (plist-get project-plist :index-style) @@ -697,24 +630,27 @@ Default for INDEX-FILENAME is 'index.org'." ;;;###autoload (defun org-publish (project &optional force) "Publish PROJECT." - (interactive "P") + (interactive + (list + (assoc (org-ido-completing-read + "Publish project: " + org-publish-project-alist nil t) + org-publish-project-alist) + current-prefix-arg)) (setq org-publish-initial-buffer (current-buffer)) (save-window-excursion - (let* ((force current-prefix-arg) - (org-publish-use-timestamps-flag + (let* ((org-publish-use-timestamps-flag (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects - (list (or project - (assoc (org-ido-completing-read - "Publish project: " - org-publish-project-alist nil t) - org-publish-project-alist))))))) + (org-publish-projects (list project))))) ;;;###autoload (defun org-publish-all (&optional force) "Publish all projects. -With prefix argument, force publish all files." +With prefix argument, remove all files in the timestamp +directory and force publishing all files." (interactive "P") + (when force + (org-publish-remove-all-timestamps)) (org-publish-initialize-files-alist) (save-window-excursion (let ((org-publish-use-timestamps-flag @@ -740,7 +676,7 @@ the project." (interactive "P") (org-publish-initialize-files-alist) (save-window-excursion - (let ((project (org-publish-get-project-from-filename (buffer-file-name))) + (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) diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el index d2dcedfeb5c..4bc1bf67d84 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -186,9 +186,10 @@ calendar | %:type %:date" (const :tag "Use `org-default-notes-file'" nil)) (choice :tag "Destin. headline" (string :tag "Specify") + (function :tag "Function") (const :tag "Use `org-remember-default-headline'" nil) - (const :tag "Level 1 at beginning of file" top) - (const :tag "Level 1 at end of file" bottom)) + (const :tag "At beginning of file" top) + (const :tag "At end of file" bottom)) (choice :tag "Context" (const :tag "Use in all contexts" nil) (const :tag "Use in all contexts" t) @@ -196,6 +197,11 @@ calendar | %:type %:date" (symbol :tag "Major mode")) (function :tag "Perform a check against function"))))) +(defcustom org-remember-delete-empty-lines-at-end t + "Non-nil means clean up final empty lines in remember buffer." + :group 'org-remember + :type 'boolean) + (defcustom org-remember-before-finalize-hook nil "Hook that is run right before a remember process is finalized. The remember buffer is still current when this hook runs." @@ -228,6 +234,27 @@ user each time a remember buffer with a running clock is filed away. " (const :tag "Always" t) (const :tag "Query user" query))) +(defcustom org-remember-backup-directory nil + "Directory where to store all remember buffers, for backup purposes. +After a remember buffer has been stored successfully, the backup file +will be removed. However, if you forget to finish the remember process, +the file will remain there. +See also `org-remember-auto-remove-backup-files'." + :group 'org-remember + :type '(choice + (const :tag "No backups" nil) + (directory :tag "Directory"))) + +(defcustom org-remember-auto-remove-backup-files t + "Non-nil means, remove remember backup files after successfully storage. +When remember is finished successfully, with storing the note at the +desired target, remove the backup files related to this remember process +and show a message about remaining backup files, from previous, unfinished +remember sessions. +Backup files will only be made at all, when `org-remember-backup-directory' +is set." + :group 'org-remember + :type 'boolean) (defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' (defvar initial) ; from remember.el, dynamically scoped in `remember-mode' @@ -297,6 +324,7 @@ RET at beg-of-buf -> Append to file as level 2 headline (append (list (nth 1 x) (car x)) (cddr x)) (append (list (car x) "") (cdr x)))) (delq nil pre-selected-templates2))) + msg (char (or use-char (cond ((= (length templates) 1) @@ -307,22 +335,32 @@ RET at beg-of-buf -> Append to file as level 2 headline (string-to-char org-force-remember-template-char) org-force-remember-template-char)) (t - (message "Select template: %s" - (mapconcat - (lambda (x) - (cond - ((not (string-match "\\S-" (nth 1 x))) - (format "[%c]" (car x))) - ((equal (downcase (car x)) - (downcase (aref (nth 1 x) 0))) - (format "[%c]%s" (car x) - (substring (nth 1 x) 1))) - (t (format "[%c]%s" (car x) (nth 1 x))))) - templates " ")) - (let ((inhibit-quit t) (char0 (read-char-exclusive))) + (setq msg (format + "Select template: %s" + (mapconcat + (lambda (x) + (cond + ((not (string-match "\\S-" (nth 1 x))) + (format "[%c]" (car x))) + ((equal (downcase (car x)) + (downcase (aref (nth 1 x) 0))) + (format "[%c]%s" (car x) + (substring (nth 1 x) 1))) + (t (format "[%c]%s" (car x) (nth 1 x))))) + templates " "))) + (let ((inhibit-quit t) char0) + (while (not char0) + (message msg) + (setq char0 (read-char-exclusive)) + (when (and (not (assoc char0 templates)) + (not (equal char0 ?\C-g))) + (message "No such template \"%c\"" char0) + (ding) (sit-for 1) + (setq char0 nil))) (when (equal char0 ?\C-g) (jump-to-register remember-register) - (kill-buffer remember-buffer)) + (kill-buffer remember-buffer) + (error "Abort")) char0)))))) (cddr (assoc char templates))))) @@ -365,11 +403,16 @@ to be run from that hook to function properly." (v-T (format-time-string (cdr org-time-stamp-formats) ct)) (v-u (concat "[" (substring v-t 1 -1) "]")) (v-U (concat "[" (substring v-T 1 -1) "]")) - ;; `initial' and `annotation' are bound in `remember' - (v-i (if (boundp 'initial) initial)) - (v-a (if (and (boundp 'annotation) annotation) - (if (equal annotation "[[]]") "" annotation) - "")) + ;; `initial' and `annotation' are bound in `remember'. + ;; But if the property list has them, we prefer those values + (v-i (or (plist-get org-store-link-plist :initial) + (and (boundp 'initial) initial) + "")) + (v-a (or (plist-get org-store-link-plist :annotation) + (and (boundp 'annotation) 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) @@ -394,13 +437,16 @@ to be run from that hook to function properly." (when (functionp file) (setq file (funcall file))) + (when (functionp headline) + (setq headline (funcall headline))) (when (and file (not (file-name-absolute-p file))) (setq file (expand-file-name file org-directory))) - (setq org-store-link-plist - (append (list :annotation v-a :initial v-i) - org-store-link-plist)) + (plist-put org-store-link-plist :annotation v-a) + org-store-link-plist + (plist-put org-store-link-plist :initial v-i)) + (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1)) (erase-buffer) (insert (substitute-command-keys @@ -551,7 +597,7 @@ to be run from that hook to function properly." nil nil (list org-end-time-was-given))) (t (let (org-completion-use-ido) - (insert (org-completing-read + (insert (org-completing-read-no-ido (concat (if prompt prompt "Enter string") (if default (concat " [" default "]")) ": ") @@ -566,6 +612,17 @@ to be run from that hook to function properly." (re-search-forward "%&" nil t)) (replace-match "") (org-set-local 'org-jump-to-target-location t)) + (when org-remember-backup-directory + (unless (file-directory-p org-remember-backup-directory) + (make-directory org-remember-backup-directory)) + (org-set-local 'auto-save-file-name-transforms nil) + (setq buffer-file-name + (expand-file-name + (format-time-string "remember-%Y-%m-%d-%H-%M-%S") + org-remember-backup-directory)) + (save-buffer) + (org-set-local 'auto-save-visited-file-name t) + (auto-save-mode 1)) (when (save-excursion (goto-char (point-min)) (re-search-forward "%!" nil t)) @@ -612,8 +669,7 @@ from that hook." (y-or-n-p "The clock is running in this buffer. Clock out now? ")))) (let (org-log-note-clock-out) (org-clock-out)))) (when buffer-file-name - (save-buffer) - (setq buffer-file-name nil)) + (do-auto-save)) (remember-finalize)) (defun org-remember-kill () @@ -695,6 +751,8 @@ The user is queried for the template." (goto-char (match-beginning 0)) (error "Target headline not found: %s" heading)))) +;; FIXME (bzg): let's clean up of final empty lines happen only once +;; (see the org-remember-delete-empty-lines-at-end option below) ;;;###autoload (defun org-remember-handler () "Store stuff from remember.el into an org file. @@ -738,14 +796,33 @@ See also the variable `org-reverse-note-order'." (goto-char (point-min)) (while (looking-at "^[ \t]*\n\\|^##.*\n") (replace-match "")) - (goto-char (point-max)) - (beginning-of-line 1) - (while (looking-at "[ \t]*$\\|##.*") - (delete-region (1- (point)) (point-max)) - (beginning-of-line 1)) + (when org-remember-delete-empty-lines-at-end + (goto-char (point-max)) + (beginning-of-line 1) + (while (and (looking-at "[ \t]*$\\|##.*") (> (point) 1)) + (delete-region (1- (point)) (point-max)) + (beginning-of-line 1))) (catch 'quit - (if org-note-abort (throw 'quit nil)) + (if org-note-abort (throw 'quit t)) (let* ((visitp (org-bound-and-true-p org-jump-to-target-location)) + (backup-file + (and buffer-file-name + (equal (file-name-directory buffer-file-name) + (file-name-as-directory + (expand-file-name org-remember-backup-directory))) + (string-match "^remember-[0-9]\\{4\\}" + (file-name-nondirectory buffer-file-name)) + buffer-file-name)) + + (dummy + (unless (string-match "\\S-" (buffer-string)) + (message "Nothing to remember") + (and backup-file + (ignore-errors + (delete-file backup-file) + (delete-file (concat backup-file "~")))) + (set-buffer-modified-p nil) + (throw 'quit t))) (previousp (and (member current-prefix-arg '((16) 0)) org-remember-previous-location)) (clockp (equal current-prefix-arg 2)) @@ -763,7 +840,7 @@ See also the variable `org-reverse-note-order'." (org-startup-folded nil) (org-startup-align-all-tables nil) (org-goto-start-pos 1) - spos exitcmd level reversed txt) + spos exitcmd level reversed txt text-before-node-creation) (when (equal current-prefix-arg '(4)) (setq visitp t)) (when previousp @@ -779,27 +856,32 @@ See also the variable `org-reverse-note-order'." (setq current-prefix-arg nil) ;; Modify text so that it becomes a nice subtree which can be inserted ;; into an org tree. - (goto-char (point-min)) - (if (re-search-forward "[ \t\n]+\\'" nil t) - ;; remove empty lines at end - (replace-match "")) + (when org-remember-delete-empty-lines-at-end + (goto-char (point-min)) + (if (re-search-forward "[ \t\n]+\\'" nil t) + ;; remove empty lines at end + (replace-match ""))) (goto-char (point-min)) (unless (looking-at org-outline-regexp) ;; add a headline + (setq text-before-node-creation (buffer-string)) (insert (concat "* " (current-time-string) " (" (remember-buffer-desc) ")\n")) (backward-char 1) (when org-adapt-indentation (while (re-search-forward "^" nil t) (insert " ")))) - (goto-char (point-min)) - (if (re-search-forward "\n[ \t]*\n[ \t\n]*\\'" nil t) - (replace-match "\n\n") - (if (re-search-forward "[ \t\n]*\\'") - (replace-match "\n"))) + ;; Delete final empty lines + (when org-remember-delete-empty-lines-at-end + (goto-char (point-min)) + (if (re-search-forward "\n[ \t]*\n[ \t\n]*\\'" nil t) + (replace-match "\n\n") + (if (re-search-forward "[ \t\n]*\\'") + (replace-match "\n")))) (goto-char (point-min)) (setq txt (buffer-string)) (org-save-markers-in-region (point-min) (point-max)) + (set-buffer-modified-p nil) (when (and (eq org-remember-interactive-interface 'refile) (not fastp)) (org-refile nil (or visiting (find-file-noselect file))) @@ -811,20 +893,26 @@ See also the variable `org-reverse-note-order'." (throw 'quit t)) ;; Find the file (with-current-buffer (or visiting (find-file-noselect file)) - (unless (org-mode-p) - (error "Target files for remember notes must be in Org-mode")) + (unless (or (org-mode-p) (member heading '(top bottom))) + (error "Target files for notes must be in Org-mode if not filing to top/bottom")) (save-excursion (save-restriction (widen) - (and (goto-char (point-min)) - (not (re-search-forward "^\\* " nil t)) - (insert "\n* " (or (and (stringp heading) heading) - "Notes") "\n")) (setq reversed (org-notes-order-reversed-p)) ;; Find the default location (when heading (cond + ((not (org-mode-p)) + (if (eq heading 'top) + (goto-char (point-min)) + (goto-char (point-max)) + (or (bolp) (newline))) + (insert text-before-node-creation) + (when remember-save-after-remembering + (save-buffer) + (if (not visiting) (kill-buffer (current-buffer)))) + (throw 'quit t)) ((eq heading 'top) (goto-char (point-min)) (or (looking-at org-outline-regexp) @@ -951,7 +1039,21 @@ See also the variable `org-reverse-note-order'." (if (and (not visiting) (not (equal (marker-buffer org-clock-marker) (current-buffer)))) - (kill-buffer (current-buffer))))))))) + (kill-buffer (current-buffer)))) + (when org-remember-auto-remove-backup-files + (when backup-file + (ignore-errors + (delete-file backup-file) + (delete-file (concat backup-file "~")))) + (when org-remember-backup-directory + (let ((n (length + (directory-files + org-remember-backup-directory nil + "^remember-.*[0-9]$")))) + (when (> n 0) + (message + "%d backup files (unfinished remember calls) in %s" + n org-remember-backup-directory)))))))))) t) ;; return t to indicate that we took care of this note. @@ -995,3 +1097,4 @@ See also the variable `org-reverse-note-order'." ;; arch-tag: 497f30d0-4bc3-4097-8622-2d27ac5f2698 ;;; org-remember.el ends here + diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el index aed410f3d01..101b0026dd7 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -36,11 +36,8 @@ ;; Declare external functions and variables (declare-function rmail-show-message "rmail" (&optional n no-summary)) -(declare-function rmail-get-header "rmail" (name &optional msgnum)) (declare-function rmail-what-message "rmail" ()) (defvar rmail-current-message) -(defvar rmail-buffer) -(defvar rmail-view-buffer) ;; Install the link type (org-add-link-type "rmail" 'org-rmail-open) @@ -49,35 +46,29 @@ ;; Implementation (defun org-rmail-store-link () "Store a link to an Rmail folder or message." - (when (memq major-mode '(rmail-mode rmail-summary-mode)) - (let (message-id from to subject desc link) - (if (fboundp 'rmail-get-header) ; Emacs 23 - (setq message-id (rmail-get-header "message-id") - from (rmail-get-header "from") - to (rmail-get-header "to") - subject (rmail-get-header "subject")) - (save-window-excursion ; Emacs 22 - (save-restriction - (when (eq major-mode 'rmail-summary-mode) - (rmail-show-message rmail-current-message)) - (with-no-warnings ; don't warn when compiling Emacs 23 - (rmail-narrow-to-non-pruned-header)) - (setq message-id (mail-fetch-field "message-id") - from (mail-fetch-field "from") - to (mail-fetch-field "to") - subject (mail-fetch-field "subject")) - (rmail-show-message rmail-current-message)))) - (org-store-link-props - :type "rmail" :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 "rmail:" - (with-current-buffer rmail-buffer - buffer-file-name) - "#" message-id)) - (org-add-link-props :link link :description desc) - link))) + (when (or (eq major-mode 'rmail-mode) + (eq major-mode 'rmail-summary-mode)) + (save-window-excursion + (save-restriction + (when (eq major-mode 'rmail-summary-mode) + (rmail-show-message rmail-current-message)) + (when (fboundp 'rmail-narrow-to-non-pruned-header) + (rmail-narrow-to-non-pruned-header)) + (let* ((folder buffer-file-name) + (message-id (mail-fetch-field "message-id")) + (from (mail-fetch-field "from")) + (to (mail-fetch-field "to")) + (subject (mail-fetch-field "subject")) + desc link) + (org-store-link-props + :type "rmail" :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 "rmail:" folder "#" message-id)) + (org-add-link-props :link link :description desc) + (rmail-show-message rmail-current-message) + link))))) (defun org-rmail-open (path) "Follow an Rmail message link to the specified PATH." @@ -92,27 +83,19 @@ "Follow an Rmail link to FOLDER and ARTICLE." (require 'rmail) (setq article (org-add-angle-brackets article)) - (let (message-number buff) + (let (message-number) (save-excursion (save-window-excursion (rmail (if (string= folder "RMAIL") rmail-file-name folder)) - (setq buff (current-buffer) - message-number - (with-current-buffer - (if (and (fboundp 'rmail-buffers-swapped-p) - (rmail-buffers-swapped-p)) - rmail-view-buffer - (current-buffer)) - (save-restriction - (widen) - (goto-char (point-max)) - (if (re-search-backward - (concat "^Message-ID:\\s-+" (regexp-quote - (or article ""))) - nil t) - ;; This is an rmail "debugging" function. :( - (with-current-buffer buff - (rmail-what-message)))))))) + (setq message-number + (save-restriction + (widen) + (goto-char (point-max)) + (if (re-search-backward + (concat "^Message-ID:\\s-+" (regexp-quote + (or article ""))) + nil t) + (rmail-what-message)))))) (if message-number (progn (rmail (if (string= folder "RMAIL") rmail-file-name folder)) diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el new file mode 100644 index 00000000000..8017d689db7 --- /dev/null +++ b/lisp/org/org-src.el @@ -0,0 +1,471 @@ +;;; org-src.el --- Source code examples in Org +;; +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Bastien Guerry <bzg AT altern DOT org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.29c +;; +;; 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 the code dealing with source code examples in Org-mode. + +;;; Code: + +(require 'org-macs) +(require 'org-compat) + +(declare-function org-do-remove-indentation "org" (&optional n)) +(declare-function org-get-indentation "org" (&optional line)) + +(defcustom org-edit-src-region-extra nil + "Additional regexps to identify regions for editing with `org-edit-src-code'. +For examples see the function `org-edit-src-find-region-and-lang'. +The regular expression identifying the begin marker should end with a newline, +and the regexp marking the end line should start with a newline, to make sure +there are kept outside the narrowed region." + :group 'org-edit-structure + :type '(repeat + (list + (regexp :tag "begin regexp") + (regexp :tag "end regexp") + (choice :tag "language" + (string :tag "specify") + (integer :tag "from match group") + (const :tag "from `lang' element") + (const :tag "from `style' element"))))) + +(defcustom org-coderef-label-format "(ref:%s)" + "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 + +#+BEGIN_SRC pascal +n -r -l \"((%s))\" +... +#+END_SRC + +If you want to use this for HTML export, make sure that the format does +not introduce special font-locking, and avoid the HTML special +characters `<', `>', and `&'. The reason for this restriction is that +the labels are searched for only after htmlize has done its job." + :group 'org-edit-structure ; FIXME this is not in the right group + :type 'string) + +(defcustom org-edit-fixed-width-region-mode 'artist-mode + "The mode that should be used to edit fixed-width regions. +These are the regions where each line starts with a colon." + :group 'org-edit-structure + :type '(choice + (const artist-mode) + (const picture-mode) + (const fundamental-mode) + (function :tag "Other (specify)"))) + +(defcustom org-edit-src-content-indentation 2 + "Indentation for the content is 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]." + :group 'org-edit-structure + :type 'integer) + +(defcustom org-edit-src-persistent-message t + "Non-nil means show persistent exit help message while editing src examples. +The message is shown in the header-line, which will be created in the +first line of the window showing the editing buffer. +When nil, the message will only be shown intermittently in the echo area." + :group 'org-edit-structure + :type 'boolean) + + +(defvar org-src-mode-hook nil + "Hook run after Org switched a source code snippet to its Emacs mode. +This hook will run + +- when editing a source code snippet with \"C-c '\". +- When formatting a source code snippet for export with htmlize. + +You may want to use this hook for example to turn off `outline-minor-mode' +or similar things which you want to have when editing a source code file, +but which mess up the display of a snippet in Org exported files.") + +;;; Editing source examples + +(defvar org-src-mode-map (make-sparse-keymap)) +(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) +(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save) +(defvar org-edit-src-force-single-line nil) +(defvar org-edit-src-from-org-mode nil) +(defvar org-edit-src-picture nil) +(defvar org-edit-src-beg-marker nil) +(defvar org-edit-src-end-marker nil) +(defvar org-edit-src-overlay nil) +(defvar org-edit-src-nindent nil) + +(define-minor-mode org-src-mode + "Minor mode for language major mode buffers generated by org. +This minor mode is turned on in two situations: +- when editing a source code snippet with \"C-c '\". +- When formatting a source code snippet for export with htmlize. +There is a mode hook, and keybindings for `org-edit-src-exit' and +`org-edit-src-save'") + +(defun org-edit-src-code () + "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]. +This will remove the original code in the Org buffer, and replace it with +the edited version." + (interactive) + (let ((line (org-current-line)) + (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)) + nindent ovl lang lang-f single lfmt code begline buffer) + (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) + lang (nth 2 info) + single (nth 3 info) + lfmt (nth 4 info) + nindent (nth 5 info) + lang-f (intern (concat lang "-mode")) + begline (save-excursion (goto-char beg) (org-current-line))) + (unless (functionp lang-f) + (error "No such language mode: %s" lang-f)) + (goto-line line) + (if (and (setq buffer (org-edit-src-find-buffer beg end)) + (y-or-n-p "Return to existing edit buffer? [n] will revert changes: ")) + (switch-to-buffer buffer) + (when buffer + (with-current-buffer buffer + (if (boundp 'org-edit-src-overlay) + (org-delete-overlay org-edit-src-overlay))) + (kill-buffer buffer)) + (setq buffer (generate-new-buffer "*Org Edit Src Example*")) + (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 + '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") + (switch-to-buffer buffer) + (insert code) + (remove-text-properties (point-min) (point-max) + '(display nil invisible nil intangible nil)) + (org-do-remove-indentation) + (let ((org-inhibit-startup t)) + (funcall lang-f) + (org-src-mode)) + (set (make-local-variable 'org-edit-src-force-single-line) single) + (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) + (when lfmt + (set (make-local-variable 'org-coderef-label-format) lfmt)) + (when org-mode-p + (goto-char (point-min)) + (while (re-search-forward "^," nil t) + (replace-match ""))) + (goto-line (1+ (- line begline))) + (org-set-local 'org-edit-src-beg-marker beg) + (org-set-local 'org-edit-src-end-marker end) + (org-set-local 'org-edit-src-overlay ovl) + (org-set-local 'org-edit-src-nindent nindent) + (and org-edit-src-persistent-message + (org-set-local 'header-line-format msg))) + (message "%s" msg) + t))) + +(defun org-edit-src-continue (e) + (interactive "e") + (mouse-set-point e) + (let ((buf (get-char-property (point) 'edit-buffer))) + (if buf (switch-to-buffer buf) + (error "Something is wrong here")))) + +(defun org-edit-src-find-buffer (beg end) + "Find a source editing buffer that is already editing the region BEG to END." + (catch 'exit + (mapc + (lambda (b) + (with-current-buffer b + (if (and (string-match "\\`*Org Edit " (buffer-name)) + (local-variable-p 'org-edit-src-beg-marker (current-buffer)) + (local-variable-p 'org-edit-src-end-marker (current-buffer)) + (equal beg org-edit-src-beg-marker) + (equal end org-edit-src-end-marker)) + (throw 'exit (current-buffer))))) + (buffer-list)) + nil)) + +(defun org-edit-fixed-width-region () + "Edit the fixed-width ascii drawing at point. +This must be a region where each line starts with a colon followed by +a space character. +An new buffer is created and the fixed-width region is copied into it, +and the buffer is switched into `artist-mode' for editing. When done, +exit with \\[org-edit-src-exit]. The edited text will then replace +the fragment in the Org-mode buffer." + (interactive) + (let ((line (org-current-line)) + (case-fold-search t) + (msg (substitute-command-keys + "Edit, then exit with C-c ' (C-c and single quote)")) + (org-mode-p (eq major-mode 'org-mode)) + (beg (make-marker)) + (end (make-marker)) + nindent ovl beg1 end1 code begline buffer) + (beginning-of-line 1) + (if (looking-at "[ \t]*[^:\n \t]") + nil + (if (looking-at "[ \t]*\\(\n\\|\\'\\)") + (setq beg1 (point) end1 beg1) + (save-excursion + (if (re-search-backward "^[ \t]*[^: \t]" nil 'move) + (setq beg1 (point-at-bol 2)) + (setq beg1 (point)))) + (save-excursion + (if (re-search-forward "^[ \t]*[^: \t]" nil 'move) + (setq end1 (1- (match-beginning 0))) + (setq end1 (point)))) + (goto-line line)) + (setq beg (move-marker beg beg1) + end (move-marker end end1) + code (buffer-substring-no-properties beg end) + begline (save-excursion (goto-char beg) (org-current-line))) + (if (and (setq buffer (org-edit-src-find-buffer beg end)) + (y-or-n-p "Return to existing edit buffer? [n] will revert changes: ")) + (switch-to-buffer buffer) + (when buffer + (with-current-buffer buffer + (if (boundp 'org-edit-src-overlay) + (org-delete-overlay org-edit-src-overlay))) + (kill-buffer buffer)) + (setq buffer (generate-new-buffer "*Org Edit Src Example*")) + (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 + '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") + (switch-to-buffer buffer) + (insert code) + (remove-text-properties (point-min) (point-max) + '(display nil invisible nil intangible nil)) + (setq nindent (org-do-remove-indentation)) + (cond + ((eq org-edit-fixed-width-region-mode 'artist-mode) + (fundamental-mode) + (artist-mode 1)) + (t (funcall org-edit-fixed-width-region-mode))) + (set (make-local-variable 'org-edit-src-force-single-line) nil) + (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) + (set (make-local-variable 'org-edit-src-picture) t) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*: ?" nil t) + (replace-match "")) + (goto-line (1+ (- line begline))) + (org-src-mode) + (org-set-local 'org-edit-src-beg-marker beg) + (org-set-local 'org-edit-src-end-marker end) + (org-set-local 'org-edit-src-overlay ovl) + (org-set-local 'org-edit-src-nindent nindent) + (and org-edit-src-persistent-message + (org-set-local 'header-line-format msg))) + (message "%s" msg) + t))) + +(defun org-edit-src-find-region-and-lang () + "Find the region and language for a local edit. +Return a list with beginning and end of the region, a string representing +the language, a switch telling of the content should be in a single line." + (let ((re-list + (append + org-edit-src-region-extra + '( + ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang) + ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style) + ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental") + ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp") + ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl") + ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python") + ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby") + ("^[ \t]*#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n[ \t]*#\\+end_src" 2) + ("^[ \t]*#\\+begin_example.*\n" "\n[ \t]*#\\+end_example" "fundamental") + ("^[ \t]*#\\+html:" "\n" "html" single-line) + ("^[ \t]*#\\+begin_html.*\n" "\n[ \t]*#\\+end_html" "html") + ("^[ \t]*#\\+latex:" "\n" "latex" single-line) + ("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex") + ("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line) + ("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental") + ("^[ \t]*#\\+docbook:" "\n" "xml" single-line) + ("^[ \t]*#\\+begin_docbook.*\n" "\n[ \t]*#\\+end_docbook" "xml") + ))) + (pos (point)) + re1 re2 single beg end lang lfmt match-re1 ind entry) + (catch 'exit + (while (setq entry (pop re-list)) + (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry) + single (nth 3 entry)) + (save-excursion + (if (or (looking-at re1) + (re-search-backward re1 nil t)) + (progn + (setq match-re1 (match-string 0)) + (setq beg (match-end 0) + lang (org-edit-src-get-lang lang) + lfmt (org-edit-src-get-label-format match-re1) + ind (org-edit-src-get-indentation (match-beginning 0))) + (if (and (re-search-forward re2 nil t) + (>= (match-end 0) pos)) + (throw 'exit (list beg (match-beginning 0) + lang single lfmt ind)))) + (if (or (looking-at re2) + (re-search-forward re2 nil t)) + (progn + (setq end (match-beginning 0)) + (if (and (re-search-backward re1 nil t) + (<= (match-beginning 0) pos)) + (progn + (setq lfmt (org-edit-src-get-label-format + (match-string 0)) + ind (org-edit-src-get-indentation + (match-beginning 0))) + (throw 'exit + (list (match-end 0) end + (org-edit-src-get-lang lang) + single lfmt ind)))))))))))) + +(defun org-edit-src-get-lang (lang) + "Extract the src language." + (let ((m (match-string 0))) + (cond + ((stringp lang) lang) + ((integerp lang) (match-string lang)) + ((and (eq lang 'lang) + (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m)) + (match-string 1 m)) + ((and (eq lang 'style) + (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m)) + (match-string 1 m)) + (t "fundamental")))) + +(defun org-edit-src-get-label-format (s) + "Extract the label format." + (save-match-data + (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s) + (match-string 1 s)))) + +(defun org-edit-src-get-indentation (pos) + "Extract the label format." + (save-match-data + (goto-char pos) + (org-get-indentation))) + +(defun org-edit-src-exit () + "Exit special edit and protect problematic lines." + (interactive) + (unless (string-match "\\`*Org Edit " (buffer-name (current-buffer))) + (error "This is not an sub-editing buffer, something is wrong...")) + (let ((beg org-edit-src-beg-marker) + (end org-edit-src-end-marker) + (ovl org-edit-src-overlay) + (buffer (current-buffer)) + (nindent org-edit-src-nindent) + code line) + (untabify (point-min) (point-max)) + (save-excursion + (goto-char (point-min)) + (if (looking-at "[ \t\n]*\n") (replace-match "")) + (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))) + (when (org-bound-and-true-p org-edit-src-force-single-line) + (goto-char (point-min)) + (while (re-search-forward "\n" nil t) + (replace-match " ")) + (goto-char (point-min)) + (if (looking-at "\\s-*") (replace-match " ")) + (if (re-search-forward "\\s-+\\'" nil t) + (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) + (replace-match ",\\1"))) + (when (org-bound-and-true-p org-edit-src-picture) + (untabify (point-min) (point-max)) + (goto-char (point-min)) + (while (re-search-forward "^" nil t) + (replace-match ": "))) + (when nindent + (setq nindent (make-string (+ org-edit-src-content-indentation nindent) + ?\ )) + (goto-char (point-min)) + (while (re-search-forward "^" nil t) + (replace-match nindent))) + (setq code (buffer-string)) + (switch-to-buffer (marker-buffer beg)) + (kill-buffer buffer) + (goto-char beg) + (org-delete-overlay ovl) + (delete-region beg end) + (insert code) + (goto-char beg) + (goto-line (1- (+ (org-current-line) line))) + (move-marker beg nil) + (move-marker end nil))) + +(defun org-edit-src-save () + "Save parent buffer with current state source-code buffer." + (interactive) + (let ((p (point)) (m (mark)) msg) + (org-edit-src-exit) + (save-buffer) + (setq msg (current-message)) + (org-edit-src-code) + (push-mark m 'nomessage) + (goto-char (min p (point-max))) + (message (or msg "")))) + +(provide 'org-src) + +;; arch-tag: 6a1fc84f-dec7-47be-a416-64be56bea5d8 + +;;; org-src.el ends here diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index d561bb91bb4..f09d51917c0 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -247,13 +247,29 @@ Automatically means, when TAB or RET or C-c C-c are pressed in the line." :type 'boolean) (defcustom org-table-error-on-row-ref-crossing-hline t - "Non-nil means, a relative row reference that tries to cross a hline errors. -When nil, the reference will silently be to the field just next to the hline. -Coming from below, it will be the field below the hline, coming from -above, it will be the field above the hline." + "OBSOLETE VARIABLE, please see `org-table-relative-ref-may-cross-hline'." :group 'org-table :type 'boolean) +(defcustom org-table-relative-ref-may-cross-hline t + "Non-nil means, reltive formula references may cross hlines. +Here are the allowed values: + +nil Relative references may not cross hlines. They will reference the + field next to the hline instead. Coming from below, the reference + will be to the field below the hline. Coming from above, it will be + to the field above. +t Relative references may cros hlines. +error An attempt to cross a hline will throw an error. + +It is probably good to never set this variable to nil, for the sake of +portability of tables." + :group 'org-table-calculation + :type '(choice + (const :tag "Allow to cross" t) + (const :tag "Stick to hline" nil) + (const :tag "Error on attempt to cross" error))) + (defgroup org-table-import-export nil "Options concerning table import and export in Org-mode." :tag "Org Table Import Export" @@ -471,8 +487,9 @@ property, locally or anywhere up in the hierarchy." (error "Abort"))) (if (file-directory-p file) (error "This is a directory path, not a file")) - (if (equal (file-truename file) - (file-truename (buffer-file-name))) + (if (and (buffer-file-name) + (equal (file-truename file) + (file-truename (buffer-file-name)))) (error "Please specify a file name that is different from current")) (unless format (setq deffmt-readable org-table-export-default-format) @@ -573,7 +590,7 @@ 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 fmax f1 len c e) + emptystrings links dates emph narrow falign falign1 fmax f1 len c e) (untabify beg end) (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) ;; Check if we have links or dates @@ -594,7 +611,9 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; Check if we are narrowing any columns (goto-char beg) (setq narrow (and org-format-transports-properties-p - (re-search-forward "<[0-9]+>" end t))) + (re-search-forward "<[rl]?[0-9]+>" end t))) + (goto-char beg) + (setq falign (re-search-forward "<[rl][0-9]*>" end t)) ;; Get the rows (setq lines (org-split-string (buffer-substring beg end) "\n")) @@ -629,12 +648,14 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns (setq column (mapcar (lambda (x) (or (nth i x) "")) fields)) ;; Check if there is an explicit width specified - (when narrow - (setq c column fmax nil) + (when (or narrow falign) + (setq c column fmax nil falign1 nil) (while c (setq e (pop c)) - (if (and (stringp e) (string-match "^<\\([0-9]+\\)>$" e)) - (setq fmax (string-to-number (match-string 1 e)) c nil))) + (when (and (stringp e) (string-match "^<\\([rl]\\)?\\([0-9]+\\)?>$" e)) + (if (match-end 1) (setq falign1 (match-string 1 e))) + (if (match-end 2) + (setq fmax (string-to-number (match-string 2 e)) c nil)))) ;; Find fields that are wider than fmax, and shorten them (when fmax (loop for xx in column do @@ -654,14 +675,16 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; Get the maximum width for each column (push (apply 'max 1 (mapcar 'org-string-width column)) lengths) ;; Get the fraction of numbers, to decide about alignment of the column - (setq cnt 0 frac 0.0) - (loop for x in column do - (if (equal x "") - nil - (setq frac ( / (+ (* frac cnt) - (if (string-match org-table-number-regexp x) 1 0)) - (setq cnt (1+ cnt)))))) - (push (>= frac org-table-number-fraction) typenums)) + (if falign1 + (push (equal (downcase falign1) "r") typenums) + (setq cnt 0 frac 0.0) + (loop for x in column do + (if (equal x "") + nil + (setq frac ( / (+ (* frac cnt) + (if (string-match org-table-number-regexp x) 1 0)) + (setq cnt (1+ cnt)))))) + (push (>= frac org-table-number-fraction) typenums))) (setq lengths (nreverse lengths) typenums (nreverse typenums)) ;; Store the alignment of this table, for later editing of single fields @@ -699,6 +722,16 @@ When nil, simply write \"#ERROR\" in corrupted fields.") ;; Replace the old one (delete-region beg end) (move-marker end nil) + (if (equal (char-before) ?\n) + ;; This hack is for org-indent, to force redisplay of the + ;; line prefix of the first line. Apparently the redisplay + ;; is tied to the newline, which is, I think, a bug. + ;; To force this redisplay, we remove and re-insert the + ;; newline, so that the redisplay engine thinks it belongs + ;; to the changed text. + (progn + (backward-delete-char 1) + (insert "\n"))) (move-marker org-table-aligned-begin-marker (point)) (insert new) (move-marker org-table-aligned-end-marker (point)) @@ -827,13 +860,48 @@ Before doing so, re-align the table if necessary." (org-table-align)) (if (org-at-table-hline-p) (end-of-line 1)) - (re-search-backward "|" (org-table-begin)) - (re-search-backward "|" (org-table-begin)) + (condition-case nil + (progn + (re-search-backward "|" (org-table-begin)) + (re-search-backward "|" (org-table-begin))) + (error (error "Cannot move to previous table field"))) (while (looking-at "|\\(-\\|[ \t]*$\\)") (re-search-backward "|" (org-table-begin))) (if (looking-at "| ?") (goto-char (match-end 0)))) +(defun org-table-beginning-of-field (&optional n) + "Move to the end of the current table field. +If already at or after the end, move to the end of the next table field. +With numeric argument N, move N-1 fields forward first." + (interactive "p") + (let ((pos (point))) + (while (> n 1) + (setq n (1- n)) + (org-table-previous-field)) + (if (not (re-search-backward "|" (point-at-bol 0) t)) + (error "No more table fields before the current") + (goto-char (match-end 0)) + (and (looking-at " ") (forward-char 1))) + (if (>= (point) pos) (org-table-beginning-of-field 2)))) + +(defun org-table-end-of-field (&optional n) + "Move to the beginning of the current table field. +If already at or before the beginning, move to the beginning of the +previous field. +With numeric argument N, move N-1 fields backward first." + (interactive "p") + (let ((pos (point))) + (while (> n 1) + (setq n (1- n)) + (org-table-next-field)) + (when (re-search-forward "|" (point-at-eol 1) t) + (backward-char 1) + (skip-chars-backward " ") + (if (and (equal (char-before (point)) ?|) (looking-at " ")) + (forward-char 1))) + (if (<= (point) pos) (org-table-end-of-field 2)))) + (defun org-table-next-row () "Go to the next row (same column) in the current table. Before doing so, re-align the table if necessary." @@ -1362,15 +1430,21 @@ should be done in reverse order." (defun org-table-cut-region (beg end) - "Copy region in table to the clipboard and blank all relevant fields." - (interactive "r") + "Copy region in table to the clipboard and blank all relevant fields. +If there is no active region, use just the field at point." + (interactive (list + (if (org-region-active-p) (region-beginning) (point)) + (if (org-region-active-p) (region-end) (point)))) (org-table-copy-region beg end 'cut)) (defun org-table-copy-region (beg end &optional cut) "Copy rectangular region in table to clipboard. A special clipboard is used which can only be accessed with `org-table-paste-rectangle'." - (interactive "rP") + (interactive (list + (if (org-region-active-p) (region-beginning) (point)) + (if (org-region-active-p) (region-end) (point)) + current-prefix-arg)) (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 region cols (rpl (if cut " " nil))) @@ -1778,11 +1852,12 @@ When NAMED is non-nil, look for a named equation." (setq alist (sort alist 'org-table-formula-less-p)) (save-excursion (goto-char (org-table-end)) - (if (looking-at "\\([ \t]*\n\\)*#\\+TBLFM:\\(.*\n?\\)") + (if (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM:\\(.*\n?\\)") (progn ;; don't overwrite TBLFM, we might use text properties to store stuff (goto-char (match-beginning 2)) (delete-region (match-beginning 2) (match-end 0))) + (org-indent-line-function) (insert "#+TBLFM:")) (insert " " (mapconcat (lambda (x) @@ -1811,7 +1886,7 @@ When NAMED is non-nil, look for a named equation." (let (scol eq eq-alist strings string seen) (save-excursion (goto-char (org-table-end)) - (when (looking-at "\\([ \t]*\n\\)*#\\+TBLFM: *\\(.*\\)") + (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)") (setq strings (org-split-string (match-string 2) " *:: *")) (while (setq string (pop strings)) (when (string-match "\\`\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string) @@ -1836,7 +1911,7 @@ KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace. For all numbers larger than LIMIT, shift them by DELTA." (save-excursion (goto-char (org-table-end)) - (when (looking-at "#\\+TBLFM:") + (when (looking-at "[ \t]*#\\+TBLFM:") (let ((re (concat key "\\([0-9]+\\)")) (re2 (when remove @@ -1847,14 +1922,17 @@ For all numbers larger than LIMIT, shift them by DELTA." s n a) (when remove (while (re-search-forward re2 (point-at-eol) t) - (replace-match ""))) + (unless (save-match-data (org-in-regexp "remote([^)]+?)")) + (replace-match "")))) (while (re-search-forward re (point-at-eol) t) - (setq s (match-string 1) n (string-to-number s)) - (cond - ((setq a (assoc s replace)) - (replace-match (concat key (cdr a)) t t)) - ((and limit (> n limit)) - (replace-match (concat key (int-to-string (+ n delta))) t t)))))))) + (unless (save-match-data (org-in-regexp "remote([^)]+?)")) + (setq s (match-string 1) n (string-to-number s)) + (cond + ((setq a (assoc s replace)) + (replace-match (concat key (cdr a)) t t)) + ((and limit (> n limit)) + (replace-match (concat key (int-to-string (+ n delta))) + t t))))))))) (defun org-table-get-specials () "Get the column names and local parameters for this table." @@ -2353,9 +2431,13 @@ and TABLE is a vector with line types." (>= i 0) (< i l) (not (eq (aref table i) type)) (if (and relative (eq (aref table i) 'hline)) - (if org-table-error-on-row-ref-crossing-hline - (error "Row descriptor %s used in line %d crosses hline" desc cline) - (progn (setq i (- i (if backwards -1 1)) n 1) nil)) + (cond + ((eq org-table-relative-ref-may-cross-hline t) t) + ((eq org-table-relative-ref-may-cross-hline 'error) + (error "Row descriptor %s used in line %d crosses hline" desc cline)) + (t (setq i (- i (if backwards -1 1)) + n 1) + nil)) t))) (setq n (1- n))) (if (or (< i 0) (>= i l)) @@ -2620,7 +2702,7 @@ Parameters get priority." (defun org-table-edit-formulas () "Edit the formulas of the current table in a separate buffer." (interactive) - (when (save-excursion (beginning-of-line 1) (looking-at "#\\+TBLFM")) + (when (save-excursion (beginning-of-line 1) (looking-at "[ \t]*#\\+TBLFM")) (beginning-of-line 0)) (unless (org-at-table-p) (error "Not at a table")) (org-table-get-specials) @@ -3387,6 +3469,8 @@ to execute outside of tables." '("\C-c`" org-table-edit-field) '("\C-c*" org-table-recalculate) '("\C-c^" org-table-sort-lines) + '("\M-a" org-table-beginning-of-field) + '("\M-e" org-table-end-of-field) '([(control ?#)] org-table-rotate-recalc-marks))) elt key fun cmd) (while (setq elt (pop bindings)) @@ -3411,6 +3495,16 @@ to execute outside of tables." (orgtbl-make-binding 'org-table-previous-field 104 [(shift tab)] [(tab)] "\C-i")) + (org-defkey orgtbl-mode-map [S-iso-lefttab] + (orgtbl-make-binding 'org-table-previous-field 107 + [S-iso-lefttab] [backtab] [(shift tab)] + [(tab)] "\C-i")) + + (org-defkey orgtbl-mode-map [backtab] + (orgtbl-make-binding 'org-table-previous-field 108 + [backtab] [S-iso-lefttab] [(shift tab)] + [(tab)] "\C-i")) + (org-defkey orgtbl-mode-map "\M-\C-m" (orgtbl-make-binding 'org-table-wrap-region 105 "\M-\C-m" [(meta return)])) @@ -3491,15 +3585,15 @@ to execute outside of tables." (defun orgtbl-ctrl-c-ctrl-c (arg) "If the cursor is inside a table, realign the table. -It it is a table to be sent away to a receiver, do it. +If it is a table to be sent away to a receiver, do it. With prefix arg, also recompute table." (interactive "P") (let ((pos (point)) action) (save-excursion (beginning-of-line 1) - (setq action (cond ((looking-at "#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) + (setq action (cond ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) ((looking-at "[ \t]*|") pos) - ((looking-at "#\\+TBLFM:") 'recalc)))) + ((looking-at "[ \t]*#\\+TBLFM:") 'recalc)))) (cond ((integerp action) (goto-char action) @@ -3557,7 +3651,8 @@ overwritten, and the table is not marked as requiring realignment." orgtbl-hijacker-command-102 orgtbl-hijacker-command-103 orgtbl-hijacker-command-104 - orgtbl-hijacker-command-105)) + orgtbl-hijacker-command-105 + yas/expand)) (org-table-blank-field)) t) (eq N 1) @@ -3568,14 +3663,27 @@ overwritten, and the table is not marked as requiring realignment." (goto-char (match-beginning 0)) (self-insert-command N)) (setq org-table-may-need-update t) - (let (orgtbl-mode a) - (call-interactively - (or (key-binding - (or (and (listp function-key-map) - (setq a (assoc last-input-event function-key-map)) - (cdr a)) - (vector last-input-event))) - 'self-insert-command))))) + (let* (orgtbl-mode + a + (cmd (or (key-binding + (or (and (listp function-key-map) + (setq a (assoc last-input-event function-key-map)) + (cdr a)) + (vector last-input-event))) + 'self-insert-command))) + (call-interactively cmd) + (if (and org-self-insert-cluster-for-undo + (eq cmd 'self-insert-command)) + (if (not (eq last-command 'orgtbl-self-insert-command)) + (setq org-self-insert-command-undo-counter 1) + (if (>= org-self-insert-command-undo-counter 20) + (setq org-self-insert-command-undo-counter 1) + (and (> org-self-insert-command-undo-counter 0) + buffer-undo-list + (not (cadr buffer-undo-list)) ; remove nil entry + (setcdr buffer-undo-list (cddr buffer-undo-list))) + (setq org-self-insert-command-undo-counter + (1+ org-self-insert-command-undo-counter)))))))) (defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" "Regular expression matching exponentials as produced by calc.") @@ -3612,7 +3720,7 @@ a radio table." (goto-char (org-table-begin)) (let (rtn) (beginning-of-line 0) - (while (looking-at "#\\+ORGTBL[: \t][ \t]*SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") + (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?") (let ((name (org-no-properties (match-string 1))) (transform (intern (match-string 2))) (params (if (match-end 3) @@ -4106,17 +4214,20 @@ list of the fields in the rectangle ." org-table-last-column-widths org-table-last-alignment org-table-last-column-widths tbeg buffer loc) + (setq form (org-table-convert-refs-to-rc form)) (save-excursion (save-restriction (widen) (save-excursion (goto-char (point-min)) (if (re-search-forward - (concat "^#\\+TBLNAME:[ \t]*" (regexp-quote name-or-id) "[ \t]*$") + (concat "^#[ \t]*\\+TBLNAME:[ \t]*" (regexp-quote name-or-id) "[ \t]*$") nil t) (setq buffer (current-buffer) loc (match-beginning 0)) - (setq id-loc (org-id-find name-or-id 'marker) - buffer (marker-buffer id-loc) + (setq id-loc (org-id-find name-or-id 'marker)) + (unless (and id-loc (markerp id-loc)) + (error "Can't find remote table \"%s\"" name-or-id)) + (setq buffer (marker-buffer id-loc) loc (marker-position id-loc)) (move-marker id-loc nil))) (switch-to-buffer buffer) diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index 901693f6732..385f09b8954 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -29,6 +29,9 @@ (require 'org) +(declare-function org-show-notification "org-clock" (parameters)) +(declare-function org-agenda-error "org-agenda" ()) + (defvar org-timer-start-time nil "t=0 for the running timer.") @@ -253,6 +256,74 @@ VALUE can be `on', `off', or `pause'." (concat " <" (substring (org-timer-value-string) 0 -1) ">")) (force-mode-line-update))) +(defvar org-timer-timer1 nil) +(defvar org-timer-timer2 nil) +(defvar org-timer-timer3 nil) +(defvar org-timer-last-timer nil) + +(defun org-timer-cancel-timers () + "Reset all timers." + (interactive) + (mapc (lambda(timer) + (when (eval timer) + (cancel-timer timer) + (setq timer nil))) + '(org-timer-timer1 + org-timer-timer2 + org-timer-timer3)) + (message "All timers reset")) + +(defun org-timer-show-remaining-time () + "Display the remaining time before the timer ends." + (interactive) + (require 'time) + (if (and (not org-timer-timer1) + (not org-timer-timer2) + (not org-timer-timer3)) + (message "No timer set") + (let* ((rtime (decode-time + (time-subtract (timer--time org-timer-last-timer) + (current-time)))) + (rsecs (nth 0 rtime)) + (rmins (nth 1 rtime))) + (message "%d minutes %d secondes left before next time out" + rmins rsecs)))) + +;;;###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) + (let* ((mins (string-to-number (match-string 0 minutes))) + (secs (* mins 60)) + (hl (cond + ((string-match "Org Agenda" (buffer-name)) + (let* ((marker (or (get-text-property (point) 'org-marker) + (org-agenda-error))) + (hdmarker (or (get-text-property (point) 'org-hd-marker) + marker)) + (pos (marker-position marker))) + (with-current-buffer (marker-buffer marker) + (widen) + (goto-char pos) + (org-show-entry) + (org-get-heading)))) + ((eq major-mode 'org-mode) + (org-get-heading)) + (t (error "Not in an Org buffer")))) + timer-set) + (mapcar (lambda(timer) + (if (not (or (eval timer) timer-set)) + (setq timer-set t + timer + (run-with-timer secs nil 'org-show-notification + (format "%s: time out" hl)) + org-timer-last-timer timer))) + '(org-timer-timer1 + org-timer-timer2 + org-timer-timer3))))) + (provide 'org-timer) ;; arch-tag: 97538f8c-3871-4509-8f23-1e7b3ff3d107 diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el index aec28c5f663..283ac74639b 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -71,8 +71,9 @@ :message-id message-id) (setq message-id (org-remove-angle-brackets message-id)) (setq folder (abbreviate-file-name folder)) - (if (string-match (concat "^" (regexp-quote vm-folder-directory)) - folder) + (if (and vm-folder-directory + (string-match (concat "^" (regexp-quote vm-folder-directory)) + folder)) (setq folder (replace-match "" t t folder))) (setq desc (org-email-link-description)) (setq link (org-make-link "vm:" folder "#" message-id)) diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el index a09d88e1536..773e8bc9630 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -93,7 +93,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." (setq return-content (concat return-content (buffer-substring (point) transform-end)))) - (kill-new return-content) + (org-kill-new return-content) (message "Transforming links...done, use C-y to insert text into Org-mode file") (message "Copy with link transformation complete.")))) diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el index eb8936f34db..60be81e75c3 100644 --- a/lisp/org/org-wl.el +++ b/lisp/org/org-wl.el @@ -6,7 +6,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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el new file mode 100644 index 00000000000..fcc8d43320f --- /dev/null +++ b/lisp/org/org-xoxo.el @@ -0,0 +1,124 @@ +;;; org-xoxo.el --- XOXO export for Org-mode + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.29c +;; +;; 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: + +(require 'org-exp) + +;;; XOXO export + +(defun org-export-as-xoxo-insert-into (buffer &rest output) + (with-current-buffer buffer + (apply 'insert output))) +(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1) + +;;;###autoload +(defun org-export-as-xoxo (&optional buffer) + "Export the org buffer as XOXO. +The XOXO buffer is named *xoxo-<source buffer name>*" + (interactive (list (current-buffer))) + ;; A quickie abstraction + + ;; Output everything as XOXO + (with-current-buffer (get-buffer buffer) + (let* ((pos (point)) + (opt-plist (org-combine-plists (org-default-export-plist) + (org-infile-export-plist))) + (filename (concat (file-name-as-directory + (org-export-directory :xoxo opt-plist)) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ".html")) + (out (find-file-noselect filename)) + (last-level 1) + (hanging-li nil)) + (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. + ;; Check the output buffer is empty. + (with-current-buffer out (erase-buffer)) + ;; Kick off the output + (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n") + (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't) + (let* ((hd (match-string-no-properties 1)) + (level (length hd)) + (text (concat + (match-string-no-properties 2) + (save-excursion + (goto-char (match-end 0)) + (let ((str "")) + (catch 'loop + (while 't + (forward-line) + (if (looking-at "^[ \t]\\(.*\\)") + (setq str (concat str (match-string-no-properties 1))) + (throw 'loop str))))))))) + + ;; Handle level rendering + (cond + ((> level last-level) + (org-export-as-xoxo-insert-into out "\n<ol>\n")) + + ((< level last-level) + (dotimes (- (- last-level level) 1) + (if hanging-li + (org-export-as-xoxo-insert-into out "</li>\n")) + (org-export-as-xoxo-insert-into out "</ol>\n")) + (when hanging-li + (org-export-as-xoxo-insert-into out "</li>\n") + (setq hanging-li nil))) + + ((equal level last-level) + (if hanging-li + (org-export-as-xoxo-insert-into out "</li>\n"))) + ) + + (setq last-level level) + + ;; And output the new li + (setq hanging-li 't) + (if (equal ?+ (elt text 0)) + (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>") + (org-export-as-xoxo-insert-into out "<li>" text)))) + + ;; Finally finish off the ol + (dotimes (- last-level 1) + (if hanging-li + (org-export-as-xoxo-insert-into out "</li>\n")) + (org-export-as-xoxo-insert-into out "</ol>\n")) + + (goto-char pos) + ;; Finish the buffer off and clean it up. + (switch-to-buffer-other-window out) + (indent-region (point-min) (point-max) nil) + (save-buffer) + (goto-char (point-min)) + ))) + +(provide 'org-xoxo) + +;; arch-tag: 16e6a31f-f4f5-46f1-af18-48dc89faa702 + + +;;; org-xoxo.el ends here diff --git a/lisp/org/org.el b/lisp/org/org.el index 2f9847e2fee..591d920253f 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.21b +;; Version: 6.29c ;; ;; This file is part of GNU Emacs. ;; @@ -88,13 +88,14 @@ (require 'org-compat) (require 'org-faces) (require 'org-list) +(require 'org-src) (require 'org-footnote) ;;;; Customization variables ;;; Version -(defconst org-version "6.21b" +(defconst org-version "6.29c" "The version number of the file org.el.") (defun org-version (&optional here) @@ -167,36 +168,45 @@ to add the symbol `xyz', and the package must have a call to (const :tag " id: Global IDs for identifying entries" org-id) (const :tag " info: Links to Info nodes" org-info) (const :tag " jsinfo: Set up Sebastian Rose's JavaScript org-info.js" org-jsinfo) + (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask) (const :tag " irc: Links to IRC/ERC chat sessions" org-irc) (const :tag " mac-message: Links to messages in Apple Mail" org-mac-message) (const :tag " mew Links to Mew folders/messages" org-mew) (const :tag " mhe: Links to MHE folders/messages" org-mhe) + (const :tag " protocol: Intercept calls from emacsclient" org-protocol) (const :tag " rmail: Links to RMAIL folders/messages" org-rmail) (const :tag " vm: Links to VM folders/messages" org-vm) (const :tag " wl: Links to Wanderlust folders/messages" org-wl) - (const :tag " w3m: Special cut/past from w3m to Org." org-w3m) + (const :tag " w3m: Special cut/paste from w3m to Org." org-w3m) (const :tag " mouse: Additional mouse support" org-mouse) (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) - (const :tag "C annotation-helper: Call Remember directly from Browser" org-annotation-helper) + (const :tag "C annotation-helper: Call Remember directly from Browser (OBSOLETE, use org-protocol)" org-annotation-helper) (const :tag "C bookmark: Org links to bookmarks" org-bookmark) - (const :tag "C browser-url: Store link, directly from Browser" org-browser-url) - (const :tag "C depend: TODO dependencies for Org-mode" org-depend) + (const :tag "C browser-url: Store link, directly from Browser (OBSOLETE, use org-protocol)" org-browser-url) + (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist) + (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) + (const :tag "C collector: Collect properties into tables" org-collector) + (const :tag "C depend: TODO dependencies for Org-mode (PARTIALLY OBSOLETE, see built-in dependency support))" org-depend) (const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol) (const :tag "C eval: Include command output as text" org-eval) (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry) - (const :tag "C exp-blocks: Pre-process blocks for export" org-exp-blocks) - (const :tag "C interactive-query: Interactive modification of tags query" org-interactive-query) + (const :tag "C exp-bibtex: Export citations using BibTeX" org-exp-bibtex) + (const :tag "C interactive-query: Interactive modification of tags query (PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query) + (const :tag "C jira Add a jira:ticket protocol to Org" org-jira) (const :tag "C mairix: Hook mairix search into Org 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 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) + (const :tag "C R: Computation using the R language" org-R) (const :tag "C registry: A registry for Org links" org-registry) (const :tag "C org2rem: Convert org appointments into reminders" org2rem) (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen) - (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) + (const :tag "C special-blocks: Turn blocks into LaTeX envs and HTML divs" org-special-blocks) (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) (repeat :tag "External packages" :inline t (symbol :tag "Package")))) (defcustom org-support-shift-select nil @@ -268,6 +278,18 @@ uninteresting. Also tables look terrible when wrapped." :group 'org-startup :type 'boolean) +(defcustom org-startup-indented nil + "Non-nil means, turn on `org-indent-mode' on startup. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + + #+STARTUP: indent + #+STARTUP: noindent" + :group 'org-structure + :type '(choice + (const :tag "Not" nil) + (const :tag "Globally (slow on startup in large files)" t))) + (defcustom org-startup-align-all-tables nil "Non-nil means, align all tables when visiting a file. This is useful when the column width in tables is forced with <N> cookies @@ -292,7 +314,8 @@ has been set." (defcustom org-replace-disputed-keys nil "Non-nil means use alternative key bindings for some keys. Org-mode uses S-<cursor> keys for changing timestamps and priorities. -These keys are also used by other packages like `CUA-mode' or `windmove.el'. +These keys are also used by other packages like shift-selection-mode' +\(built into Emacs 23), `CUA-mode' or `windmove.el'. If you want to use Org-mode together with one of these other modes, or more generally if you would like to move some Org-mode commands to other keys, set this variable and configure the keys with the variable @@ -543,7 +566,27 @@ new-frame Make a new frame each time. Note that in this case :tag "Org Cycle" :group 'org-structure) -(defcustom org-drawers '("PROPERTIES" "CLOCK") +(defcustom org-cycle-skip-children-state-if-no-children t + "Non-nil means, skip CHILDREN state in entries that don't have any." + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-max-level nil + "Maximum level which should still be subject to visibility cycling. +Levels higher than this will, for cycling, be treated as text, not a headline. +When `org-odd-levels-only' is set, a value of N in this variable actually +means 2N-1 stars as the limiting headline. +When nil, cycle all levels. +Note that the limiting level of cycling is also influenced by +`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but +`org-inlinetask-min-level' is, cycling will be limited to levels one less +than its value." + :group 'org-cycle + :type '(choice + (const :tag "No limit" nil) + (integer :tag "Maximum level"))) + +(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK") "Names of drawers. Drawers are not opened by cycling on the headline above. Drawers only open with a TAB on the drawer line itself. A drawer looks like this: @@ -557,8 +600,19 @@ Drawers can be defined on the per-file basis with a line like: #+DRAWERS: HIDDEN STATE PROPERTIES" :group 'org-structure + :group 'org-cycle :type '(repeat (string :tag "Drawer Name"))) +(defcustom org-hide-block-startup nil + "Non-nil means, , entering Org-mode will fold all blocks. +This can also be set in on a per-file basis with + +#+STARTUP: hideblocks +#+STARTUP: showblocks" + :group 'org-startup + :group 'org-cycle + :type 'boolean) + (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 @@ -603,6 +657,16 @@ Special case: when 0, never leave empty lines in collapsed view." :type 'integer) (put 'org-cycle-separator-lines 'safe-local-variable 'integerp) +(defcustom org-pre-cycle-hook nil + "Hook that is run before visibility cycling is happening. +The function(s) in this hook must accept a single argument which indicates +the new state that will be set right after running this hook. The +argument is a symbol. Before a global state change, it can have the values +`overview', `content', or `all'. Before a local state change, it can have +the values `folded', `children', or `subtree'." + :group 'org-cycle + :type 'hook) + (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees org-cycle-hide-drawers org-cycle-show-empty-lines @@ -638,33 +702,62 @@ lines to the buffer: :type 'boolean) (defcustom org-adapt-indentation t - "Non-nil means, adapt indentation when promoting and demoting. -When this is set and the *entire* text in an entry is indented, the -indentation is increased by one space in a demotion command, and -decreased by one in a promotion command. If any line in the entry -body starts at column 0, indentation is not changed at all." + "Non-nil means, adapt indentation to outline node level. + +When this variable is set, Org assumes that you write outlines by +indenting text in each node to align with the headline (after the stars). +The following issues are influenced by this variable: + +- When this is set and the *entire* text in an entry is indented, the + indentation is increased by one space in a demotion command, and + decreased by one in a promotion command. If any line in the entry + body starts with text at column 0, indentation is not changed at all. + +- Property drawers and planning information is inserted indented when + this variable s set. When nil, they will not be indented. + +- TAB indents a line relative to context. The lines below a headline + will be indented when this variable is set. + +Note that this is all about true indentation, by adding and removing +space characters. See also `org-indent.el' which does level-dependent +indentation in a virtual way, i.e. at display time in Emacs." :group 'org-edit-structure :type 'boolean) (defcustom org-special-ctrl-a/e nil "Non-nil means `C-a' and `C-e' behave specially in headlines and items. + When t, `C-a' will bring back the cursor to the beginning of the headline text, i.e. after the stars and after a possible TODO keyword. In an item, this will be the position after the bullet. When the cursor is already at that position, another `C-a' will bring it to the beginning of the line. + `C-e' will jump to the end of the headline, ignoring the presence of tags in the headline. A second `C-e' will then jump to the true end of the line, after any tags. + When set to the symbol `reversed', the first `C-a' or `C-e' works normally, -and only a directly following, identical keypress will bring the cursor -to the special positions." +going to the true line boundary first. Only a directly following, identical +keypress will bring the cursor to the special positions. + +This may also be a cons cell where the behavior for `C-a' and `C-e' is +set separately." :group 'org-edit-structure :type '(choice (const :tag "off" nil) - (const :tag "after bullet first" t) - (const :tag "border first" reversed))) - + (const :tag "after stars/bullet and before tags first" t) + (const :tag "true line boundary first" reversed) + (cons :tag "Set C-a and C-e separately" + (choice :tag "Special C-a" + (const :tag "off" nil) + (const :tag "after stars/bullet first" t) + (const :tag "before stars/bullet first" reversed)) + (choice :tag "Special C-e" + (const :tag "off" nil) + (const :tag "before tags first" t) + (const :tag "after tags first" reversed))))) (if (fboundp 'defvaralias) (defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)) @@ -736,7 +829,9 @@ for the duration of the command." (plain-list-item . auto)) "Should `org-insert-heading' leave a blank line before new heading/item? The value is an alist, with `heading' and `plain-list-item' as car, -and a boolean flag as cdr." +and a boolean flag as cdr. For plain lists, if the variable +`org-empty-line-terminates-plain-lists' is set, the setting here +is ignored and no empty line is inserted, to keep the list in tact." :group 'org-edit-structure :type '(list (cons (const heading) @@ -761,49 +856,6 @@ See also the QUOTE keyword." :group 'org-edit-structure :type 'boolean) -(defcustom org-edit-src-region-extra nil - "Additional regexps to identify regions for editing with `org-edit-src-code'. -For examples see the function `org-edit-src-find-region-and-lang'. -The regular expression identifying the begin marker should end with a newline, -and the regexp marking the end line should start with a newline, to make sure -there are kept outside the narrowed region." - :group 'org-edit-structure - :type '(repeat - (list - (regexp :tag "begin regexp") - (regexp :tag "end regexp") - (choice :tag "language" - (string :tag "specify") - (integer :tag "from match group") - (const :tag "from `lang' element") - (const :tag "from `style' element"))))) - -(defcustom org-coderef-label-format "(ref:%s)" - "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 -an individual literal example with the -f option, like - -#+BEGIN_SRC pascal +n -r -l \"((%s))\" -... -#+END_SRC - -If you want to use this for HTML export, make sure that the format does -not introduce special font-locking, and avoid the HTML special -characters `<', `>', and `&'. The reason for this restriction is that -the labels are searched for only after htmlize has done its job." - :group 'org-edit-structure ; FIXME this is not in the right group - :type 'string) - -(defcustom org-edit-fixed-width-region-mode 'artist-mode - "The mode that should be used to edit fixed-width regions. -These are the regions where each line starts with a colon." - :group 'org-edit-structure - :type '(choice - (const artist-mode) - (const picture-mode) - (const fundamental-mode) - (function :tag "Other (specify)"))) (defcustom org-goto-auto-isearch t "Non-nil means, typing characters in org-goto starts incremental search." @@ -849,7 +901,7 @@ as possible." "The maximum level for Imenu access to Org-mode headlines. This also applied for speedbar access." :group 'org-imenu-and-speedbar - :type 'number) + :type 'integer) (defgroup org-table nil "Options concerning tables in Org-mode." @@ -887,6 +939,14 @@ See also the variable `org-table-auto-blank-field'." (const :tag "on" t) (const :tag "on, optimized" optimized))) +(defcustom org-self-insert-cluster-for-undo t + "Non-nil means cluster self-insert commands for undo when possible. +If this is set, then, like in the Emacs command loop, 20 consequtive +characters will be undone together. +This is configurable, because there is some impact on typing performance." + :group 'org-table + :type 'boolean) + (defcustom org-table-tab-recognizes-table.el t "Non-nil means, TAB will automatically notice a table.el table. When it sees such a table, it moves point into it and - if necessary - @@ -912,6 +972,9 @@ links in Org-mode buffers can have an optional tag after a double colon, e.g. [[linkkey:tag][description]] +The 'linkkey' must be a word word, starting with a letter, followed +by letters, numbers, '-' or '_'. + If REPLACE is a string, the tag will simply be appended to create the link. If the string contains \"%s\", the tag will be inserted there. Alternatively, the placeholder \"%h\" will cause a url-encoded version of the tag to @@ -1026,11 +1089,11 @@ It should match if the message is from the user him/herself." :group 'org-link-store :type 'regexp) -(defcustom org-link-to-org-use-id 'create-if-interactive +(defcustom org-link-to-org-use-id 'create-if-interactive-and-no-custom-id "Non-nil means, storing a link to an Org file will use entry IDs. Note that before this variable is even considered, org-id must be loaded, -to please customize `org-modules' and turn it on. +so please customize `org-modules' and turn it on. The variable can have the following values: @@ -1047,6 +1110,10 @@ create-if-interactive template to an entry not having an ID, create it first by explicitly creating a link to it, using `C-c C-l' first. +create-if-interactive-and-no-custom-id + Like create-if-interactive, but do not create an ID if there is + a CUSTOM_ID property defined in the entry. This is the default. + use-existing Use existing ID, do not create one. @@ -1055,9 +1122,11 @@ nil Never use an ID to make a link, instead link using a text search for :group 'org-link-store :type '(choice (const :tag "Create ID to make link" t) - (const :tag "Create if string link interactively" - 'create-if-interactive) - (const :tag "Only use existing" 'use-existing) + (const :tag "Create if storing link interactively" + create-if-interactive) + (const :tag "Create if storing link interactively and no CUSTOM_ID is present" + create-if-interactive-and-no-custom-id) + (const :tag "Only use existing" use-existing) (const :tag "Do not use ID to create link" nil))) (defcustom org-context-in-file-links t @@ -1109,7 +1178,9 @@ links created by planner." (defcustom org-tab-follows-link nil "Non-nil means, on links TAB will follow the link. -Needs to be set before org.el is loaded." +Needs to be set before org.el is loaded. +This really should not be used, it does not make sense, and the +implementation is bad." :group 'org-link-follow :type 'boolean) @@ -1186,7 +1257,10 @@ changes to the current buffer." (defcustom org-open-non-existing-files nil "Non-nil means, `org-open-file' will open non-existing files. -When nil, an error will be generated." +When nil, an error will be generated. +This variable applies only to external applications because they +might choke on non-existing files. If the link is to a file that +will be openend in Emacs, the variable is ignored." :group 'org-link-follow :type 'boolean) @@ -1219,7 +1293,7 @@ Shell links can be dangerous: just think about a link This link would show up in your Org-mode document as \"Google Search\", but really it would remove your entire home directory. Therefore we advise against setting this variable to nil. -Just change it to `y-or-n-p' of you want to confirm with a +Just change it to `y-or-n-p' if you want to confirm with a single keystroke rather than having to type \"yes\"." :group 'org-link-follow :type '(choice @@ -1236,7 +1310,7 @@ Elisp links can be dangerous: just think about a link This link would show up in your Org-mode document as \"Google Search\", but really it would remove your entire home directory. Therefore we advise against setting this variable to nil. -Just change it to `y-or-n-p' of you want to confirm with a +Just change it to `y-or-n-p' if you want to confirm with a single keystroke rather than having to type \"yes\"." :group 'org-link-follow :type '(choice @@ -1324,9 +1398,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. + 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'. + 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' @@ -1355,8 +1429,16 @@ For more examples, see the system specific constants (defcustom org-directory "~/org" "Directory with org files. -This directory will be used as default to prompt for org files. -Used by the hooks for remember.el." +This is just a default location to look for Org files. There is no need +at all to put your files into this directory. It is only used in the +following situations: + +1. When a remember template specifies a target file that is not an + absolute path. The path will then be interpreted relative to + `org-directory' +2. When a remember note is filed away in an interactive way (when exiting the + note buffer with `C-1 C-c C-c'. The the user is prompted for an org file, + with `org-directory' as the default path." :group 'org-refile :group 'org-remember :type 'directory) @@ -1390,7 +1472,7 @@ outline-path-completion Headlines in the current buffer are offered via (defcustom org-goto-max-level 5 "Maximum level to be considered when running org-goto with refile interface." :group 'org-refile - :type 'number) + :type 'integer) (defcustom org-reverse-note-order nil "Non-nil means, store new notes at the beginning of a file or entry. @@ -1413,8 +1495,8 @@ This is list of cons cells. Each cell contains: a file name or a list of file names. If you use `org-agenda-files' for that, all agenda files will be scanned for targets. Nil means, consider headings in the current buffer. -- A specification of how to select find candidate refile targets. This - may be any of +- A specification of how to find candidate refile targets. This may be + any of: - a cons cell (:tag . \"TAG\") to identify refile targets by a tag. This tag has to be present in all target headlines, inheritance will not be considered. @@ -1423,7 +1505,14 @@ This is list of cons cells. Each cell contains: - a cons cell (:regexp . \"REGEXP\") with a regular expression matching headlines that are refiling targets. - a cons cell (:level . N). Any headline of level N is considered a target. + Note that, when `org-odd-levels-only' is set, level corresponds to + order in hierarchy, not to the number of stars. - a cons cell (:maxlevel . N). Any headline with level <= N is a target. + Note that, when `org-odd-levels-only' is set, level corresponds to + 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. When this variable is nil, all top-level headlines in the current buffer are used, equivalent to the value `((nil . (:level . 1))'." @@ -1441,11 +1530,29 @@ are used, equivalent to the value `((nil . (:level . 1))'." (cons :tag "Level number" (const :value :level) (integer)) (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) +(defcustom org-refile-target-verify-function nil + "Function to verify if the headline at point should be a refile target. +The function will be called without arguments, with point at the +beginning of the headline. It should return t and leave point +where it is if the headline is a valid target for refiling. + +If the target should not be selected, the function must return nil. +In addition to this, it may move point to a place from where the search +should be continued. For example, the function may decide that the entire +subtree of the current entry should be excluded and move point to the end +of the subtree." + :group 'org-refile + :type 'function) + (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. + When the value is `file', also include the file name (without directory) -into the path. When `full-file-path', include the full file path." +into the path. In this case, you can also stop the completion after +the file name, to get entries inserted as top level in the file. + + When `full-file-path', include the full file path." :group 'org-refile :type '(choice (const :tag "Not" nil) @@ -1465,6 +1572,23 @@ fast, while still showing the whole path to the entry." :group 'org-refile :type 'boolean) +(defcustom org-refile-allow-creating-parent-nodes nil + "Non-nil means, allow to create new nodes as refile targets. +New nodes are then created by adding \"/new node name\" to the completion +of an existing node. When the value of this variable is `confirm', +new node creation must be confirmed by the user (recommended) +When nil, the completion must match an existing entry. + +Note that, if the new heading is not seen by the criteria +listed in `org-refile-targets', multiple instances of the same +heading would be created by trying again to file under the new +heading." + :group 'org-refile + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Prompt for confirmation" confirm))) + (defgroup org-todo nil "Options concerning TODO items in Org-mode." :tag "Org TODO" @@ -1475,6 +1599,14 @@ fast, while still showing the whole path to the entry." :tag "Org Progress" :group 'org-time) +(defvar org-todo-interpretation-widgets + '( + (: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.") + (defcustom org-todo-keywords '((sequence "TODO" "DONE")) "List of TODO entry keyword sequences and their interpretation. \\<org-mode-map>This is a list of sequences. @@ -1524,8 +1656,18 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'." (cons (choice :tag "Interpretation" - (const :tag "Sequence (cycling hits every state)" sequence) - (const :tag "Type (cycling directly to DONE)" type)) + ;;Quick and dirty way to see + ;;`org-todo-interpretations'. This takes the + ;;place of item arguments + :convert-widget + (lambda (widget) + (widget-put widget + :args (mapcar + #'(lambda (x) + (widget-convert + (cons 'const x))) + org-todo-interpretation-widgets)) + widget)) (repeat (string :tag "Keyword")))))) @@ -1591,8 +1733,25 @@ by a letter in parenthesis, like TODO(t)." (defcustom org-provide-todo-statistics t "Non-nil means, update todo statistics after insert and toggle. -When this is set, todo statistics is updated in the parent of the current -entry each time a todo state is changed." +ALL-HEADLINES means update todo statistics by including headlines +with no TODO keyword as well, counting them as not done. +A list of TODO keywords means the same, but skip keywords that are +not in this list. + +When this is set, todo statistics is updated in the parent of the +current entry each time a todo state is changed." + :group 'org-todo + :type '(choice + (const :tag "Yes, only for TODO entries" t) + (const :tag "Yes, including all entries" 'all-headlines) + (repeat :tag "Yes, for TODOs in this list" + (string :tag "TODO keyword")) + (other :tag "No TODO statistics" nil))) + +(defcustom org-hierarchical-todo-statistics t + "Non-nil means, TODO statistics covers just direct children. +When nil, all entries in the subtree are considered. +This has only an effect if `org-provide-todo-statistics' is set." :group 'org-todo :type 'boolean) @@ -1636,6 +1795,8 @@ TODO state changes "Non-nil means, undone TODO entries will block switching the parent to DONE. Also, if a parent has an :ORDERED: property, switching an entry to DONE will be blocked if any prior sibling is not yet done. +Finally, if the parent is blocked because of ordered siblings of its own, +the child will also be blocked. This variable needs to be set before org.el is loaded, and you need to restart Emacs after a change to make the change effective. The only way to change is while Emacs is running is through the customize interface." @@ -1643,9 +1804,9 @@ to change is while Emacs is running is through the customize interface." (set var val) (if val (add-hook 'org-blocker-hook - 'org-block-todo-from-children-or-siblings) + 'org-block-todo-from-children-or-siblings-or-parent) (remove-hook 'org-blocker-hook - 'org-block-todo-from-children-or-siblings))) + 'org-block-todo-from-children-or-siblings-or-parent))) :group 'org-todo :type 'boolean) @@ -1667,6 +1828,22 @@ to change is while Emacs is running is through the customize interface." :group 'org-todo :type 'boolean) +(defcustom org-treat-insert-todo-heading-as-state-change nil + "Non-nil means, inserting a TODO heading is treated as state change. +So when the command \\[org-insert-todo-heading] is used, state change +logging will apply if appropriate. When nil, the new TODO item will +be inserted directly, and no logging will take place." + :group 'org-todo + :type 'boolean) + +(defcustom org-treat-S-cursor-todo-selection-as-state-change t + "Non-nil means, switching TODO states with S-cursor counts as state change. +This is the default behavior. However, setting this to nil allows a +convenient way to select a TODO state and bypass any logging associated +with that." + :group 'org-todo + :type 'boolean) + (defcustom org-todo-state-tags-triggers nil "Tag changes that should be triggered by TODO state changes. This is a list. Each entry is @@ -1737,7 +1914,7 @@ When nil, only the date will be recorded." (defcustom org-log-note-headings '((done . "CLOSING NOTE %t") - (state . "State %-12s %t") + (state . "State %-12s from %-12S %t") (note . "Note taken on %t") (clock-out . "")) "Headings for notes added to entries. @@ -1746,6 +1923,7 @@ 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. %s will be replaced by the new TODO state, in double quotes. +%S will be replaced by the old TODO state, in double quotes. %u will be replaced by the user name. %U will be replaced by the full user name." :group 'org-todo @@ -1761,12 +1939,51 @@ empty string. (unless (assq 'note org-log-note-headings) (push '(note . "%t") org-log-note-headings)) +(defcustom org-log-into-drawer nil + "Non-nil means, insert state change notes and time stamps into a drawer. +When nil, state changes notes will be inserted after the headline and +any scheduling and clock lines, but not inside a drawer. + +The value of this variable should be the name of the drawer to use. +LOGBOOK is proposed at the default drawer for this purpose, you can +also set this to a string to define the drawer of your choice. + +A value of t is also allowed, representing \"LOGBOOK\". + +If this variable is set, `org-log-state-notes-insert-after-drawers' +will be ignored. + +You can set the property LOG_INTO_DRAWER to overrule this setting for +a subtree." + :group 'org-todo + :group 'org-progress + :type '(choice + (const :tag "Not into a drawer" nil) + (const :tag "LOGBOOK" t) + (string :tag "Other"))) + +(if (fboundp 'defvaralias) + (defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)) + +(defun org-log-into-drawer () + "Return the value of `org-log-into-drawer', but let properties overrule. +If the current entry has or inherits a LOG_INTO_DRAWER property, it will be +used instead of the default value." + (let ((p (ignore-errors (org-entry-get nil "LOG_INTO_DRAWER" 'inherit)))) + (cond + ((or (not p) (equal p "nil")) org-log-into-drawer) + ((equal p "t") "LOGBOOK") + (t p)))) + (defcustom org-log-state-notes-insert-after-drawers nil "Non-nil means, insert state change notes after any drawers in entry. Only the drawers that *immediately* follow the headline and the deadline/scheduled line are skipped. When nil, insert notes right after the heading and perhaps the line -with deadline/scheduling if present." +with deadline/scheduling if present. + +This variable will have no effect if `org-log-into-drawer' is +set." :group 'org-todo :group 'org-progress :type 'boolean) @@ -1811,6 +2028,13 @@ property to one or more of these keywords." :tag "Org Priorities" :group 'org-todo) +(defcustom org-enable-priority-commands t + "Non-nil means, priority commands are active. +When nil, these commands will be disabled, so that you never accidentally +set a priority." + :group 'org-priorities + :type 'boolean) + (defcustom org-highest-priority ?A "The highest priority of TODO items. A character like ?A, ?B etc. Must have a smaller ASCII number than `org-lowest-priority'." @@ -1897,7 +2121,8 @@ To turn this on on a per-file basis, insert anywhere in the file: "Custom formats for time stamps. See `format-time-string' for the syntax. These are overlayed over the default ISO format if the variable `org-display-custom-times' is set. Time like %H:%M should be at the -end of the second format." +end of the second format. The custom formats are also honored by export +commands, if custom time display is turned on at the time of export." :group 'org-time :type 'sexp) @@ -1919,10 +2144,12 @@ org-mode generates a time duration." "No. of days before expiration during which a deadline becomes active. This variable governs the display in sparse trees and in the agenda. When 0 or negative, it means use this number (the absolute value of it) -even if a deadline has a different individual lead time specified." +even if a deadline has a different individual lead time specified. + +Custom commands can set this variable in the options section." :group 'org-time :group 'org-agenda-daily/weekly - :type 'number) + :type 'integer) (defcustom org-read-date-prefer-future t "Non-nil means, assume future for incomplete date input from user. @@ -1959,6 +2186,13 @@ When nil, only the minibuffer will be available." (defvaralias 'org-popup-calendar-for-date-prompt 'org-read-date-popup-calendar)) +(defcustom org-read-date-minibuffer-setup-hook nil + "Hook to be used to set up keys for the date/time interface. +Add key definitions to `minibuffer-local-map', which will be a temporary +copy." + :group 'org-time + :type 'hook) + (defcustom org-extend-today-until 0 "The hour when your day really ends. Must be an integer. This has influence for the following applications: @@ -1972,7 +2206,7 @@ IMPORTANT: This is a feature whose implementation is and likely will remain incomplete. Really, it is only here because past midnight seems to be the favorite working time of John Wiegley :-)" :group 'org-time - :type 'number) + :type 'integer) (defcustom org-edit-timestamp-down-means-later nil "Non-nil means, S-down will increase the time in a time stamp. @@ -2006,7 +2240,28 @@ See the manual for details." (cons (string :tag "Tag name") (character :tag "Access char")) (const :tag "Start radio group" (:startgroup)) - (const :tag "End radio group" (:endgroup))))) + (const :tag "End radio group" (:endgroup)) + (const :tag "New line" (:newline))))) + +(defcustom org-tag-persistent-alist nil + "List of tags that will always appear in all Org-mode files. +This is in addition to any in buffer settings or customizations +of `org-tag-alist'. +When this list is nil, Org-mode will base TAG input on `org-tag-alist'. +The value of this variable is an alist, the car of each entry must be a +keyword as a string, the cdr may be a character that is used to select +that tag through the fast-tag-selection interface. +See the manual for details. +To disable these tags on a per-file basis, insert anywhere in the file: + #+STARTUP: noptag" + :group 'org-tags + :type '(repeat + (choice + (cons (string :tag "Tag name") + (character :tag "Access char")) + (const :tag "Start radio group" (:startgroup)) + (const :tag "End radio group" (:endgroup)) + (const :tag "New line" (:newline))))) (defvar org-file-tags nil "List of tags that can be inherited by all entries in the file. @@ -2102,23 +2357,35 @@ see the variable `org-use-tag-inheritance'." (t (error "Invalid setting of `org-use-tag-inheritance'")))) (defcustom org-tags-match-list-sublevels t - "Non-nil means list also sublevels of headlines matching tag search. + "Non-nil means list also sublevels of headlines matching a search. +This variable applies to tags/property searches, and also to stuck +projects because this search is based on a tags match as well. + +When set to the symbol `indented', sublevels are indented with +leading dots. + Because of tag inheritance (see variable `org-use-tag-inheritance'), the sublevels of a headline matching a tag search often also match the same search. Listing all of them can create very long lists. Setting this variable to nil causes subtrees of a match to be skipped. -This option is off by default, because inheritance in on. If you turn -inheritance off, you very likely want to turn this option on. - -As a special case, if the tag search is restricted to TODO items, the -value of this variable is ignored and sublevels are always checked, to -make sure all corresponding TODO items find their way into the list. This variable is semi-obsolete and probably should always be true. It is better to limit inheritance to certain tags using the variables `org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'." :group 'org-tags - :type 'boolean) + :type '(choice + (const :tag "No, don't list them" nil) + (const :tag "Yes, do list them" t) + (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" + :group 'org-tags + :type '(choice + (const :tag "No sorting" nil) + (const :tag "Alphabetical" string<) + (const :tag "Reverse alphabetical" string>) + (function :tag "Custom function" nil))) (defvar org-tags-history nil "History of minibuffer reads for tags.") @@ -2220,13 +2487,26 @@ Effort estimates given in this property need to have the format H:MM." :type '(string :tag "Property")) (defconst org-global-properties-fixed - '(("VISIBILITY_ALL" . "folded children content all")) + '(("VISIBILITY_ALL" . "folded children content all") + ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto")) "List of property/value pairs that can be inherited by any entry. -These are fixed values, for the preset properties.") +These are fixed values, for the preset properties. The user variable +that can be used to add to this list is `org-global-properties'. + +The entries in this list are cons cells where the car is a property +name and cdr is a string with the value. If the value represents +multiple items like an \"_ALL\" property, separate the items by +spaces.") (defcustom org-global-properties nil "List of property/value pairs that can be inherited by any entry. + +This list will be combined with the constant `org-global-properties-fixed'. + +The entries in this list are cons cells where the car is a property +name and cdr is a string with the value. + You can set buffer-local values for the same purpose in the variable `org-file-properties' this by adding lines like @@ -2419,6 +2699,13 @@ Changing this variable requires a restart of Emacs to take effect." :group 'org-font-lock :type 'boolean) +(defcustom org-fontify-whole-heading-line nil + "Non-nil means fontify the whole line for headings. +This is useful when setting a background color for the +org-leve-* faces." + :group 'org-font-lock + :type 'boolean) + (defcustom org-highlight-latex-fragments-and-specials nil "Non-nil means, fontify what is treated specially by the exporters." :group 'org-font-lock @@ -2491,7 +2778,7 @@ Changing this variable requires a restart of Emacs to take effect." "\\([" post "]\\|$\\)"))))) (defcustom org-emphasis-regexp-components - '(" \t('\"" "- \t.,:?;'\")" " \t\r\n,\"'" "." 1) + '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1) "Components used to build the regular expression for emphasis. This is a list with 6 entries. Terminology: In an emphasis string like \" *strong word* \", we call the initial space PREMATCH, the final @@ -2531,6 +2818,7 @@ Text starting and ending with a special character will be emphasized, for example *bold*, _underlined_ and /italic/. This variable sets the marker characters, the face to be used by font-lock for highlighting in Org-mode Emacs buffers, and the HTML tags to be used for this. +For LaTeX export, see the variable `org-export-latex-emphasis-alist'. Use customize to modify this, or restart Emacs after changing it." :group 'org-font-lock :set 'org-set-emph-re @@ -2544,6 +2832,11 @@ Use customize to modify this, or restart Emacs after changing it." (string :tag "HTML end tag") (option (const verbatim))))) +(defvar org-protecting-blocks + '("src" "example" "latex" "ascii" "html" "docbook" "ditaa" "dot" "r" "R") + "Blocks that contain text that is quoted, i.e. not processed as Org syntax. +This is needed for font-lock setup.") + ;;; Miscellaneous options (defgroup org-completion nil @@ -2606,7 +2899,8 @@ Normal means, no org-mode-specific context." (declare-function org-agenda-copy-local-variable "org-agenda" (var)) (declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item "org-agenda" (&optional end)) - +(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) +(declare-function org-indent-mode "org-indent" (arg)) (declare-function parse-time-string "parse-time" (string)) (declare-function remember "remember" (&optional initial)) (declare-function remember-buffer-desc "remember" ()) @@ -2734,26 +3028,37 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (while (re-search-forward org-table-any-line-regexp nil t) (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size))) (beginning-of-line 1) - (if (looking-at org-table-line-regexp) - (save-excursion (funcall function))) + (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")) -;; Declare and autoload functions from org-exp.el +;; Declare and autoload functions from org-exp.el & Co (declare-function org-default-export-plist "org-exp") (declare-function org-infile-export-plist "org-exp") (declare-function org-get-current-options "org-exp") (eval-and-compile (org-autoload "org-exp" - '(org-export org-export-as-ascii org-export-visible - org-insert-export-options-template org-export-as-html-and-open - org-export-as-html-batch org-export-as-html-to-buffer - org-replace-region-by-html org-export-region-as-html - org-export-as-html org-export-icalendar-this-file - org-export-icalendar-all-agenda-files - org-table-clean-before-export - org-export-icalendar-combine-agenda-files org-export-as-xoxo))) + '(org-export org-export-visible + org-insert-export-options-template + org-table-clean-before-export)) + (org-autoload "org-ascii" + '(org-export-as-ascii org-export-ascii-preprocess + org-export-as-ascii-to-buffer org-replace-region-by-ascii + org-export-region-as-ascii)) + (org-autoload "org-html" + '(org-export-as-html-and-open + org-export-as-html-batch org-export-as-html-to-buffer + org-replace-region-by-html org-export-region-as-html + org-export-as-html)) + (org-autoload "org-icalendar" + '(org-export-icalendar-this-file + org-export-icalendar-all-agenda-files + org-export-icalendar-combine-agenda-files)) + (org-autoload "org-xoxo" '(org-export-as-xoxo))) ;; Declare and autoload functions from org-agenda.el @@ -2780,6 +3085,10 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (defvar org-clock-start-time) (defvar org-clock-marker (make-marker) "Marker recording the last clock-in.") +(defun org-clock-is-active () + "Return non-nil if clock is currently running. +The return value is actually the clock marker." + (marker-buffer org-clock-marker)) (eval-and-compile (org-autoload @@ -2849,14 +3158,29 @@ If yes, offer to stop it and to save the buffer with the changes." ;; Autoload org-timer.el -;(declare-function org-timer "org-timer") - (eval-and-compile (org-autoload "org-timer" '(org-timer-start org-timer org-timer-item - org-timer-change-times-in-region))) + org-timer-change-times-in-region + org-timer-set-timer + org-timer-reset-timers + org-timer-show-remaining-time))) + +;; Autoload org-feed.el +(eval-and-compile + (org-autoload + "org-feed" + '(org-feed-update org-feed-update-all org-feed-goto-inbox))) + + +;; Autoload org-indent.el + +(eval-and-compile + (org-autoload + "org-indent" + '(org-indent-mode))) ;; Autoload archiving code ;; The stuff that is needed for cycling and tags has to be defined here. @@ -2935,6 +3259,12 @@ Instead, use the key `v' to cycle the archives-mode in the agenda." :group 'org-agenda-skip :type 'boolean) +(defcustom org-columns-skip-arrchived-trees t + "Non-nil means, irgnore archived trees when creating column view." + :group 'org-archive + :group 'org-properties + :type 'boolean) + (defcustom org-cycle-open-archived-trees nil "Non-nil means, `org-cycle' will open archived trees. An archived tree is a tree marked with the tag ARCHIVE. @@ -3003,12 +3333,20 @@ collapsed state." ;; Autoload ID code (declare-function org-id-store-link "org-id") +(declare-function org-id-locations-load "org-id") +(declare-function org-id-locations-save "org-id") +(defvar org-id-track-globally) (org-autoload "org-id" '(org-id-get-create org-id-new org-id-copy org-id-get org-id-get-with-outline-path-completion org-id-get-with-outline-drilling org-id-goto org-id-find org-id-store-link)) +;; Autoload Plotting Code + +(org-autoload "org-plot" + '(org-plot/gnuplot)) + ;;; Variables for pre-computed regular expressions, all buffer local (defvar org-drawer-regexp nil @@ -3020,6 +3358,9 @@ collapsed state." (defvar org-not-done-regexp nil "Matches any of the TODO state keywords except the last one.") (make-variable-buffer-local 'org-not-done-regexp) +(defvar org-not-done-heading-regexp nil + "Matches a TODO headline that is not done.") +(make-variable-buffer-local 'org-not-done-regexp) (defvar org-todo-line-regexp nil "Matches a headline and puts TODO state into group 2 if present.") (make-variable-buffer-local 'org-todo-line-regexp) @@ -3122,6 +3463,8 @@ After a match, the following groups carry important information: ("nofold" org-startup-folded nil) ("showall" org-startup-folded nil) ("content" org-startup-folded content) + ("indent" org-startup-indented t) + ("noindent" org-startup-indented nil) ("hidestars" org-hide-leading-stars t) ("showstars" org-hide-leading-stars nil) ("odd" org-odd-levels-only t) @@ -3144,8 +3487,13 @@ After a match, the following groups carry important information: ("fnprompt" org-footnote-auto-label nil) ("fnconfirm" org-footnote-auto-label confirm) ("fnplain" org-footnote-auto-label plain) + ("fnadjust" org-footnote-auto-adjust t) + ("nofnadjust" org-footnote-auto-adjust nil) ("constcgs" constants-unit-system cgs) - ("constSI" constants-unit-system SI)) + ("constSI" constants-unit-system SI) + ("noptag" org-tag-persistent-alist nil) + ("hideblocks" org-hide-block-startup t) + ("nohideblocks" org-hide-block-startup 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 @@ -3166,9 +3514,10 @@ means to push this value onto the list in the variable.") (org-set-local 'org-file-properties nil) (org-set-local 'org-file-tags nil) (let ((re (org-make-options-regexp - '("CATEGORY" "SEQ_TODO" "TYP_TODO" "TODO" "COLUMNS" + '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" "FILETAGS" "TAGS" "LINK" "PRIORITIES" - "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE"))) + "CONSTANTS" "PROPERTY" "DRAWERS" "SETUPFILE") + "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)")) (splitre "[ \t]+") kwds kws0 kwsa key log value cat arch tags const links hw dws tail sep kws1 prio props ftags drawers @@ -3193,8 +3542,13 @@ means to push this value onto the list in the variable.") (push (cons 'sequence (org-split-string value splitre)) kwds)) ((equal key "TYP_TODO") (push (cons 'type (org-split-string value splitre)) kwds)) + ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key) + ;; general TODO-like setup + (push (cons (intern (downcase (match-string 1 key))) + (org-split-string value splitre)) kwds)) ((equal key "TAGS") - (setq tags (append tags (org-split-string value splitre)))) + (setq tags (append tags (if tags '("\\n") nil) + (org-split-string value splitre)))) ((equal key "COLUMNS") (org-set-local 'org-columns-default-format value)) ((equal key "LINK") @@ -3259,7 +3613,8 @@ means to push this value onto the list in the variable.") (org-set-local 'org-lowest-priority (nth 1 prio)) (org-set-local 'org-default-priority (nth 2 prio))) (and props (org-set-local 'org-file-properties (nreverse props))) - (and ftags (org-set-local 'org-file-tags ftags)) + (and ftags (org-set-local 'org-file-tags + (mapcar 'org-add-prop-inherited ftags))) (and drawers (org-set-local 'org-drawers drawers)) (and arch (org-set-local 'org-archive-location arch)) (and links (setq org-link-abbrev-alist-local (nreverse links))) @@ -3274,28 +3629,32 @@ means to push this value onto the list in the variable.") (setq kwds (nreverse kwds)) (let (inter kws kw) (while (setq kws (pop kwds)) - (setq inter (pop kws) sep (member "|" kws) - kws0 (delete "|" (copy-sequence kws)) - kwsa nil - kws1 (mapcar - (lambda (x) - ;; 1 2 - (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) - (progn - (setq kw (match-string 1 x) - key (and (match-end 2) (match-string 2 x)) - log (org-extract-log-state-settings x)) - (push (cons kw (and key (string-to-char key))) kwsa) - (and log (push log org-todo-log-states)) - kw) - (error "Invalid TODO keyword %s" x))) - kws0) - kwsa (if kwsa (append '((:startgroup)) - (nreverse kwsa) - '((:endgroup)))) - hw (car kws1) - dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) - tail (list inter hw (car dws) (org-last dws))) + (let ((kws (or + (run-hook-with-args-until-success + 'org-todo-setup-filter-hook kws) + kws))) + (setq inter (pop kws) sep (member "|" kws) + kws0 (delete "|" (copy-sequence kws)) + kwsa nil + kws1 (mapcar + (lambda (x) + ;; 1 2 + (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) + (progn + (setq kw (match-string 1 x) + key (and (match-end 2) (match-string 2 x)) + log (org-extract-log-state-settings x)) + (push (cons kw (and key (string-to-char key))) kwsa) + (and log (push log org-todo-log-states)) + kw) + (error "Invalid TODO keyword %s" x))) + kws0) + kwsa (if kwsa (append '((:startgroup)) + (nreverse kwsa) + '((:endgroup)))) + hw (car kws1) + dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) + tail (list inter hw (car dws) (org-last dws)))) (add-to-list 'org-todo-heads hw 'append) (push kws1 org-todo-sets) (setq org-done-keywords (append org-done-keywords dws nil)) @@ -3321,6 +3680,7 @@ means to push this value onto the list in the variable.") (cond ((equal e "{") (push '(:startgroup) tgs)) ((equal e "}") (push '(:endgroup) tgs)) + ((equal e "\\n") (push '(:newline) tgs)) ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e) (push (cons (match-string 1 e) (string-to-char (match-string 2 e))) @@ -3352,6 +3712,10 @@ means to push this value onto the list in the variable.") (concat "\\<\\(" (mapconcat 'regexp-quote org-not-done-keywords "\\|") "\\)\\>") + org-not-done-heading-regexp + (concat "^\\(\\*+\\)[ \t]+\\(" + (mapconcat 'regexp-quote org-not-done-keywords "\\|") + "\\)\\>") org-todo-line-regexp (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") @@ -3457,6 +3821,7 @@ Respect keys that are already there." (cond ((equal e '(:startgroup)) (push e new)) ((equal e '(:endgroup)) (push e new)) + ((equal e '(:newline)) (push e new)) (t (setq k (car e) c2 nil) (if (cdr e) @@ -3485,10 +3850,8 @@ This is for getting out of special buffers like remember.") ;; FIXME: Occasionally check by commenting these, to make sure ;; no other functions uses these, forgetting to let-bind them. (defvar entry) -(defvar state) (defvar last-state) (defvar date) -(defvar description) ;; Defined somewhere in this file, but used before definition. (defvar org-html-entities) @@ -3517,6 +3880,8 @@ This variable is set by `org-before-change-function'. "Mode hook for Org-mode, run after the mode was turned on.") (defvar org-inhibit-startup nil) ; Dynamically-scoped param. (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. +(defvar org-inhibit-logging nil) ; Dynamically-scoped param. +(defvar org-inhibit-blocking nil) ; Dynamically-scoped param. (defvar org-table-buffer-is-an nil) (defconst org-outline-regexp "\\*+ ") @@ -3560,6 +3925,7 @@ The following commands are available: (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)) (when (featurep 'xemacs) (org-set-local 'line-move-ignore-invisible t)) (org-set-local 'outline-regexp org-outline-regexp) @@ -3601,9 +3967,9 @@ The following commands are available: ;; too late :-( (if org-enforce-todo-dependencies (add-hook 'org-blocker-hook - 'org-block-todo-from-children-or-siblings) + 'org-block-todo-from-children-or-siblings-or-parent) (remove-hook 'org-blocker-hook - 'org-block-todo-from-children-or-siblings)) + 'org-block-todo-from-children-or-siblings-or-parent)) (if org-enforce-todo-checkbox-dependencies (add-hook 'org-blocker-hook 'org-block-todo-from-checkboxes) @@ -3645,6 +4011,9 @@ The following commands are available: (let ((bmp (buffer-modified-p))) (org-table-map-tables 'org-table-align) (set-buffer-modified-p bmp))) + (when org-startup-indented + (require 'org-indent) + (org-indent-mode 1)) (org-set-startup-visibility))) (put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) @@ -3671,9 +4040,6 @@ The following commands are available: (when org-tab-follows-link (org-defkey org-mouse-map [(tab)] 'org-open-at-point) (org-defkey org-mouse-map "\C-i" 'org-open-at-point)) -(when org-return-follows-link - (org-defkey org-mouse-map [(return)] 'org-open-at-point) - (org-defkey org-mouse-map "\C-m" 'org-open-at-point)) (require 'font-lock) @@ -3796,16 +4162,19 @@ The time stamps may be either active or inactive.") (defun org-do-emphasis-faces (limit) "Run through the buffer and add overlays to links." - (let (rtn) + (let (rtn a) (while (and (not rtn) (re-search-forward org-emph-re limit t)) (if (not (= (char-after (match-beginning 3)) (char-after (match-beginning 4)))) (progn (setq rtn t) + (setq a (assoc (match-string 3) org-emphasis-alist)) (font-lock-prepend-text-property (match-beginning 2) (match-end 2) 'face - (nth 1 (assoc (match-string 3) - org-emphasis-alist))) + (nth 1 a)) + (and (nth 4 a) + (org-remove-flyspell-overlays-in + (match-beginning 0) (match-end 0))) (add-text-properties (match-beginning 2) (match-end 2) '(font-lock-multiline t)) (when org-hide-emphasis-markers @@ -3871,55 +4240,115 @@ will be prompted for." (defconst org-nonsticky-props '(mouse-face highlight keymap invisible intangible help-echo org-linked-text)) +(defsubst org-rear-nonsticky-at (pos) + (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props))) (defun org-activate-plain-links (limit) "Run through the buffer and add overlays to links." (catch 'exit (let (f) - (while (re-search-forward org-plain-link-re limit t) - (setq f (get-text-property (match-beginning 0) 'face)) - (if (or (eq f 'org-tag) - (and (listp f) (memq 'org-tag f))) - nil - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map - )) - (throw 'exit t)))))) + (if (re-search-forward org-plain-link-re limit t) + (progn + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (setq f (get-text-property (match-beginning 0) 'face)) + (if (or (eq f 'org-tag) + (and (listp f) (memq 'org-tag f))) + nil + (add-text-properties (match-beginning 0) (match-end 0) + (list 'mouse-face 'highlight + 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 0))) + t))))) (defun org-activate-code (limit) (if (re-search-forward "^[ \t]*\\(: .*\n?\\)" limit t) (progn + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (remove-text-properties (match-beginning 0) (match-end 0) '(display t invisible t intangible t)) t))) +(defun org-fontify-meta-lines-and-blocks (limit) + "Fontify #+ lines and blocks, in the correct ways." + (let ((case-fold-search t)) + (if (re-search-forward + "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\)\\(_\\([a-zA-Z]+\\)\\)?\\)\\(.*\\)\\)" + limit t) + (let ((beg (match-beginning 0)) + (beg1 (line-beginning-position 2)) + (dc1 (downcase (match-string 2))) + (dc3 (downcase (match-string 3))) + end end1 quoting) + (cond + ((member dc1 '("html:" "ascii:" "latex:" "docbook:")) + ;; a single line of backend-specific content + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) + (add-text-properties (match-beginning 1) (match-end 3) + '(font-lock-fontified t face org-meta-line)) + (add-text-properties (match-beginning 6) (match-end 6) + '(font-lock-fontified t face org-block)) + t) + ((and (match-end 4) (equal dc3 "begin")) + ;; Truely a block + (setq quoting (member (downcase (match-string 5)) + org-protecting-blocks)) + (when (re-search-forward + (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") + nil t) ;; on purpose, we look further than LIMIT + (setq end (match-end 0) end1 (1- (match-beginning 0))) + (when quoting + (remove-text-properties beg end + '(display t invisible t intangible t))) + (add-text-properties + beg end + '(font-lock-fontified t font-lock-multiline t)) + (add-text-properties beg beg1 '(face org-meta-line)) + (add-text-properties end1 end '(face org-meta-line)) + (when quoting + (add-text-properties beg1 end1 '(face org-block))) + t)) + ((not (member (char-after beg) '(?\ ?\t))) + ;; just any other in-buffer setting, but not indented + (add-text-properties + beg (match-end 0) + '(font-lock-fontified t face org-meta-line)) + t) + ((or (member dc1 '("caption:" "label:" "orgtbl:" "tblfm:" "tblname:")) + (and (match-end 4) (equal dc3 "attr"))) + (add-text-properties + beg (match-end 0) + '(font-lock-fontified t face org-meta-line)) + t) + (t nil)))))) + (defun org-activate-angle-links (limit) "Run through the buffer and add overlays to links." (if (re-search-forward org-angle-link-re limit t) (progn + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (add-text-properties (match-beginning 0) (match-end 0) (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map - )) + 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 0)) t))) (defun org-activate-footnote-links (limit) "Run through the buffer and add overlays to links." - (if (re-search-forward "\\(^\\|[^][]\\)\\(\\[\\([0-9]+\\]\\|fn:[^ \t\r\n:]+?[]:]\\)\\)" + (if (re-search-forward "\\(^\\|[^][]\\)\\(\\[\\([0-9]+\\]\\|fn:[^ \t\r\n:]+?[]:]\\)\\)" limit t) (progn + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (add-text-properties (match-beginning 2) (match-end 2) (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props 'keymap org-mouse-map 'help-echo (if (= (point-at-bol) (match-beginning 2)) "Footnote definition" "Footnote reference") )) + (org-rear-nonsticky-at (match-end 2)) t))) (defun org-activate-bracket-links (limit) @@ -3931,34 +4360,41 @@ will be prompted for." ;; but that requires another match, protecting match data, ;; a lot of overhead for font-lock. (ip (org-maybe-intangible - (list 'invisible 'org-link 'rear-nonsticky org-nonsticky-props + (list 'invisible 'org-link 'keymap org-mouse-map 'mouse-face 'highlight 'font-lock-multiline t 'help-echo help))) - (vp (list 'rear-nonsticky org-nonsticky-props - 'keymap org-mouse-map 'mouse-face 'highlight - ' font-lock-multiline t 'help-echo help))) + (vp (list 'keymap org-mouse-map 'mouse-face 'highlight + 'font-lock-multiline t 'help-echo help))) ;; We need to remove the invisible property here. Table narrowing ;; may have made some of this invisible. + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (remove-text-properties (match-beginning 0) (match-end 0) '(invisible nil)) (if (match-end 3) (progn (add-text-properties (match-beginning 0) (match-beginning 3) ip) + (org-rear-nonsticky-at (match-beginning 3)) (add-text-properties (match-beginning 3) (match-end 3) vp) - (add-text-properties (match-end 3) (match-end 0) ip)) + (org-rear-nonsticky-at (match-end 3)) + (add-text-properties (match-end 3) (match-end 0) ip) + (org-rear-nonsticky-at (match-end 0))) (add-text-properties (match-beginning 0) (match-beginning 1) ip) + (org-rear-nonsticky-at (match-beginning 1)) (add-text-properties (match-beginning 1) (match-end 1) vp) - (add-text-properties (match-end 1) (match-end 0) ip)) + (org-rear-nonsticky-at (match-end 1)) + (add-text-properties (match-end 1) (match-end 0) ip) + (org-rear-nonsticky-at (match-end 0))) t))) (defun org-activate-dates (limit) "Run through the buffer and add overlays to dates." (if (re-search-forward org-tsr-regexp-both limit t) (progn + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (add-text-properties (match-beginning 0) (match-end 0) (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 0)) (when org-display-custom-times (if (match-end 3) (org-display-custom-time (match-beginning 3) (match-end 3))) @@ -3981,12 +4417,13 @@ will be prompted for." (let ((case-fold-search t)) (if (re-search-forward org-target-link-regexp limit t) (progn + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (add-text-properties (match-beginning 0) (match-end 0) (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props 'keymap org-mouse-map 'help-echo "Radio target link" 'org-linked-text t)) + (org-rear-nonsticky-at (match-end 0)) t))))) (defun org-update-radio-target-regexp () @@ -4045,7 +4482,10 @@ will be prompted for." (regexp-opt (append (mapcar 'car org-html-entities) (if (boundp 'org-latex-entities) - org-latex-entities nil)) + (mapcar (lambda (x) + (or (car-safe x) x)) + org-latex-entities) + nil)) 'words))) ; FIXME )) ;; (list "\\\\\\(?:[a-zA-Z]+\\)"))) @@ -4119,10 +4559,11 @@ between words." (defun org-activate-tags (limit) (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) (progn + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (add-text-properties (match-beginning 1) (match-end 1) (list 'mouse-face 'highlight - 'rear-nonsticky org-nonsticky-props 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 1)) t))) (defun org-outline-level () @@ -4151,8 +4592,12 @@ between words." ;; Call the hook '(org-font-lock-hook) ;; Headlines - '("^\\(\\**\\)\\(\\* \\)\\(.*\\)" (1 (org-get-level-face 1)) - (2 (org-get-level-face 2)) (3 (org-get-level-face 3))) + `(,(if org-fontify-whole-heading-line + "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)" + "^\\(\\**\\)\\(\\* \\)\\(.*\\)") + (1 (org-get-level-face 1)) + (2 (org-get-level-face 2)) + (3 (org-get-level-face 3))) ;; Table lines '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" (1 'org-table t)) @@ -4160,6 +4605,7 @@ between words." '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t)) '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) + '("| *\\(<[lr]?[0-9]*>\\)" (1 'org-formula t)) ;; Drawers (list org-drawer-regexp '(0 'org-special-keyword t)) (list "^[ \t]*:END:" '(0 'org-special-keyword t)) @@ -4167,8 +4613,6 @@ between words." (list org-property-re '(1 'org-special-keyword t) '(3 'org-property-value t)) - (if org-format-transports-properties-p - '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) ;; Links (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) @@ -4181,7 +4625,7 @@ between words." '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) '(org-hide-wide-columns (0 nil append)) ;; TODO lines - (list (concat "^\\*+[ \t]+" org-todo-regexp) + (list (concat "^\\*+[ \t]+" org-todo-regexp "\\([ \t]\\|$\\)") '(1 (org-get-todo-face 1) t)) ;; DONE (if org-fontify-done-headline @@ -4191,7 +4635,7 @@ between words." '(2 'org-headline-done t)) nil) ;; Priorities - (list (concat "\\[#[A-Z0-9]\\]") '(0 'org-special-keyword t)) + '(org-font-lock-add-priority-faces) ;; Tags '(org-font-lock-add-tag-faces) ;; Special keywords @@ -4206,13 +4650,14 @@ between words." '(org-do-emphasis-faces))) ;; Checkboxes '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)" - 2 'bold prepend) + 2 'org-checkbox prepend) (if org-provide-checkbox-statistics '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" (0 (org-get-checkbox-statistics-face) t))) ;; Description list items '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(.*? ::\\)" 2 'bold prepend) + ;; ARCHIVEd headings (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") '(1 'org-archived prepend)) ;; Specials @@ -4224,6 +4669,8 @@ between words." "\\|" org-quote-string "\\)\\>") '(1 'org-special-keyword t)) '("^#.*" (0 'font-lock-comment-face t)) + ;; Blocks and meta lines + '(org-fontify-meta-lines-and-blocks) ))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) ;; Now set the full font-lock-keywords @@ -4232,6 +4679,15 @@ between words." '(org-font-lock-keywords t nil nil backward-paragraph)) (kill-local-variable 'font-lock-keywords) nil)) +(defun org-fontify-like-in-org-mode (s &optional odd-levels) + "Fontify string S like in Org-mode" + (with-temp-buffer + (insert s) + (let ((org-odd-levels-only odd-levels)) + (org-mode) + (font-lock-fontify-buffer) + (buffer-string)))) + (defvar org-m nil) (defvar org-l nil) (defvar org-f nil) @@ -4262,6 +4718,16 @@ If KWD is a number, get the corresponding match group." 'font-lock-fontified t)) (backward-char 1)))) +(defun org-font-lock-add-priority-faces (limit) + "Add the special priority faces." + (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t) + (add-text-properties + (match-beginning 0) (match-end 0) + (list 'face (or (cdr (assoc (char-after (match-beginning 1)) + org-priority-faces)) + 'org-special-keyword) + 'font-lock-fontified t)))) + (defun org-get-tag-face (kwd) "Get the right face for a TODO keyword KWD. If KWD is a number, get the corresponding match group." @@ -4278,7 +4744,9 @@ If KWD is a number, get the corresponding match group." deactivate-mark buffer-file-name buffer-file-truename) (remove-text-properties beg end '(mouse-face t keymap t org-linked-text t - invisible t intangible t)))) + invisible t intangible t + line-prefix t wrap-prefix t + org-no-flyspell t)))) ;;;; Visibility cycling, including org-goto and indirect buffer @@ -4290,19 +4758,28 @@ If KWD is a number, get the corresponding match group." (make-variable-buffer-local 'org-cycle-subtree-status) ;;;###autoload + +(defvar org-inlinetask-min-level) + (defun org-cycle (&optional arg) - "Visibility cycling for Org-mode. + "TAB-action and visibility cycling for Org-mode. + +This is the command invoked in Org-moe by the TAB key. It's main purpose +is outine visibility cycling, but it also invokes other actions +in special contexts. - When this function is called with a prefix argument, rotate the entire buffer through 3 states (global cycling) 1. OVERVIEW: Show only top-level headlines. 2. CONTENTS: Show all headlines of all levels, but no body text. 3. SHOW ALL: Show everything. - When called with two C-u C-u prefixes, switch to the startup visibility, + When called with two `C-u C-u' prefixes, switch to the startup visibility, determined by the variable `org-startup-folded', and by any VISIBILITY properties in the buffer. - When called with three C-u C-u C-u prefixed, show the entire buffer, - including drawers. + When called with three `C-u C-u C-u' prefixed, show the entire buffer, + including any drawers. + +- When inside a table, re-align the table and move to the next field. - When point is at the beginning of a headline, rotate the subtree started by this line through 3 different states (local cycling) @@ -4311,6 +4788,7 @@ If KWD is a number, get the corresponding match group." From this state, you can move to one of the children and zoom in further. 3. SUBTREE: Show the entire subtree, including body text. + If there is no subtree, switch directly from CHILDREN to FOLDED. - When there is a numeric prefix, go up to a heading with level ARG, do a `show-subtree' and return to the previous cursor position. If ARG @@ -4325,166 +4803,220 @@ If KWD is a number, get the corresponding match group." But only if also the variable `org-cycle-global-at-bob' is t." (interactive "P") (org-load-modules-maybe) - (let* ((outline-regexp - (if (and (org-mode-p) org-cycle-include-plain-lists) - "\\(?:\\*+ \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)" - outline-regexp)) - (bob-special (and org-cycle-global-at-bob (bobp) - (not (looking-at outline-regexp)))) - (org-cycle-hook - (if bob-special - (delq 'org-optimize-window-after-visibility-change - (copy-sequence org-cycle-hook)) - org-cycle-hook)) - (pos (point))) - - (if (or bob-special (equal arg '(4))) - ;; special case: use global cycling - (setq arg t)) + (unless (run-hook-with-args-until-success 'org-tab-first-hook) + (let* ((limit-level + (or org-cycle-max-level + (and (boundp 'org-inlinetask-min-level) + org-inlinetask-min-level + (1- org-inlinetask-min-level)))) + (nstars (and limit-level + (if org-odd-levels-only + (and limit-level (1- (* limit-level 2))) + limit-level))) + (outline-regexp + (cond + ((not (org-mode-p)) outline-regexp) + ((or (eq org-cycle-include-plain-lists 'integrate) + (and org-cycle-include-plain-lists (org-at-item-p))) + (concat "\\(?:\\*" + (if nstars (format "\\{1,%d\\}" nstars) "+") + " \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)")) + (t (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))) + (bob-special (and org-cycle-global-at-bob (bobp) + (not (looking-at outline-regexp)))) + (org-cycle-hook + (if bob-special + (delq 'org-optimize-window-after-visibility-change + (copy-sequence org-cycle-hook)) + org-cycle-hook)) + (pos (point))) + + (if (or bob-special (equal arg '(4))) + ;; special case: use global cycling + (setq arg t)) - (cond + (cond - ((equal arg '(16)) - (org-set-startup-visibility) - (message "Startup visibility, plus VISIBILITY properties")) + ((equal arg '(16)) + (org-set-startup-visibility) + (message "Startup visibility, plus VISIBILITY properties")) - ((equal arg '(64)) - (show-all) - (message "Entire buffer visible, including drawers")) + ((equal arg '(64)) + (show-all) + (message "Entire buffer visible, including drawers")) - ((org-at-table-p 'any) - ;; Enter the table or move to the next field in the table - (or (org-table-recognize-table.el) - (progn - (if arg (org-table-edit-field t) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-field))))) + ((org-at-table-p 'any) + ;; Enter the table or move to the next field in the table + (or (org-table-recognize-table.el) + (progn + (if arg (org-table-edit-field t) + (org-table-justify-field-maybe) + (call-interactively 'org-table-next-field))))) + + ((run-hook-with-args-until-success + 'org-tab-after-check-for-table-hook)) + + ((eq arg t) ;; Global cycling + (org-cycle-internal-global)) + + ((and org-drawers org-drawer-regexp + (save-excursion + (beginning-of-line 1) + (looking-at org-drawer-regexp))) + ;; Toggle block visibility + (org-flag-drawer + (not (get-char-property (match-end 0) 'invisible)))) + + ((integerp arg) + ;; Show-subtree, ARG levels up from here. + (save-excursion + (org-back-to-heading) + (outline-up-heading (if (< arg 0) (- arg) + (- (funcall outline-level) arg))) + (org-show-subtree))) - ((eq arg t) ;; Global cycling + ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp)) + (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) - (cond - ((and (eq last-command this-command) - (eq org-cycle-global-status 'overview)) - ;; We just created the overview - now do table of contents - ;; This can be slow in very large buffers, so indicate action - (message "CONTENTS...") - (org-content) - (message "CONTENTS...done") - (setq org-cycle-global-status 'contents) - (run-hook-with-args 'org-cycle-hook 'contents)) - - ((and (eq last-command this-command) - (eq org-cycle-global-status 'contents)) - ;; We just showed the table of contents - now show everything - (show-all) - (message "SHOW ALL") - (setq org-cycle-global-status 'all) - (run-hook-with-args 'org-cycle-hook 'all)) + (org-cycle-internal-local)) - (t - ;; Default action: go to overview - (org-overview) - (message "OVERVIEW") - (setq org-cycle-global-status 'overview) - (run-hook-with-args 'org-cycle-hook 'overview)))) + ;; TAB emulation and template completion + (buffer-read-only (org-back-to-heading)) - ((and org-drawers org-drawer-regexp - (save-excursion - (beginning-of-line 1) - (looking-at org-drawer-regexp))) - ;; Toggle block visibility - (org-flag-drawer - (not (get-char-property (match-end 0) 'invisible)))) + ((run-hook-with-args-until-success + 'org-tab-after-check-for-cycling-hook)) - ((integerp arg) - ;; Show-subtree, ARG levels up from here. - (save-excursion - (org-back-to-heading) - (outline-up-heading (if (< arg 0) (- arg) - (- (funcall outline-level) arg))) - (org-show-subtree))) + ((org-try-structure-completion)) - ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp)) - (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) - ;; At a heading: rotate between three different views - (org-back-to-heading) - (let ((goal-column 0) eoh eol eos) - ;; First, some boundaries - (save-excursion - (org-back-to-heading) - (save-excursion - (beginning-of-line 2) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) (setq eol (point))) - (outline-end-of-heading) (setq eoh (point)) - (org-end-of-subtree t) - (unless (eobp) - (skip-chars-forward " \t\n") - (beginning-of-line 1) ; in case this is an item - ) - (setq eos (1- (point)))) - ;; Find out what to do next and set `this-command' - (cond - ((= eos eoh) - ;; Nothing is hidden behind this heading - (message "EMPTY ENTRY") - (setq org-cycle-subtree-status nil) - (save-excursion - (goto-char eos) - (outline-next-heading) - (if (org-invisible-p) (org-flag-heading nil)))) - ((or (>= eol eos) - (not (string-match "\\S-" (buffer-substring eol eos)))) - ;; Entire subtree is hidden in one line: open it - (org-show-entry) - (show-children) - (message "CHILDREN") - (save-excursion - (goto-char eos) - (outline-next-heading) - (if (org-invisible-p) (org-flag-heading nil))) - (setq org-cycle-subtree-status 'children) - (run-hook-with-args 'org-cycle-hook 'children)) - ((and (eq last-command this-command) - (eq org-cycle-subtree-status 'children)) - ;; We just showed the children, now show everything. - (org-show-subtree) - (message "SUBTREE") - (setq org-cycle-subtree-status 'subtree) - (run-hook-with-args 'org-cycle-hook 'subtree)) - (t - ;; Default action: hide the subtree. - (hide-subtree) - (message "FOLDED") - (setq org-cycle-subtree-status 'folded) - (run-hook-with-args 'org-cycle-hook 'folded))))) + ((org-try-cdlatex-tab)) - ;; TAB emulation and template completion - (buffer-read-only (org-back-to-heading)) + ((and (eq org-cycle-emulate-tab 'exc-hl-bol) + (or (not (bolp)) + (not (looking-at outline-regexp)))) + (call-interactively (global-key-binding "\t"))) - ((org-try-structure-completion)) + ((if (and (memq org-cycle-emulate-tab '(white whitestart)) + (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) + (or (and (eq org-cycle-emulate-tab 'white) + (= (match-end 0) (point-at-eol))) + (and (eq org-cycle-emulate-tab 'whitestart) + (>= (match-end 0) pos)))) + t + (eq org-cycle-emulate-tab t)) + (call-interactively (global-key-binding "\t"))) - ((org-try-cdlatex-tab)) + (t (save-excursion + (org-back-to-heading) + (org-cycle))))))) - ((and (eq org-cycle-emulate-tab 'exc-hl-bol) - (or (not (bolp)) - (not (looking-at outline-regexp)))) - (call-interactively (global-key-binding "\t"))) - - ((if (and (memq org-cycle-emulate-tab '(white whitestart)) - (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) - (or (and (eq org-cycle-emulate-tab 'white) - (= (match-end 0) (point-at-eol))) - (and (eq org-cycle-emulate-tab 'whitestart) - (>= (match-end 0) pos)))) - t - (eq org-cycle-emulate-tab t)) - (call-interactively (global-key-binding "\t"))) +(defun org-cycle-internal-global () + "Do the global cycling action." + (cond + ((and (eq last-command this-command) + (eq org-cycle-global-status 'overview)) + ;; We just created the overview - now do table of contents + ;; This can be slow in very large buffers, so indicate action + (run-hook-with-args 'org-pre-cycle-hook 'contents) + (message "CONTENTS...") + (org-content) + (message "CONTENTS...done") + (setq org-cycle-global-status 'contents) + (run-hook-with-args 'org-cycle-hook 'contents)) + + ((and (eq last-command this-command) + (eq org-cycle-global-status 'contents)) + ;; We just showed the table of contents - now show everything + (run-hook-with-args 'org-pre-cycle-hook 'all) + (show-all) + (message "SHOW ALL") + (setq org-cycle-global-status 'all) + (run-hook-with-args 'org-cycle-hook 'all)) - (t (save-excursion - (org-back-to-heading) - (org-cycle)))))) + (t + ;; Default action: go to overview + (run-hook-with-args 'org-pre-cycle-hook 'overview) + (org-overview) + (message "OVERVIEW") + (setq org-cycle-global-status 'overview) + (run-hook-with-args 'org-cycle-hook 'overview)))) + +(defun org-cycle-internal-local () + "Do the local cycling action." + (org-back-to-heading) + (let ((goal-column 0) eoh eol eos level has-children children-skipped) + ;; First, some boundaries + (save-excursion + (org-back-to-heading) + (setq level (funcall outline-level)) + (save-excursion + (beginning-of-line 2) + (if (or (featurep 'xemacs) (<= emacs-major-version 21)) + ; XEmacs does not have `next-single-char-property-change' + ; I'm not sure about Emacs 21. + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (beginning-of-line 2)) + (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)) + (save-excursion + (outline-next-heading) + (setq has-children (and (org-at-heading-p t) + (> (funcall outline-level) level)))) + (org-end-of-subtree t) + (unless (eobp) + (skip-chars-forward " \t\n") + (beginning-of-line 1) ; in case this is an item + ) + (setq eos (1- (point)))) + ;; Find out what to do next and set `this-command' + (cond + ((= eos eoh) + ;; Nothing is hidden behind this heading + (run-hook-with-args 'org-pre-cycle-hook 'empty) + (message "EMPTY ENTRY") + (setq org-cycle-subtree-status nil) + (save-excursion + (goto-char eos) + (outline-next-heading) + (if (org-invisible-p) (org-flag-heading nil)))) + ((and (or (>= eol eos) + (not (string-match "\\S-" (buffer-substring eol eos)))) + (or has-children + (not (setq children-skipped + org-cycle-skip-children-state-if-no-children)))) + ;; Entire subtree is hidden in one line: children view + (run-hook-with-args 'org-pre-cycle-hook 'children) + (org-show-entry) + (show-children) + (message "CHILDREN") + (save-excursion + (goto-char eos) + (outline-next-heading) + (if (org-invisible-p) (org-flag-heading nil))) + (setq org-cycle-subtree-status 'children) + (run-hook-with-args 'org-cycle-hook 'children)) + ((or children-skipped + (and (eq last-command this-command) + (eq org-cycle-subtree-status 'children))) + ;; We just showed the children, or no children are there, + ;; now show everything. + (run-hook-with-args 'org-pre-cycle-hook 'subtree) + (org-show-subtree) + (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) + (setq org-cycle-subtree-status 'subtree) + (run-hook-with-args 'org-cycle-hook 'subtree)) + (t + ;; Default action: hide the subtree. + (run-hook-with-args 'org-pre-cycle-hook 'folded) + (hide-subtree) + (message "FOLDED") + (setq org-cycle-subtree-status 'folded) + (run-hook-with-args 'org-cycle-hook 'folded))))) ;;;###autoload (defun org-global-cycle (&optional arg) @@ -4513,6 +5045,7 @@ With a numeric prefix, show all headlines up to that level." ((eq org-startup-folded 'content) (let ((this-command 'org-cycle) (last-command 'org-cycle)) (org-cycle '(4)) (org-cycle '(4))))) + (if org-hide-block-startup (org-hide-block-all)) (org-set-visibility-according-to-property 'no-cleanup) (org-cycle-hide-archived-subtrees 'all) (org-cycle-hide-drawers 'all) @@ -4590,14 +5123,13 @@ With numerical argument N, show content up to level N." This function is the default value of the hook `org-cycle-hook'." (when (get-buffer-window (current-buffer)) (cond -; ((eq state 'overview) (org-first-headline-recenter 1)) -; ((eq state 'overview) (org-beginning-of-line)) ((eq state 'content) nil) ((eq state 'all) nil) ((eq state 'folded) nil) ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) +;; FIXME: no longer in use (defun org-compact-display-after-subtree-move () "Show a compacter version of the tree of the entry's parent." (save-excursion @@ -4610,6 +5142,45 @@ This function is the default value of the hook `org-cycle-hook'." (org-cycle-hide-drawers 'children)) (org-overview)))) +(defun org-remove-empty-overlays-at (pos) + "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))) + +(defun org-clean-visibility-after-subtree-move () + "Fix visibility issues after moving a subtree." + ;; First, find a reasonable region to look at: + ;; Start two siblings above, end three below + (let* ((beg (save-excursion + (and (outline-get-last-sibling) + (outline-get-last-sibling)) + (point))) + (end (save-excursion + (and (outline-get-next-sibling) + (outline-get-next-sibling) + (outline-get-next-sibling)) + (if (org-at-heading-p) + (point-at-eol) + (point)))) + (level (looking-at "\\*+")) + (re (if level (concat "^" (regexp-quote (match-string 0)) " ")))) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (when re + ;; Properly fold already folded siblings + (goto-char (point-min)) + (while (re-search-forward re nil t) + (if (save-excursion (goto-char (point-at-eol)) (org-invisible-p)) + (hide-entry)))) + (org-cycle-show-empty-lines 'overview) + (org-cycle-hide-drawers 'overview))))) + (defun org-cycle-show-empty-lines (state) "Show empty lines above all visible headlines. The region to be covered depends on STATE when called through @@ -4657,11 +5228,14 @@ are at least `org-cycle-separator-lines' empty lines before the headline." (defun org-cycle-hide-drawers (state) "Re-hide all drawers after a visibility state change." (when (and (org-mode-p) - (not (memq state '(overview folded)))) + (not (memq state '(overview folded contents)))) (save-excursion (let* ((globalp (memq state '(contents all))) (beg (if globalp (point-min) (point))) - (end (if globalp (point-max) (org-end-of-subtree t)))) + (end (if globalp (point-max) + (if (eq state 'children) + (save-excursion (outline-next-heading) (point)) + (org-end-of-subtree t))))) (goto-char beg) (while (re-search-forward org-drawer-regexp end t) (org-flag-drawer t)))))) @@ -4691,6 +5265,91 @@ Optional argument N means, put the headline into the Nth line of the window." (beginning-of-line) (recenter (prefix-numeric-value N)))) +;;; Folding of blocks + +(defconst org-block-regexp + + "^[ \t]*#\\+begin_\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_\\1[ \t]*$" + "Regular expression for hiding blocks.") + +(defvar org-hide-block-overlays nil + "Overays hiding blocks.") +(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." + (let ((start (or start (point-min))) + (end (or end (point-max)))) + (save-excursion + (goto-char start) + (while (and (< (point) end) (re-search-forward org-block-regexp end t)) + (save-excursion + (save-match-data + (goto-char (match-beginning 0)) + (funcall function))))))) + +(defun org-hide-block-toggle-all () + "Toggle the visibility of all blocks in the current buffer." + (org-block-map #'org-hide-block-toggle)) + +(defun org-hide-block-all () + "Fold all blocks in the current buffer." + (interactive) + (org-show-block-all) + (org-block-map #'org-hide-block-toggle-maybe)) + +(defun org-show-block-all () + "Unfold all blocks in the current buffer." + (mapc 'org-delete-overlay org-hide-block-overlays) + (setq org-hide-block-overlays nil)) + +(defun org-hide-block-toggle-maybe () + "Toggle visibility of block at point." + (interactive) + (let ((case-fold-search t)) + (if (save-excursion + (beginning-of-line 1) + (looking-at org-block-regexp)) + (progn (org-hide-block-toggle) + t) ;; to signal that we took action + nil))) ;; to signal that we did not + +(defun org-hide-block-toggle (&optional force) + "Toggle the visibility of the current block." + (interactive) + (save-excursion + (beginning-of-line) + (if (re-search-forward org-block-regexp nil t) + (let ((start (- (match-beginning 4) 1)) ;; beginning of body + (end (match-end 0)) + ov) ;; end of entire body + (if (memq t (mapcar (lambda (overlay) + (eq (org-overlay-get overlay 'invisible) + 'org-hide-block)) + (org-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) + '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) + (push ov org-hide-block-overlays))) + (error "Not looking at a source block")))) + +;; org-tab-after-check-for-cycling-hook +(add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe) +;; Remove overlays when changing major mode +(add-hook 'org-mode-hook + (lambda () (org-add-hook 'change-major-mode-hook + 'org-show-block-all 'append 'local))) + ;;; Org-goto (defvar org-goto-window-configuration nil) @@ -4754,6 +5413,7 @@ the headline hierarchy above." (interactive "P") (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) (org-refile-use-outline-path t) + (org-refile-target-verify-function nil) (interface (if (not alternative-interface) org-goto-interface @@ -4973,7 +5633,7 @@ frame is not changed." (or (beginning-of-line 0) t) (save-match-data (looking-at "[ \t]*$"))))) - + (defun org-insert-heading (&optional force-heading) "Insert a new heading or item with same depth at point. If point is in a plain list and FORCE-HEADING is nil, create a new list item. @@ -5089,6 +5749,12 @@ This is a list with the following elements: (org-match-string-no-properties 4) (org-match-string-no-properties 5))))) +(defun org-get-entry () + "Get the entry text, after heading, entire subtree." + (save-excursion + (org-back-to-heading t) + (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) + (defun org-insert-heading-after-current () "Insert a new heading with same level as current, after current subtree." (interactive) @@ -5118,11 +5784,23 @@ state (TODO by default). Also with prefix arg, force first state." (org-back-to-heading) (outline-previous-heading) (looking-at org-todo-line-regexp)) - (if (or arg - (not (match-beginning 2)) - (member (match-string 2) org-done-keywords)) - (insert (car org-todo-keywords-1) " ") - (insert (match-string 2) " ")) + (let* + ((new-mark-x + (if (or arg + (not (match-beginning 2)) + (member (match-string 2) org-done-keywords)) + (car org-todo-keywords-1) + (match-string 2))) + (new-mark + (or + (run-hook-with-args-until-success + 'org-todo-get-default-hook new-mark-x nil) + new-mark-x))) + (beginning-of-line 1) + (and (looking-at "\\*+ ") (goto-char (match-end 0)) + (if org-treat-insert-todo-heading-as-state-change + (org-todo new-mark) + (insert new-mark " ")))) (when org-provide-todo-statistics (org-update-parent-todo-statistics)))) @@ -5146,6 +5824,16 @@ Works for outline headings and for plain lists alike." ;;; Promotion and Demotion +(defvar org-after-demote-entry-hook nil + "Hook run after an entry has been demoted. +The cursor will be at the beginning of the entry. +When a subtree is being demoted, the hook will be called for each node.") + +(defvar org-after-promote-entry-hook nil + "Hook run after an entry has been promoted. +The cursor will be at the beginning of the entry. +When a subtree is being promoted, the hook will be called for each node.") + (defun org-promote-subtree () "Promote the entire subtree. See also `org-promote'." @@ -5210,7 +5898,7 @@ even level numbers will become the next higher odd number." (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2)))) ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) - (max 1 (+ level change)))) + (max 1 (+ level (or change 0))))) (if (boundp 'define-obsolete-function-alias) (if (or (featurep 'xemacs) (< emacs-major-version 23)) @@ -5231,7 +5919,8 @@ in the region." (replace-match up-head nil t) ;; Fixup tag positioning (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation (- diff))))) + (if org-adapt-indentation (org-fixup-indentation (- diff))) + (run-hooks 'org-after-promote-entry-hook))) (defun org-demote () "Demote the current heading lower down the tree. @@ -5244,7 +5933,8 @@ in the region." (replace-match down-head nil t) ;; Fixup tag positioning (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation diff)))) + (if org-adapt-indentation (org-fixup-indentation diff)) + (run-hooks 'org-after-demote-entry-hook))) (defun org-map-tree (fun) "Call FUN for every heading underneath the current one." @@ -5388,8 +6078,10 @@ is signaled in this case." (setq txt (buffer-substring beg end)) (org-save-markers-in-region beg end) (delete-region beg end) + (org-remove-empty-overlays-at beg) (or (= beg (point-min)) (outline-flag-region (1- beg) beg nil)) (or (bobp) (outline-flag-region (1- (point)) (point) nil)) + (and (not (bolp)) (looking-at "\n") (forward-char 1)) (let ((bbb (point))) (insert-before-markers txt) (org-reinstall-markers-in-region bbb) @@ -5408,12 +6100,12 @@ is signaled in this case." (kill-line (- ne-ins ne-beg)) (point))) (insert (make-string (- ne-ins ne-beg) ?\n))) (move-marker ins-point nil) - (org-compact-display-after-subtree-move) - (org-show-empty-lines-in-parent) - (unless folded + (if folded + (hide-subtree) (org-show-entry) (show-children) - (org-cycle-hide-drawers 'children)))) + (org-cycle-hide-drawers 'children)) + (org-clean-visibility-after-subtree-move))) (defvar org-subtree-clip "" "Clipboard for cut and paste of subtrees. @@ -5451,7 +6143,7 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (save-excursion (outline-end-of-heading) (setq folded (org-invisible-p))) (condition-case nil - (outline-forward-same-level (1- n)) + (org-forward-same-level (1- n) t) (error nil)) (org-end-of-subtree t t)) (org-back-over-empty-lines) @@ -5492,12 +6184,13 @@ When FOR-YANK is set, this is called by `org-yank'. In this case, do not move back over whitespace before inserting, and move point to the end of the inserted text when done." (interactive "P") + (setq tree (or tree (and kill-ring (current-kill 0)))) (unless (org-kill-is-subtree-p tree) (error "%s" (substitute-command-keys "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) (let* ((visp (not (org-invisible-p))) - (txt (or tree (and kill-ring (current-kill 0)))) + (txt tree) (^re (concat "^\\(" outline-regexp "\\)")) (re (concat "\\(" outline-regexp "\\)")) (^re_ (concat "\\(\\*+\\)[ \t]*")) @@ -5643,15 +6336,86 @@ If yes, remember the marker and the distance to BEG." (save-excursion (save-match-data (narrow-to-region - (progn (org-back-to-heading) (point)) + (progn (org-back-to-heading t) (point)) (progn (org-end-of-subtree t) (point)))))) +(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'. + +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. + +If the original subtree did contain time stamps with a repeater, +the following will happen: +- the repeater will be removed in each clone +- an additional clone will be produced, with the current, unshifted + date(s) in the entry. +- the original entry will be placed *after* all the clones, with + repeater intact. +- the start days in the repeater in the original entry will be shifted + to past the last clone. +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 + 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)) + (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift))) + (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'" + shift))) + (error "Invalid shift specification %s" shift)) + (when doshift + (setq shift-n (string-to-number (match-string 1 shift)) + shift-what (cdr (assoc (match-string 2 shift) + '(("d" . day) ("w" . week) + ("m" . month) ("y" . year)))))) + (if (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day)) + (setq nmin 1 nmax n) + (org-back-to-heading t) + (setq beg (point)) + (org-end-of-subtree t t) + (setq end (point)) + (setq template (buffer-substring beg end)) + (when (and doshift + (string-match "<[^<>\n]+ \\+[0-9]+[dwmy][^<>\n]*>" template)) + (delete-region beg end) + (setq end beg) + (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)) + (while (re-search-forward org-ts-regexp-both nil t) + (org-timestamp-change (* n shift-n) shift-what)) + (unless (= n n-no-remove) + (goto-char (point-min)) + (while (re-search-forward org-ts-regexp nil t) + (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)))) + (insert task)) + (goto-char beg))) ;;; Outline Sorting (defun org-sort (with-case) "Call `org-sort-entries-or-items' or `org-table-sort-lines'. -Optional argument WITH-CASE means sort case-sensitively." +Optional argument WITH-CASE means sort case-sensitively. +With a double prefix argument, also remove duplicate entries." (interactive "P") (if (org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case) @@ -5667,17 +6431,43 @@ Optional argument WITH-CASE means sort case-sensitively." (defvar org-priority-regexp) ; defined later in the file +(defvar org-after-sorting-entries-or-items-hook nil + "Hook that is run after a bunch of entries or items have been sorted. +When children are sorted, the cursor is in the parent line when this +hook gets called. When a region or a plain list is sorted, the cursor +will be in the first entry of the sorted region/list.") + (defun org-sort-entries-or-items (&optional with-case sorting-type getkey-func compare-func property) - "Sort entries on a certain level of an outline tree. + "Sort entries on a certain level of an outline tree, or plain list items. If there is an active region, the entries in the region are sorted. Else, if the cursor is before the first entry, sort the top-level items. Else, the children of the entry at point are sorted. +If the cursor is at the first item in a plain list, the list items will be +sorted. + +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, +\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?r ?R ?f ?F). Here is the +precise meaning of each character: + +n Numerically, by converting the beginning of the entry/item to a number. +a Alphabetically, ignoring the TODO keyword and the priority, if any. +t By date/time, either the first active time stamp in the entry, or, if + none exist, by the first inactive one. + In items, only the first line will be chekced. +s By the scheduled date/time. +d By deadline date/time. +c By creation time, which is assumed to be the first inactive time stamp + at the beginning of a line. +p By priority according to the cookie. +r By the value of a property. + +Capital letters will reverse the sort order. -Sorting can be alphabetically, numerically, and by date/time as given by -the first time stamp in the entry. 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, any of (?n ?N ?a ?A ?t ?T ?p ?P ?f ?F). If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be called with point at the beginning of the record. It must return either a string or a number that should serve as the sorting key for that record. @@ -5740,8 +6530,10 @@ WITH-CASE, the sorting considers case as well." (unless sorting-type (message (if plain-list-p - "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:" - "Sort %s: [a]lpha [n]umeric [t]ime [p]riority p[r]operty todo[o]rder [f]unc A/N/T/P/O/F means reversed:") + "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:" + "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc + [t]ime [s]cheduled [d]eadline [c]reated + A/N/T/S/D/C/P/O/F means reversed:") what) (setq sorting-type (read-char-exclusive)) @@ -5763,6 +6555,7 @@ WITH-CASE, the sorting considers case as well." (narrow-to-region start end) (let ((dcst (downcase sorting-type)) + (case-fold-search nil) (now (current-time))) (sort-subr (/= dcst sorting-type) @@ -5797,10 +6590,11 @@ WITH-CASE, the sorting considers case as well." ((= dcst ?a) (buffer-substring (match-end 0) (point-at-eol))) ((= dcst ?t) - (if (re-search-forward org-ts-regexp - (point-at-eol) t) - (org-time-string-to-time (match-string 0)) - now)) + (if (or (re-search-forward org-ts-regexp (point-at-eol) t) + (re-search-forward org-ts-regexp-both + (point-at-eol) t)) + (org-time-string-to-seconds (match-string 0)) + (time-to-seconds now))) ((= dcst ?f) (if getkey-func (progn @@ -5820,12 +6614,28 @@ WITH-CASE, the sorting considers case as well." (funcall case-func (match-string 4)) nil)) ((= dcst ?t) - (if (re-search-forward org-ts-regexp - (save-excursion - (forward-line 2) - (point)) t) - (org-time-string-to-time (match-string 0)) - now)) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (or (re-search-forward org-ts-regexp end t) + (re-search-forward org-ts-regexp-both end t)) + (org-time-string-to-seconds (match-string 0)) + (time-to-seconds now)))) + ((= dcst ?c) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward + (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") + end t) + (org-time-string-to-seconds (match-string 0)) + (time-to-seconds now)))) + ((= dcst ?s) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward org-scheduled-time-regexp end t) + (org-time-string-to-seconds (match-string 1)) + (time-to-seconds now)))) + ((= dcst ?d) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward org-deadline-time-regexp end t) + (org-time-string-to-seconds (match-string 1)) + (time-to-seconds now)))) ((= dcst ?p) (if (re-search-forward org-priority-regexp (point-at-eol) t) (string-to-char (match-string 2)) @@ -5847,9 +6657,10 @@ WITH-CASE, the sorting considers case as well." nil (cond ((= dcst ?a) 'string<) - ((= dcst ?t) 'time-less-p) ((= dcst ?f) compare-func) + ((member dcst '(?p ?t ?s ?d ?c)) '<) (t nil))))) + (run-hooks 'org-after-sorting-entries-or-items-hook) (message "Sorting entries...done"))) (defun org-do-sort (table what &optional with-case sorting-type) @@ -5881,7 +6692,8 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." ((= dcst ?t) (setq extractfun (lambda (x) - (if (string-match org-ts-regexp x) + (if (or (string-match org-ts-regexp x) + (string-match org-ts-regexp-both x)) (time-to-seconds (org-time-string-to-time (match-string 0 x))) 0)) @@ -5892,231 +6704,6 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." table) (lambda (a b) (funcall comparefun (car a) (car b)))))) -;;; Editing source examples - -(defvar org-exit-edit-mode-map (make-sparse-keymap)) -(define-key org-exit-edit-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-picture nil) - -(define-minor-mode org-exit-edit-mode - "Minor mode installing a single key binding, \"C-c '\" to exit special edit.") - -(defun org-edit-src-code () - "Edit the source code example at point. -An indirect buffer is created, and that buffer is then narrowed to the -example at point and switched to the correct language mode. When done, -exit by killing the buffer with \\[org-edit-src-exit]." - (interactive) - (let ((line (org-current-line)) - (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 end lang lang-f single lfmt) - (if (not info) - nil - (setq beg (nth 0 info) - end (nth 1 info) - lang (nth 2 info) - single (nth 3 info) - lfmt (nth 4 info) - lang-f (intern (concat lang "-mode"))) - (unless (functionp lang-f) - (error "No such language mode: %s" lang-f)) - (goto-line line) - (if (get-buffer "*Org Edit Src Example*") - (kill-buffer "*Org Edit Src Example*")) - (switch-to-buffer (make-indirect-buffer (current-buffer) - "*Org Edit Src Example*")) - (narrow-to-region beg end) - (remove-text-properties beg end '(display nil invisible nil - intangible nil)) - (let ((org-inhibit-startup t)) - (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) - (when lfmt - (set (make-local-variable 'org-coderef-label-format) lfmt)) - (when org-mode-p - (goto-char (point-min)) - (while (re-search-forward "^," nil t) - (replace-match ""))) - (goto-line line) - (org-exit-edit-mode) - (org-set-local 'header-line-format msg) - (message "%s" msg) - t))) - -(defun org-edit-fixed-width-region () - "Edit the fixed-width ascii drawing at point. -This must be a region where each line starts with a colon followed by -a space character. -An indirect buffer is created, and that buffer is then narrowed to the -example at point and switched to artist-mode. When done, -exit by killing the buffer with \\[org-edit-src-exit]." - (interactive) - (let ((line (org-current-line)) - (case-fold-search t) - (msg (substitute-command-keys - "Edit, then exit with C-c ' (C-c and single quote)")) - (org-mode-p (eq major-mode 'org-mode)) - beg end) - (beginning-of-line 1) - (if (looking-at "[ \t]*[^:\n \t]") - nil - (if (looking-at "[ \t]*\\(\n\\|\\'\\)") - (setq beg (point) end beg) - (save-excursion - (if (re-search-backward "^[ \t]*[^:]" nil 'move) - (setq beg (point-at-bol 2)) - (setq beg (point)))) - (save-excursion - (if (re-search-forward "^[ \t]*[^:]" nil 'move) - (setq end (1- (match-beginning 0))) - (setq end (point)))) - (goto-line line)) - (if (get-buffer "*Org Edit Picture*") - (kill-buffer "*Org Edit Picture*")) - (switch-to-buffer (make-indirect-buffer (current-buffer) - "*Org Edit Picture*")) - (narrow-to-region beg end) - (remove-text-properties beg end '(display nil invisible nil - intangible nil)) - (when (fboundp 'font-lock-unfontify-region) - (font-lock-unfontify-region (point-min) (point-max))) - (cond - ((eq org-edit-fixed-width-region-mode 'artist-mode) - (fundamental-mode) - (artist-mode 1)) - (t (funcall org-edit-fixed-width-region-mode))) - (set (make-local-variable 'org-edit-src-force-single-line) nil) - (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) - (set (make-local-variable 'org-edit-src-picture) t) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*: ?" nil t) - (replace-match "")) - (goto-line line) - (org-exit-edit-mode) - (org-set-local 'header-line-format msg) - (message "%s" msg) - t))) - - -(defun org-edit-src-find-region-and-lang () - "Find the region and language for a local edit. -Return a list with beginning and end of the region, a string representing -the language, a switch telling of the content should be in a single line." - (let ((re-list - (append - org-edit-src-region-extra - '( - ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang) - ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style) - ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental") - ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp") - ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl") - ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python") - ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby") - ("^#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n#\\+end_src" 2) - ("^#\\+begin_example.*\n" "\n#\\+end_example" "fundamental") - ("^#\\+html:" "\n" "html" single-line) - ("^#\\+begin_html.*\n" "\n#\\+end_html" "html") - ("^#\\+begin_latex.*\n" "\n#\\+end_latex" "latex") - ("^#\\+latex:" "\n" "latex" single-line) - ("^#\\+begin_ascii.*\n" "\n#\\+end_ascii" "fundamental") - ("^#\\+ascii:" "\n" "ascii" single-line) - ))) - (pos (point)) - re1 re2 single beg end lang lfmt match-re1) - (catch 'exit - (while (setq entry (pop re-list)) - (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry) - single (nth 3 entry)) - (save-excursion - (if (or (looking-at re1) - (re-search-backward re1 nil t)) - (progn - (setq match-re1 (match-string 0)) - (setq beg (match-end 0) - lang (org-edit-src-get-lang lang) - lfmt (org-edit-src-get-label-format match-re1)) - (if (and (re-search-forward re2 nil t) - (>= (match-end 0) pos)) - (throw 'exit (list beg (match-beginning 0) - lang single lfmt)))) - (if (or (looking-at re2) - (re-search-forward re2 nil t)) - (progn - (setq end (match-beginning 0)) - (if (and (re-search-backward re1 nil t) - (<= (match-beginning 0) pos)) - (progn - (setq lfmt (org-edit-src-get-label-format - (match-string 0))) - (throw 'exit - (list (match-end 0) end - (org-edit-src-get-lang lang) - single lfmt)))))))))))) - -(defun org-edit-src-get-lang (lang) - "Extract the src language." - (let ((m (match-string 0))) - (cond - ((stringp lang) lang) - ((integerp lang) (match-string lang)) - ((and (eq lang 'lang) - (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m)) - (match-string 1 m)) - ((and (eq lang 'style) - (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m)) - (match-string 1 m)) - (t "fundamental")))) - -(defun org-edit-src-get-label-format (s) - "Extract the label format." - (save-match-data - (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s) - (match-string 1 s)))) - -(defun org-edit-src-exit () - "Exit special edit and protect problematic lines." - (interactive) - (unless (buffer-base-buffer (current-buffer)) - (error "This is not an indirect buffer, something is wrong...")) - (unless (> (point-min) 1) - (error "This buffer is not narrowed, something is wrong...")) - (goto-char (point-min)) - (if (looking-at "[ \t\n]*\n") (replace-match "")) - (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")) - (when (org-bound-and-true-p org-edit-src-force-single-line) - (goto-char (point-min)) - (while (re-search-forward "\n" nil t) - (replace-match " ")) - (goto-char (point-min)) - (if (looking-at "\\s-*") (replace-match " ")) - (if (re-search-forward "\\s-+\\'" nil t) - (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) "^\\(.\\)" "^\\([*#]\\)") nil t) - (replace-match ",\\1")) - (when font-lock-mode - (font-lock-unfontify-region (point-min) (point-max))) - (put-text-property (point-min) (point-max) 'font-lock-fontified t)) - (when (org-bound-and-true-p org-edit-src-picture) - (untabify (point-min) (point-max)) - (goto-char (point-min)) - (while (re-search-forward "^" nil t) - (replace-match ": ")) - (when font-lock-mode - (font-lock-unfontify-region (point-min) (point-max))) - (put-text-property (point-min) (point-max) 'font-lock-fontified t)) - (kill-buffer (current-buffer)) - (and (org-mode-p) (org-restart-font-lock))) - ;;; The orgstruct minor mode @@ -6179,22 +6766,38 @@ C-c C-c Set tags / toggle checkbox" "Unconditionally turn on `orgstruct-mode'." (orgstruct-mode 1)) +(defun orgstruct++-mode (&optional arg) + "Toggle `orgstruct-mode', the enhanced version of it. +In addition to setting orgstruct-mode, this also exports all indentation +and autofilling variables from org-mode into the buffer. It will also +recognize item context in multiline items. +Note that turning off orgstruct-mode will *not* remove the +indentation/paragraph settings. This can only be done by refreshing the +major mode, for example with \\[normal-mode]." + (interactive "P") + (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))) + (if (< arg 1) + (orgstruct-mode -1) + (orgstruct-mode 1) + (let (var val) + (mapc + (lambda (x) + (when (string-match + "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" + (symbol-name (car x))) + (setq var (car x) val (nth 1 x)) + (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) + org-local-vars) + (org-set-local 'orgstruct-is-++ t)))) + +(defvar orgstruct-is-++ nil + "Is orgstruct-mode in ++ version in the current-buffer?") +(make-variable-buffer-local 'orgstruct-is-++) + ;;;###autoload (defun turn-on-orgstruct++ () - "Unconditionally turn on `orgstruct-mode', and force org-mode indentations. -In addition to setting orgstruct-mode, this also exports all indentation and -autofilling variables from org-mode into the buffer. Note that turning -off orgstruct-mode will *not* remove these additional settings." - (orgstruct-mode 1) - (let (var val) - (mapc - (lambda (x) - (when (string-match - "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" - (symbol-name (car x))) - (setq var (car x) val (nth 1 x)) - (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) - org-local-vars))) + "Unconditionally turn on `orgstruct++-mode'." + (orgstruct++-mode 1)) (defun orgstruct-error () "Error when there is no default binding for a structure key." @@ -6214,6 +6817,14 @@ off orgstruct-mode will *not* remove these additional settings." '([(meta shift down)] org-shiftmetadown) '([(meta shift left)] org-shiftmetaleft) '([(meta shift right)] org-shiftmetaright) + '([?\e (up)] org-metaup) + '([?\e (down)] org-metadown) + '([?\e (left)] org-metaleft) + '([?\e (right)] org-metaright) + '([?\e (shift up)] org-shiftmetaup) + '([?\e (shift down)] org-shiftmetadown) + '([?\e (shift left)] org-shiftmetaleft) + '([?\e (shift right)] org-shiftmetaright) '([(shift up)] org-shiftup) '([(shift down)] org-shiftdown) '([(shift left)] org-shiftleft) @@ -6247,6 +6858,16 @@ off orgstruct-mode will *not* remove these additional settings." (orgstruct-make-binding 'org-insert-todo-heading 107 [(meta return)] "\M-\C-m")) + (org-defkey orgstruct-mode-map "\e\C-m" + (orgstruct-make-binding 'org-insert-heading 108 + "\e\C-m" [?\e (return)])) + (org-defkey orgstruct-mode-map [?\e (return)] + (orgstruct-make-binding 'org-insert-heading 109 + [?\e (return)] "\e\C-m")) + (org-defkey orgstruct-mode-map [?\e (shift return)] + (orgstruct-make-binding 'org-insert-todo-heading 110 + [?\e (return)] "\e\C-m")) + (unless org-local-vars (setq org-local-vars (org-get-local-variables))) @@ -6267,7 +6888,10 @@ to execute outside of tables." "'.") '(interactive "p") (list 'if - '(org-context-p 'headline 'item) + `(org-context-p 'headline 'item + (and orgstruct-is-++ + ,(and (memq fun '(org-insert-heading org-insert-todo-heading)) t) + 'item-body)) (list 'org-run-like-in-org-mode (list 'quote fun)) (list 'let '(orgstruct-mode) (list 'call-interactively @@ -6288,7 +6912,9 @@ Possible values in the list of contexts are `table', `headline', and `item'." ;;????????? (looking-at "\\*+")) (looking-at outline-regexp)) (and (memq 'item contexts) - (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)"))) + (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)")) + (and (memq 'item-body contexts) + (org-in-item-p))) (goto-char pos)))) (defun org-get-local-variables () @@ -6314,6 +6940,10 @@ Possible values in the list of contexts are `table', `headline', and `item'." ;;;###autoload (defun org-run-like-in-org-mode (cmd) + "Run a command, pretending that the current buffer is in Org-mode. +This will temporarily bind local variables that are typically bound in +Org-mode to the values they have in Org-mode, and then interactively +call CMD." (org-load-modules-maybe) (unless org-local-vars (setq org-local-vars (org-get-local-variables))) @@ -6454,7 +7084,8 @@ For file links, arg negates `org-context-in-file-links'." (interactive "P") (org-load-modules-maybe) (setq org-store-link-plist nil) ; reset - (let (link cpltxt desc description search txt) + (let ((outline-regexp (org-get-limited-outline-regexp)) + link cpltxt desc description search txt custom-id) (cond ((run-hook-with-args-until-success 'org-store-link-functions) @@ -6491,8 +7122,11 @@ For file links, arg negates `org-context-in-file-links'." (org-store-link-props :type "calendar" :date cd))) ((eq major-mode 'w3-mode) - (setq cpltxt (url-view-url t) - link (org-make-link cpltxt)) + (setq cpltxt (if (and (buffer-name) + (not (string-match "Untitled" (buffer-name)))) + (buffer-name) + (url-view-url t)) + link (org-make-link (url-view-url t))) (org-store-link-props :type "w3" :url (url-view-url t))) ((eq major-mode 'w3m-mode) @@ -6521,6 +7155,7 @@ For file links, arg negates `org-context-in-file-links'." link (org-make-link cpltxt))) ((and buffer-file-name (org-mode-p)) + (setq custom-id (ignore-errors (org-entry-get nil "CUSTOM_ID"))) (cond ((org-in-regexp "<<\\(.*?\\)>>") (setq cpltxt @@ -6532,6 +7167,9 @@ For file links, arg negates `org-context-in-file-links'." (or (eq org-link-to-org-use-id t) (and (eq org-link-to-org-use-id 'create-if-interactive) (interactive-p)) + (and (eq org-link-to-org-use-id 'create-if-interactive-and-no-custom-id) + (interactive-p) + (not custom-id)) (and org-link-to-org-use-id (condition-case nil (org-entry-get nil "ID") @@ -6562,7 +7200,7 @@ For file links, arg negates `org-context-in-file-links'." (condition-case nil (org-make-org-heading-search-string txt) (error ""))) - desc "NONE"))) + desc (or (nth 4 (org-heading-components)) "NONE")))) (if (string-match "::\\'" cpltxt) (setq cpltxt (substring cpltxt 0 -2))) (setq link (org-make-link cpltxt))))) @@ -6594,11 +7232,16 @@ For file links, arg negates `org-context-in-file-links'." desc (or desc cpltxt)) (if (equal desc "NONE") (setq desc nil)) - (if (and (interactive-p) link) + (if (and (or (interactive-p) executing-kbd-macro) link) (progn (setq org-stored-links (cons (list link desc) org-stored-links)) - (message "Stored: %s" (or desc link))) + (message "Stored: %s" (or desc link)) + (when custom-id + (setq link (concat "file:" (abbreviate-file-name (buffer-file-name)) + "::#" custom-id)) + (setq org-stored-links + (cons (list link desc) org-stored-links)))) (and link (org-make-link-string link desc))))) (defun org-store-link-props (&rest plist) @@ -6722,6 +7365,8 @@ according to FMT (default from `org-email-link-description-format')." "Association list of escapes for some characters problematic in links. This is the list that is used for internal purposes.") +(defvar org-url-encoding-use-url-hexify nil) + (defconst org-link-escape-chars-browser '((?\ . "%20")) ; 32 for the SPC char "Association list of escapes for some characters problematic in links. @@ -6729,31 +7374,35 @@ This is the list that is used before handing over to the browser.") (defun org-link-escape (text &optional table) "Escape characters in TEXT that are problematic for links." - (setq table (or table org-link-escape-chars)) - (when text - (let ((re (mapconcat (lambda (x) (regexp-quote - (char-to-string (car x)))) - table "\\|"))) - (while (string-match re text) - (setq text - (replace-match - (cdr (assoc (string-to-char (match-string 0 text)) - table)) + (if org-url-encoding-use-url-hexify + (url-hexify-string text) + (setq table (or table org-link-escape-chars)) + (when text + (let ((re (mapconcat (lambda (x) (regexp-quote + (char-to-string (car x)))) + table "\\|"))) + (while (string-match re text) + (setq text + (replace-match + (cdr (assoc (string-to-char (match-string 0 text)) + table)) t t text))) - text))) + text)))) (defun org-link-unescape (text &optional table) "Reverse the action of `org-link-escape'." - (setq table (or table org-link-escape-chars)) - (when text - (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x))) - table "\\|"))) - (while (string-match re text) - (setq text - (replace-match - (char-to-string (car (rassoc (match-string 0 text) table))) - t t text))) - text))) + (if org-url-encoding-use-url-hexify + (url-unhex-string text) + (setq table (or table org-link-escape-chars)) + (when text + (let ((re (mapconcat (lambda (x) (regexp-quote (cdr x))) + table "\\|"))) + (while (string-match re text) + (setq text + (replace-match + (char-to-string (car (rassoc (match-string 0 text) table))) + t t text))) + text)))) (defun org-xor (a b) "Exclusive or." @@ -6822,7 +7471,7 @@ used as the link location instead of reading one interactively." (desc region) tmphist ; byte-compile incorrectly complains about this (link link-location) - entry file) + entry file all-prefixes) (cond (link-location) ; specified by arg, just use it. ((org-in-regexp org-bracket-link-regexp 1) @@ -6840,26 +7489,12 @@ used as the link location instead of reading one interactively." (org-remove-angle-brackets (match-string 0))))) ((member complete-file '((4) (16))) ;; Completing read for file names. - (setq file (read-file-name "File: ")) - (let ((pwd (file-name-as-directory (expand-file-name "."))) - (pwd1 (file-name-as-directory (abbreviate-file-name - (expand-file-name "."))))) - (cond - ((equal complete-file '(16)) - (setq link (org-make-link - "file:" - (abbreviate-file-name (expand-file-name file))))) - ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) - (setq link (org-make-link "file:" (match-string 1 file)))) - ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") - (expand-file-name file)) - (setq link (org-make-link - "file:" (match-string 1 (expand-file-name file))))) - (t (setq link (org-make-link "file:" file)))))) + (setq link (org-file-complete-link complete-file))) (t ;; Read link, with completion for stored links. (with-output-to-temp-buffer "*Org Links*" - (princ "Insert a link. Use TAB to complete valid link prefixes.\n") + (princ "Insert a link. +Use TAB to complete link prefixes, then RET for type-specific completion support\n") (when org-stored-links (princ "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") (princ (mapconcat @@ -6869,24 +7504,33 @@ used as the link location instead of reading one interactively." (let ((cw (selected-window))) (select-window (get-buffer-window "*Org Links*")) (setq truncate-lines t) - (org-fit-window-to-buffer) - (select-window cw)) + (unless (pos-visible-in-window-p (point-max)) + (org-fit-window-to-buffer)) + (and (window-live-p cw) (select-window cw))) ;; Fake a link history, containing the stored links. (setq tmphist (append (mapcar 'car org-stored-links) org-insert-link-history)) + (setq all-prefixes (append (mapcar 'car org-link-abbrev-alist-local) + (mapcar 'car org-link-abbrev-alist) + org-link-types)) (unwind-protect - (setq link - (let ((org-completion-use-ido nil)) - (org-completing-read - "Link: " - (append - (mapcar (lambda (x) (list (concat (car x) ":"))) - (append org-link-abbrev-alist-local org-link-abbrev-alist)) - (mapcar (lambda (x) (list (concat x ":"))) - org-link-types)) - nil nil nil - 'tmphist - (or (car (car org-stored-links)))))) + (progn + (setq link + (let ((org-completion-use-ido nil)) + (org-completing-read + "Link: " + (append + (mapcar (lambda (x) (list (concat x ":"))) + all-prefixes) + (mapcar 'car org-stored-links)) + nil nil nil + 'tmphist + (car (car org-stored-links))))) + (if (or (member link all-prefixes) + (and (equal ":" (substring link -1)) + (member (substring link 0 -1) all-prefixes) + (setq link (substring link 0 -1)))) + (setq link (org-link-try-special-completion link)))) (set-window-configuration wcf) (kill-buffer "*Org Links*")) (setq entry (assoc link org-stored-links)) @@ -6948,6 +7592,34 @@ used as the link location instead of reading one interactively." (if remove (apply 'delete-region remove)) (insert (org-make-link-string link desc)))) +(defun org-link-try-special-completion (type) + "If there is completion support for link type TYPE, offer it." + (let ((fun (intern (concat "org-" type "-complete-link")))) + (if (functionp fun) + (funcall fun) + (read-string "Link (no completion support): " (concat type ":"))))) + +(defun org-file-complete-link (&optional arg) + "Create a file link using completion." + (let (file link) + (setq file (read-file-name "File: ")) + (let ((pwd (file-name-as-directory (expand-file-name "."))) + (pwd1 (file-name-as-directory (abbreviate-file-name + (expand-file-name "."))))) + (cond + ((equal arg '(16)) + (setq link (org-make-link + "file:" + (abbreviate-file-name (expand-file-name file))))) + ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) + (setq link (org-make-link "file:" (match-string 1 file)))) + ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") + (expand-file-name file)) + (setq link (org-make-link + "file:" (match-string 1 (expand-file-name file))))) + (t (setq link (org-make-link "file:" file))))) + link)) + (defun org-completing-read (&rest args) "Completing-read with SPACE being a normal character." (let ((minibuffer-local-completion-map @@ -6966,7 +7638,12 @@ used as the link location instead of reading one interactively." (fboundp 'ido-completing-read) (boundp 'ido-mode) ido-mode (listp (second args))) - (apply 'ido-completing-read (concat (car args)) (cdr args)) + (let ((ido-enter-matching-directory nil)) + (apply 'ido-completing-read (concat (car args)) + (if (consp (car (nth 1 args))) + (mapcar (lambda (x) (car x)) (nth 1 args)) + (nth 1 args)) + (cddr args))) (apply 'completing-read args))) (defun org-extract-attributes (s) @@ -6982,6 +7659,14 @@ used as the link location instead of reading one interactively." (org-add-props s nil 'org-attr attr)) s)) +(defun org-extract-attributes-from-string (tag) + (let (key value attr) + (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"\\s-?" tag) + (setq key (match-string 1 tag) value (match-string 2 tag) + tag (replace-match "" t t tag) + attr (plist-put attr (intern key) value))) + (cons tag attr))) + (defun org-attributes-to-string (plist) "Format a property list into an HTML attribute list." (let ((s "") key value) @@ -7101,17 +7786,18 @@ Org-mode syntax." (defun org-open-link-from-string (s &optional arg) "Open a link in the string S, as if it was in Org-mode." (interactive "sLink: \nP") - (with-temp-buffer - (let ((org-inhibit-startup t)) - (org-mode) - (insert s) - (goto-char (point-min)) - (org-open-at-point arg)))) + (let ((reference-buffer (current-buffer))) + (with-temp-buffer + (let ((org-inhibit-startup t)) + (org-mode) + (insert s) + (goto-char (point-min)) + (org-open-at-point arg reference-buffer))))) -(defun org-open-at-point (&optional in-emacs) +(defun org-open-at-point (&optional in-emacs reference-buffer) "Open link at or after point. If there is no link at point, this function will search forward up to -the end of the current subtree. +the end of the current line. Normally, files will be opened by an appropriate application. If the 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 @@ -7125,7 +7811,7 @@ application the system uses for this file type." ((org-at-timestamp-p t) (org-follow-timestamp-link)) ((or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) (org-footnote-action)) - (t + (t (let (type path link line search (pos (point))) (catch 'match (save-excursion @@ -7159,19 +7845,25 @@ application the system uses for this file type." (org-in-regexp org-plain-link-re)) (setq type (match-string 1) path (match-string 2)) (throw 'match t))) - (when (org-in-regexp "\\<\\([^><\n]+\\)\\>") - (setq type "tree-match" - path (match-string 1)) - (throw 'match t)) (save-excursion (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) (setq type "tags" path (match-string 1)) (while (string-match ":" path) (setq path (replace-match "+" t t path))) - (throw 'match t)))) + (throw 'match t))) + (when (org-in-regexp "<\\([^><\n]+\\)>") + (setq type "tree-match" + path (match-string 1)) + (throw 'match t))) (unless path (error "No link found")) + + ;; switch back to reference buffer + ;; needed when if called in a temporary buffer through + ;; org-open-link-from-string + (and reference-buffer (switch-to-buffer reference-buffer)) + ;; Remove any trailing spaces in path (if (string-match " +\\'" path) (setq path (replace-match "" t t path))) @@ -7347,6 +8039,18 @@ in all files. If AVOID-POS is given, ignore matches near that position." ;; First check if there are any special ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) ;; Now try the builtin stuff + ((and (equal (string-to-char s0) ?#) + (> (length s0) 1) + (save-excursion + (goto-char (point-min)) + (and + (re-search-forward + (concat "^[ \t]*:CUSTOM_ID:[ \t]+" (regexp-quote (substring s0 1)) "[ \t]*$") nil t) + (setq type 'dedicated + pos (match-beginning 0)))) + ;; There is an exact target for this + (goto-char pos) + (org-back-to-heading t))) ((save-excursion (goto-char (point-min)) (and @@ -7732,8 +8436,10 @@ on the system \"/user@host:\"." (defun org-get-refile-targets (&optional default-buffer) "Produce a table with refile targets." - (let ((entries (or org-refile-targets '((nil . (:level . 1))))) - targets txt re files f desc descre fast-path-p level) + (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) (message "Getting targets...") (with-current-buffer (or default-buffer (current-buffer)) (while (setq entry (pop entries)) @@ -7774,37 +8480,46 @@ on the system \"/user@host:\"." (set-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 (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 (point-at-bol)) - (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)) - (goto-char (point-at-eol)))))))) + (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)))))))))) (message "Getting targets...done") - (nreverse targets)))) + (nreverse targets))) (defun org-protect-slash (s) (while (string-match "/" s) @@ -7834,7 +8549,12 @@ on the system \"/user@host:\"." (defvar org-refile-history nil "History for refiling operations.") -(defun org-refile (&optional goto default-buffer) +(defvar org-after-refile-insert-hook nil + "Hook run after `org-refile' has inserted its stuff at the new location. +Note that this is still *before* the stuff will be removed from +the *old* location.") + +(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 `org-refile-targets', which see. This list is created before each use @@ -7852,7 +8572,11 @@ 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 -operation has put the subtree." +operation has put the subtree. + +RFLOC can be a refile location obtained in a different way. + +See also `org-refile-use-outline-path' and `org-completion-use-ido'" (interactive "P") (let* ((cbuf (current-buffer)) (regionp (org-region-active-p)) @@ -7861,18 +8585,26 @@ operation has put the subtree." (region-length (and regionp (- region-end region-start))) (filename (buffer-file-name (buffer-base-buffer cbuf))) pos it nbuf file re level reversed) - (when regionp (goto-char region-start) - (unless (org-kill-is-subtree-p - (buffer-substring region-start region-end)) - (error "The region is not a (sequence of) subtree(s)"))) + (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 (setq it (org-refile-get-location - (if goto "Goto: " "Refile to: ") default-buffer)) + (when (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 (equal (buffer-file-name) file) + (if (and (not goto) + pos + (equal (buffer-file-name) file) (if regionp (and (>= pos region-start) (<= pos region-end)) @@ -7880,7 +8612,7 @@ operation has put the subtree." (< 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 @@ -7890,7 +8622,7 @@ operation has put the subtree." (org-show-context 'org-goto)) (if regionp (progn - (kill-new (buffer-substring region-start region-end)) + (org-kill-new (buffer-substring region-start region-end)) (org-save-markers-in-region region-start region-end)) (org-copy-subtree 1 nil t)) (save-excursion @@ -7900,23 +8632,35 @@ operation has put the subtree." (save-excursion (save-restriction (widen) - (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 (outline-get-next-sibling)) - (org-end-of-subtree t t) - (point-max)))) + (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 (outline-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)) (bookmark-set "org-refile-last-stored") - (org-paste-subtree level)))) + (org-paste-subtree level) + (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))))))) + (message "Refiled to \"%s\"" (car it)))))) + (org-reveal)) (defun org-refile-goto-last-stored () "Go to the location where the last refile was stored." @@ -7924,7 +8668,7 @@ operation has put the subtree." (bookmark-jump "org-refile-last-stored") (message "This is the location of the last refile")) -(defun org-refile-get-location (&optional prompt default-buffer) +(defun org-refile-get-location (&optional prompt default-buffer new-nodes) "Prompt the user for a refile location, using PROMPT." (let ((org-refile-targets org-refile-targets) (org-refile-use-outline-path org-refile-use-outline-path)) @@ -7932,6 +8676,7 @@ operation has put the subtree." (unless org-refile-target-table (error "No refile targets")) (let* ((cbuf (current-buffer)) + (partial-completion-mode nil) (cfn (buffer-file-name (buffer-base-buffer cbuf))) (cfunc (if (and org-refile-use-outline-path org-outline-path-complete-in-steps) @@ -7941,19 +8686,72 @@ operation has put the subtree." (filename (and cfn (expand-file-name cfn))) (tbl (mapcar (lambda (x) - (if (not (equal filename (nth 1 x))) + (if (and (not (member org-refile-use-outline-path + '(file full-file-path))) + (not (equal filename (nth 1 x)))) (cons (concat (car x) extra " (" (file-name-nondirectory (nth 1 x)) ")") (cdr x)) (cons (concat (car x) extra) (cdr x)))) org-refile-target-table)) - (completion-ignore-case t)) - (assoc (funcall cfunc prompt tbl nil t nil 'org-refile-history) - tbl))) + (completion-ignore-case t) + pa answ parent-target child parent old-hist) + (setq old-hist org-refile-history) + (setq answ (funcall cfunc prompt tbl nil (not new-nodes) + nil 'org-refile-history)) + (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl))) + (if pa + (progn + (when (or (not org-refile-history) + (not (eq old-hist org-refile-history)) + (not (equal (car pa) (car org-refile-history)))) + (setq org-refile-history + (cons (car pa) (if (assoc (car org-refile-history) tbl) + org-refile-history + (cdr org-refile-history)))) + (if (equal (car org-refile-history) (nth 1 org-refile-history)) + (pop org-refile-history))) + pa) + (when (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ) + (setq parent (match-string 1 answ) + child (match-string 2 answ)) + (setq parent-target (or (assoc parent tbl) (assoc (concat parent "/") tbl))) + (when (and parent-target + (or (eq new-nodes t) + (and (eq new-nodes 'confirm) + (y-or-n-p (format "Create new node \"%s\"? " child))))) + (org-refile-new-child parent-target child)))))) + +(defun org-refile-new-child (parent-target child) + "Use refile target PARENT-TARGET to add new CHILD below it." + (unless parent-target + (error "Cannot find parent for new node")) + (let ((file (nth 1 parent-target)) + (pos (nth 3 parent-target)) + level) + (with-current-buffer (or (find-buffer-visiting file) + (find-file-noselect file)) + (save-excursion + (save-restriction + (widen) + (if pos + (goto-char pos) + (goto-char (point-max)) + (if (not (bolp)) (newline))) + (when (looking-at outline-regexp) + (setq level (funcall outline-level)) + (org-end-of-subtree t t)) + (org-back-over-empty-lines) + (insert "\n" (make-string + (if pos (org-get-valid-level level 1) 1) ?*) + " " child "\n") + (beginning-of-line 0) + (list (concat (car parent-target) "/" child) file "" (point))))))) (defun org-olpath-completing-read (prompt collection &rest args) "Read an outline path like a file name." - (let ((thetable collection)) + (let ((thetable collection) + (org-completion-use-ido nil)) ; does not work with ido. (apply 'org-ido-completing-read prompt (lambda (string predicate &optional flag) @@ -8102,13 +8900,19 @@ This function can be used in a hook." ;;;; Completion (defconst org-additional-option-like-keywords - '("BEGIN_HTML" "BEGIN_LaTeX" "END_HTML" "END_LaTeX" - "ORGTBL" "HTML:" "LaTeX:" "BEGIN:" "END:" "TBLFM" + '("BEGIN_HTML" "END_HTML" "HTML:" "ATTR_HTML" + "BEGIN_DocBook" "END_DocBook" "DocBook:" "ATTR_DocBook" + "BEGIN_LaTeX" "END_LaTeX" "LaTeX:" "LATEX_HEADER:" "ATTR_LaTeX" + "BEGIN:" "END:" + "ORGTBL" "TBLFM:" "TBLNAME:" "BEGIN_EXAMPLE" "END_EXAMPLE" "BEGIN_QUOTE" "END_QUOTE" "BEGIN_VERSE" "END_VERSE" + "BEGIN_CENTER" "END_CENTER" "BEGIN_SRC" "END_SRC" - "CAPTION" "LABEL" "ATTR_HTML" "ATTR_LaTeX")) + "CATEGORY" "COLUMNS" + "CAPTION" "LABEL" + "BIND")) (defcustom org-structure-template-alist '( @@ -8120,6 +8924,8 @@ This function can be used in a hook." "<quote>\n?\n</quote>") ("v" "#+begin_verse\n?\n#+end_verse" "<verse>\n?\n/verse>") + ("c" "#+begin_center\n?\n#+end_center" + "<center>\n?\n/center>") ("l" "#+begin_latex\n?\n#+end_latex" "<literal style=\"latex\">\n?\n</literal>") ("L" "#+latex: " @@ -8165,13 +8971,14 @@ expands them." (defun org-complete-expand-structure-template (start cell) "Expand a structure template." (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates)) - (rpl (nth (if musep 2 1) cell))) + (rpl (nth (if musep 2 1) cell)) + (ind "")) (delete-region start (point)) (when (string-match "\\`#\\+" rpl) (cond ((bolp)) ((not (string-match "\\S-" (buffer-substring (point-at-bol) (point)))) - (delete-region (point-at-bol) (point))) + (setq ind (buffer-substring (point-at-bol) (point)))) (t (newline)))) (setq start (point)) (if (string-match "%file" rpl) @@ -8182,6 +8989,8 @@ expands them." (abbreviate-file-name (read-file-name "Include file: "))) "\"") t t rpl))) + (setq rpl (mapconcat 'identity (split-string rpl "\n") + (concat "\n" ind))) (insert rpl) (if (re-search-backward "\\?" start t) (delete-char 1)))) @@ -8352,7 +9161,20 @@ this is nil.") (push (nth 2 e) rtn))) rtn))))) +(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 +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." ) + (defvar org-agenda-headline-snapshot-before-repeat) + (defun org-todo (&optional arg) "Change the TODO state of an item. The state of an item is given by a keyword at the start of the heading, @@ -8381,14 +9203,19 @@ For calling through lisp, arg is also interpreted in the following way: really is a member of `org-todo-keywords'." (interactive "P") (if (equal arg '(16)) (setq arg 'nextset)) - (let ((org-blocker-hook org-blocker-hook)) + (let ((org-blocker-hook org-blocker-hook) + (case-fold-search nil)) (when (equal arg '(64)) (setq arg nil org-blocker-hook nil)) + (when (and org-blocker-hook + (or org-inhibit-blocking + (org-entry-get nil "NOBLOCKING"))) + (setq org-blocker-hook nil)) (save-excursion (catch 'exit (org-back-to-heading) (if (looking-at outline-regexp) (goto-char (1- (match-end 0)))) - (or (looking-at (concat " +" org-todo-regexp " *")) + (or (looking-at (concat " +" org-todo-regexp "\\( +\\|$\\)")) (looking-at " *")) (let* ((match-data (match-data)) (startpos (point-at-bol)) @@ -8457,15 +9284,18 @@ For calling through lisp, arg is also interpreted in the following way: ((null member) (or head (car org-todo-keywords-1))) ((equal this final-done-word) nil) ;; -> make empty ((null tail) nil) ;; -> first entry - ((eq interpret 'sequence) - (car tail)) ((memq interpret '(type priority)) (if (eq this-command last-command) (car tail) (if (> (length tail) 0) (or done-word (car org-done-keywords)) nil))) - (t nil))) + (t + (car tail)))) + (state (or + (run-hook-with-args-until-success + 'org-todo-get-default-hook state last-state) + state)) (next (if state (concat " " state " ") " ")) (change-plist (list :type 'todo-state-change :from this :to state :position startpos)) @@ -8504,10 +9334,13 @@ For calling through lisp, arg is also interpreted in the following way: (not (member this org-done-keywords)))) (and logging (org-local-logging logging)) (when (and (or org-todo-log-states org-log-done) + (not (eq org-inhibit-logging t)) (not (memq arg '(nextset previousset)))) ;; we need to look at recording a time and note (setq dolog (or (nth 1 (assoc state org-todo-log-states)) (nth 2 (assoc this org-todo-log-states)))) + (if (and (eq dolog 'note) (eq org-inhibit-logging 'note)) + (setq dolog 'time)) (when (and state (member state org-not-done-keywords) (not (member this org-not-done-keywords))) @@ -8518,10 +9351,10 @@ For calling through lisp, arg is also interpreted in the following way: ;; It is now done, and it was not done before (org-add-planning-info 'closed (org-current-time)) (if (and (not dolog) (eq 'note org-log-done)) - (org-add-log-setup 'done state 'findpos 'note))) + (org-add-log-setup 'done state this 'findpos 'note))) (when (and state dolog) ;; This is a non-nil state, and we need to log it - (org-add-log-setup 'state state 'findpos dolog))) + (org-add-log-setup 'state state this 'findpos dolog))) ;; Fixup tag positioning (org-todo-trigger-tag-changes state) (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) @@ -8547,12 +9380,12 @@ For calling through lisp, arg is also interpreted in the following way: (< (point) (+ 2 (or (match-end 2) (match-end 1))))) (progn (goto-char (or (match-end 2) (match-end 1))) - (just-one-space))) + (and (looking-at " ") (just-one-space)))) (when org-trigger-hook (save-excursion (run-hook-with-args 'org-trigger-hook change-plist)))))))) -(defun org-block-todo-from-children-or-siblings (change-plist) +(defun org-block-todo-from-children-or-siblings-or-parent (change-plist) "Block turning an entry into a TODO, using the hierarchy. This checks whether the current task should be blocked from state changes. Such blocking occurs when: @@ -8561,7 +9394,11 @@ changes. Such blocking occurs when: 2. A task has a parent with the property :ORDERED:, and there are siblings prior to the current task with incomplete - status." + status. + + 3. The parent of the task is blocked because it has siblings that should + be done first, or is child of a block grandparent TODO entry." + (catch 'dont-block ;; If this is not a todo state change, or if this entry is already DONE, ;; do not block @@ -8590,36 +9427,64 @@ changes. Such blocking occurs when: ;; any previous siblings are undone, it's blocked (save-excursion (org-back-to-heading t) - (when (save-excursion - (ignore-errors - (org-up-heading-all 1) - (org-entry-get (point) "ORDERED"))) - (let* ((this-level (funcall outline-level)) - (current-level this-level)) - (while (and (not (bobp)) - (= current-level this-level)) - (outline-previous-heading) - (setq current-level (funcall outline-level)) - (if (= current-level this-level) - ;; this todo has children, check whether they are all - ;; completed - (if (and (not (org-entry-is-done-p)) - (org-entry-is-todo-p)) - (throw 'dont-block nil))))))) - t)) ; don't block + (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") + (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. + ;; Search further up the hierarchy, to see if an anchestor is blocked + (while t + (goto-char parent-pos) + (if (not (looking-at org-not-done-heading-regexp)) + (throw 'dont-block t)) ; do not block, parent is not a TODO + (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") + (forward-line 1) + (re-search-forward org-not-done-heading-regexp pos t)) + (throw 'dont-block nil))))))) ; block, older sibling not done. + +(defcustom org-track-ordered-property-with-tag nil + "Should the ORDERED property also be shown as a tag? +The ORDERED property decides if an entry should require subtasks to be +completed in sequence. Since a property is not very visible, setting +this option means that toggling the ORDERED property with the command +`org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is +not relevant for the behavior, but it makes things more visible. + +Note that toggling the tag with tags commands will not change the property +and therefore not influence behavior! + +This can be t, meaning the tag ORDERED should be used, It can also be a +string to select a different tag for this task." + :group 'org-todo + :type '(choice + (const :tag "No tracking" nil) + (const :tag "Track with ORDERED tag" t) + (string :tag "Use other tag"))) (defun org-toggle-ordered-property () - "Toggle the ORDERED property of the current entry." + "Toggle the ORDERED property of the current entry. +For better visibility, you can track the value of this property with a tag. +See variable `org-track-ordered-property-with-tag'." (interactive) - (save-excursion - (org-back-to-heading) - (if (org-entry-get nil "ORDERED") - (progn - (org-delete-property "ORDERED") - (message "Subtasks can be completed in arbitrary order or parallel")) - (org-entry-put nil "ORDERED" "t") - (message "Subtasks must be completed in sequence")))) - + (let* ((t1 org-track-ordered-property-with-tag) + (tag (and t1 (if (stringp t1) t1 "ORDERED")))) + (save-excursion + (org-back-to-heading) + (if (org-entry-get nil "ORDERED") + (progn + (org-delete-property "ORDERED") + (and tag (org-toggle-tag tag 'off)) + (message "Subtasks can be completed in arbitrary order")) + (org-entry-put nil "ORDERED" "t") + (and tag (org-toggle-tag tag 'on)) + (message "Subtasks must be completed in sequence"))))) + +(defvar org-blocked-by-checkboxes) ; dynamically scoped (defun org-block-todo-from-checkboxes (change-plist) "Block turning an entry into a TODO, using checkboxes. This checks whether the current task should be blocked from state @@ -8642,39 +9507,77 @@ changes because there are uncheckd boxes in this entry." (goto-char beg) (if (re-search-forward "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\[[- ]\\]" end t) - (throw 'dont-block nil)))) + (progn + (if (boundp 'org-blocked-by-checkboxes) + (setq org-blocked-by-checkboxes t)) + (throw 'dont-block nil))))) t)) ; do not block +(defvar org-entry-property-inherited-from) ;; defined below (defun org-update-parent-todo-statistics () - "Update any statistics cookie in the parent of the current headline." + "Update any statistics cookie in the parent of the current headline. +When `org-hierarchical-todo-statistics' is nil, statistics will cover +the entire subtree and this will travel up the hierarchy and update +statistics everywhere." (interactive) - (let ((box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - level (cnt-all 0) (cnt-done 0) is-percent kwd cookie-present) + (let* ((lim 0) prop + (recursive (or (not org-hierarchical-todo-statistics) + (string-match + "\\<recursive\\>" + (or (setq prop (org-entry-get + nil "COOKIE_DATA" 'inherit)) "")))) + (lim (or (and prop (marker-position + org-entry-property-inherited-from)) + lim)) + (first t) + (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + level ltoggle l1 + (cnt-all 0) (cnt-done 0) is-percent kwd cookie-present) (catch 'exit (save-excursion - (setq level (org-up-heading-safe)) - (unless level - (throw 'exit nil)) - (while (re-search-forward box-re (point-at-eol) t) - (setq cnt-all 0 cnt-done 0 cookie-present t) - (setq is-percent (match-end 2)) - (save-match-data - (unless (outline-next-heading) (throw 'exit nil)) - (while (looking-at org-todo-line-regexp) - (setq kwd (match-string 2)) - (and kwd (setq cnt-all (1+ cnt-all))) - (and (member kwd org-done-keywords) - (setq cnt-done (1+ cnt-done))) - (condition-case nil - (org-forward-same-level 1) - (error (end-of-line 1))))) - (replace-match - (if is-percent - (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all))) - (format "[%d/%d]" cnt-done cnt-all)))) + (beginning-of-line 1) + (if (org-at-heading-p) + (setq ltoggle (funcall outline-level)) + (error "This should not happen")) + (while (and (setq level (org-up-heading-safe)) + (or recursive first) + (>= (point) lim)) + (setq first nil) + (unless (and level + (not (string-match + "\\<checkbox\\>" + (downcase + (or (org-entry-get + nil "COOKIE_DATA") + ""))))) + (throw 'exit nil)) + (while (re-search-forward box-re (point-at-eol) t) + (setq cnt-all 0 cnt-done 0 cookie-present t) + (setq is-percent (match-end 2)) + (save-match-data + (unless (outline-next-heading) (throw 'exit nil)) + (while (and (looking-at org-complex-heading-regexp) + (> (setq l1 (length (match-string 1))) level)) + (setq kwd (and (or recursive (= l1 ltoggle)) + (match-string 2))) + (if (or (eq org-provide-todo-statistics 'all-headlines) + (and (listp org-provide-todo-statistics) + (or (member kwd org-provide-todo-statistics) + (member kwd org-done-keywords)))) + (setq cnt-all (1+ cnt-all)) + (if (eq org-provide-todo-statistics t) + (and kwd (setq cnt-all (1+ cnt-all))))) + (and (member kwd org-done-keywords) + (setq cnt-done (1+ cnt-done))) + (outline-next-heading))) + (replace-match + (if is-percent + (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all))) + (format "[%d/%d]" cnt-done cnt-all))))) (when cookie-present (run-hook-with-args 'org-after-todo-statistics-hook - cnt-done (- cnt-all cnt-done))))))) + cnt-done (- cnt-all cnt-done))))) + (run-hooks 'org-todo-statistics-hook))) (defvar org-after-todo-statistics-hook nil "Hook that is called after a TODO statistics cookie has been updated. @@ -8692,6 +9595,11 @@ when there is a statistics cookie in the headline! (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\")))) ") +(defvar org-todo-statistics-hook nil + "Hook that is run whenever Org thinks TODO statistics should be updated. +This hook runs even if there is no statisics cookie present, in which case +`org-after-todo-statistics-hook' would not run.") + (defun org-todo-trigger-tag-changes (state) "Apply the changes defined in `org-todo-state-tags-triggers'." (let ((l org-todo-state-tags-triggers) @@ -8773,6 +9681,14 @@ Returns the new TODO keyword, or nil if no state change should occur." ((equal e '(:endgroup)) (setq ingroup nil cnt 0) (insert "}\n")) + ((equal e '(:newline)) + (when (not (= cnt 0)) + (setq cnt 0) + (insert "\n") + (setq e (car tbl)) + (while (equal (car tbl) '(:newline)) + (insert "\n") + (setq tbl (cdr tbl))))) (t (setq tg (car e) c (cdr e)) (if ingroup (push tg (car groups))) @@ -8864,6 +9780,8 @@ This function is run automatically after each state change to a DONE 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))) (when org-log-repeat (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) (memq 'org-add-log-note post-command-hook)) @@ -8873,6 +9791,7 @@ This function is run automatically after each state change to a DONE state." (setq org-log-note-how 'note)) ;; Set up for taking a record (org-add-log-setup 'state (or done-word (car org-done-keywords)) + last-state 'findpos org-log-repeat))) (org-back-to-heading t) (org-add-planning-info nil nil 'closed) @@ -8921,7 +9840,7 @@ This function is run automatically after each state change to a DONE state." "Make a compact tree which shows all headlines marked with TODO. The tree will show the lines where the regexp matches, and all higher headlines above the match. -With a \\[universal-argument] prefix, also show the DONE entries. +With a \\[universal-argument] prefix, prompt for a regexp to match. With a numeric prefix N, construct a sparse tree for the Nth element of `org-todo-keywords-1'." (interactive "P") @@ -8971,6 +9890,22 @@ scheduling will use the corresponding date." (org-add-planning-info 'scheduled time 'closed) (message "Scheduled to %s" org-last-inserted-timestamp)))) +(defun org-get-scheduled-time (pom &optional inherit) + "Get the scheduled time as a time tuple, of a format suitable +for calling org-schedule with, or if there is no scheduling, +returns nil." + (let ((time (org-entry-get pom "SCHEDULED" inherit))) + (when time + (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 +calling org-deadlin with, or if there is no scheduling, returns +nil." + (let ((time (org-entry-get pom "DEADLINE" inherit))) + (when time + (apply 'encode-time (org-parse-time-string time))))) + (defun org-remove-timestamp-with-keyword (keyword) "Remove all time stamps with KEYWORD in the current entry." (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*")) @@ -8999,88 +9934,96 @@ be removed." (let (org-time-was-given org-end-time-was-given ts end default-time default-input) - (when (and (not time) (memq what '(scheduled deadline))) - ;; Try to get a default date/time from existing timestamp - (save-excursion - (org-back-to-heading t) - (setq end (save-excursion (outline-next-heading) (point))) - (when (re-search-forward (if (eq what 'scheduled) - org-scheduled-time-regexp - org-deadline-time-regexp) - end t) - (setq ts (match-string 1) - default-time - (apply 'encode-time (org-parse-time-string ts)) - default-input (and ts (org-get-compact-tod ts)))))) - (when what - ;; If necessary, get the time from the user - (setq time (or time (org-read-date nil 'to-time nil nil - default-time default-input)))) - - (when (and org-insert-labeled-timestamps-at-point - (member what '(scheduled deadline))) - (insert - (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ") - (org-insert-time-stamp time org-time-was-given - nil nil nil (list org-end-time-was-given)) - (setq what nil)) - (save-excursion - (save-restriction - (let (col list elt ts buffer-invisibility-spec) + (catch 'exit + (when (and (not time) (memq what '(scheduled deadline))) + ;; Try to get a default date/time from existing timestamp + (save-excursion (org-back-to-heading t) - (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*")) - (goto-char (match-end 1)) - (setq col (current-column)) - (goto-char (match-end 0)) - (if (eobp) (insert "\n") (forward-char 1)) - (if (and (not (looking-at outline-regexp)) - (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp - "[^\r\n]*")) - (not (equal (match-string 1) org-clock-string))) - (narrow-to-region (match-beginning 0) (match-end 0)) - (insert-before-markers "\n") - (backward-char 1) - (narrow-to-region (point) (point)) - (and org-adapt-indentation (org-indent-to-column col))) - ;; Check if we have to remove something. - (setq list (cons what remove)) - (while list - (setq elt (pop list)) + (setq end (save-excursion (outline-next-heading) (point))) + (when (re-search-forward (if (eq what 'scheduled) + org-scheduled-time-regexp + org-deadline-time-regexp) + end t) + (setq ts (match-string 1) + default-time + (apply 'encode-time (org-parse-time-string ts)) + default-input (and ts (org-get-compact-tod ts)))))) + (when what + ;; If necessary, get the time from the user + (setq time (or time (org-read-date nil 'to-time nil nil + default-time default-input)))) + + (when (and org-insert-labeled-timestamps-at-point + (member what '(scheduled deadline))) + (insert + (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ") + (org-insert-time-stamp time org-time-was-given + nil nil nil (list org-end-time-was-given)) + (setq what nil)) + (save-excursion + (save-restriction + (let (col list elt ts buffer-invisibility-spec) + (org-back-to-heading t) + (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*")) + (goto-char (match-end 1)) + (setq col (current-column)) + (goto-char (match-end 0)) + (if (eobp) (insert "\n") (forward-char 1)) + (when (and (not what) + (not (looking-at + (concat "[ \t]*" + org-keyword-time-not-clock-regexp)))) + ;; Nothing to add, nothing to remove...... :-) + (throw 'exit nil)) + (if (and (not (looking-at outline-regexp)) + (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp + "[^\r\n]*")) + (not (equal (match-string 1) org-clock-string))) + (narrow-to-region (match-beginning 0) (match-end 0)) + (insert-before-markers "\n") + (backward-char 1) + (narrow-to-region (point) (point)) + (and org-adapt-indentation (org-indent-to-column col))) + ;; Check if we have to remove something. + (setq list (cons what remove)) + (while list + (setq elt (pop list)) + (goto-char (point-min)) + (when (or (and (eq elt 'scheduled) + (re-search-forward org-scheduled-time-regexp nil t)) + (and (eq elt 'deadline) + (re-search-forward org-deadline-time-regexp nil t)) + (and (eq elt 'closed) + (re-search-forward org-closed-time-regexp nil t))) + (replace-match "") + (if (looking-at "--+<[^>]+>") (replace-match "")) + (if (looking-at " +") (replace-match "")))) + (goto-char (point-max)) + (when what + (insert + (if (not (or (bolp) (eq (char-before) ?\ ))) " " "") + (cond ((eq what 'scheduled) org-scheduled-string) + ((eq what 'deadline) org-deadline-string) + ((eq what 'closed) org-closed-string)) + " ") + (setq ts (org-insert-time-stamp + time + (or org-time-was-given + (and (eq what 'closed) org-log-done-with-time)) + (eq what 'closed) + nil nil (list org-end-time-was-given))) + (end-of-line 1)) (goto-char (point-min)) - (when (or (and (eq elt 'scheduled) - (re-search-forward org-scheduled-time-regexp nil t)) - (and (eq elt 'deadline) - (re-search-forward org-deadline-time-regexp nil t)) - (and (eq elt 'closed) - (re-search-forward org-closed-time-regexp nil t))) - (replace-match "") - (if (looking-at "--+<[^>]+>") (replace-match "")) - (if (looking-at " +") (replace-match "")))) - (goto-char (point-max)) - (when what - (insert - (if (not (or (bolp) (eq (char-before) ?\ ))) " " "") - (cond ((eq what 'scheduled) org-scheduled-string) - ((eq what 'deadline) org-deadline-string) - ((eq what 'closed) org-closed-string)) - " ") - (setq ts (org-insert-time-stamp - time - (or org-time-was-given - (and (eq what 'closed) org-log-done-with-time)) - (eq what 'closed) - nil nil (list org-end-time-was-given))) - (end-of-line 1)) - (goto-char (point-min)) - (widen) - (if (and (looking-at "[ \t]+\n") - (equal (char-before) ?\n)) - (delete-region (1- (point)) (point-at-eol))) - ts))))) + (widen) + (if (and (looking-at "[ \t]+\n") + (equal (char-before) ?\n)) + (delete-region (1- (point)) (point-at-eol))) + ts)))))) (defvar org-log-note-marker (make-marker)) (defvar org-log-note-purpose nil) (defvar org-log-note-state nil) +(defvar org-log-note-previous-state nil) (defvar org-log-note-how nil) (defvar org-log-note-extra nil) (defvar org-log-note-window-configuration nil) @@ -9093,45 +10036,67 @@ The auto-repeater uses this.") "Add a note to the current entry. This is done in the same way as adding a state change note." (interactive) - (org-add-log-setup 'note nil 'findpos nil)) + (org-add-log-setup 'note nil nil 'findpos nil)) (defvar org-property-end-re) -(defun org-add-log-setup (&optional purpose state findpos how &optional extra) +(defun org-add-log-setup (&optional purpose state prev-state + findpos how &optional extra) "Set up the post command hook to take a note. If this is about to TODO state change, the new state is expected in STATE. When FINDPOS is non-nil, find the correct position for the note in the current entry. If not, assume that it can be inserted at point. HOW is an indicator what kind of note should be created. EXTRA is additional text that will be inserted into the notes buffer." - (save-restriction - (save-excursion - (when findpos - (org-back-to-heading t) - (narrow-to-region (point) (save-excursion - (outline-next-heading) (point))) - (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*" - "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp - "[^\r\n]*\\)?")) - (goto-char (match-end 0)) - (when (and org-log-state-notes-insert-after-drawers - (save-excursion - (forward-line) (looking-at org-drawer-regexp))) - (progn (forward-line) - (while (looking-at org-drawer-regexp) - (goto-char (match-end 0)) - (re-search-forward org-property-end-re (point-max) t) - (forward-line)) - (forward-line -1))) - (unless org-log-states-order-reversed - (and (= (char-after) ?\n) (forward-char 1)) - (org-skip-over-state-notes) - (skip-chars-backward " \t\n\r"))) - (move-marker org-log-note-marker (point)) - (setq org-log-note-purpose purpose - org-log-note-state state - org-log-note-how how - org-log-note-extra extra) - (add-hook 'post-command-hook 'org-add-log-note 'append)))) + (let* ((org-log-into-drawer (org-log-into-drawer)) + (drawer (cond ((stringp org-log-into-drawer) + org-log-into-drawer) + (org-log-into-drawer "LOGBOOK") + (t nil)))) + (save-restriction + (save-excursion + (when findpos + (org-back-to-heading t) + (narrow-to-region (point) (save-excursion + (outline-next-heading) (point))) + (looking-at (concat outline-regexp "\\( *\\)[^\r\n]*" + "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp + "[^\r\n]*\\)?")) + (goto-char (match-end 0)) + (cond + (drawer + (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*$") + nil t) + (progn + (goto-char (match-end 0)) + (or org-log-states-order-reversed + (and (re-search-forward org-property-end-re nil t) + (goto-char (1- (match-beginning 0)))))) + (insert "\n:" drawer ":\n:END:") + (beginning-of-line 0) + (org-indent-line-function) + (beginning-of-line 2) + (org-indent-line-function) + (end-of-line 0))) + ((and org-log-state-notes-insert-after-drawers + (save-excursion + (forward-line) (looking-at org-drawer-regexp))) + (forward-line) + (while (looking-at org-drawer-regexp) + (goto-char (match-end 0)) + (re-search-forward org-property-end-re (point-max) t) + (forward-line)) + (forward-line -1))) + (unless org-log-states-order-reversed + (and (= (char-after) ?\n) (forward-char 1)) + (org-skip-over-state-notes) + (skip-chars-backward " \t\n\r"))) + (move-marker org-log-note-marker (point)) + (setq org-log-note-purpose purpose + org-log-note-state state + org-log-note-previous-state prev-state + org-log-note-how how + org-log-note-extra extra) + (add-hook 'post-command-hook 'org-add-log-note 'append))))) (defun org-skip-over-state-notes () "Skip past the list of State notes in an entry." @@ -9160,7 +10125,9 @@ EXTRA is additional text that will be inserted into the notes buffer." ((eq org-log-note-purpose 'clock-out) "stopped clock") ((eq org-log-note-purpose 'done) "closed todo item") ((eq org-log-note-purpose 'state) - (format "state change to \"%s\"" org-log-note-state)) + (format "state change from \"%s\" to \"%s\"" + (or org-log-note-previous-state "") + (or org-log-note-state ""))) ((eq org-log-note-purpose 'note) "this entry") (t (error "This should not happen"))))) @@ -9190,10 +10157,18 @@ EXTRA is additional text that will be inserted into the notes buffer." (current-time))) (cons "%s" (if org-log-note-state (concat "\"" org-log-note-state "\"") - ""))))) + "")) + (cons "%S" (if org-log-note-previous-state + (concat "\"" org-log-note-previous-state "\"") + "\"\""))))) (if lines (setq note (concat note " \\\\"))) (push note lines)) - (when (or current-prefix-arg org-note-abort) (setq lines nil)) + (when (or current-prefix-arg org-note-abort) + (when org-log-into-drawer + (org-remove-empty-drawer-at + (if (stringp org-log-into-drawer) org-log-into-drawer "LOGBOOK") + org-log-note-marker)) + (setq lines nil)) (when lines (save-excursion (set-buffer (marker-buffer org-log-note-marker)) @@ -9202,44 +10177,62 @@ EXTRA is additional text that will be inserted into the notes buffer." (move-marker org-log-note-marker nil) (end-of-line 1) (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) - (indent-relative nil) (insert "- " (pop lines)) (org-indent-line-function) (beginning-of-line 1) (looking-at "[ \t]*") (setq ind (concat (match-string 0) " ")) (end-of-line 1) - (while lines (insert "\n" ind (pop lines))))))) + (while lines (insert "\n" ind (pop lines))) + (message "Note stored") + (org-back-to-heading t) + (org-cycle-hide-drawers 'children))))) (set-window-configuration org-log-note-window-configuration) (with-current-buffer (marker-buffer org-log-note-return-to) (goto-char org-log-note-return-to)) (move-marker org-log-note-return-to nil) (and org-log-post-message (message "%s" org-log-post-message))) +(defun org-remove-empty-drawer-at (drawer pos) + "Remove an emptyr DARWER drawer at position POS. +POS may also be a marker." + (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (if (org-in-regexp + (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2) + (replace-match "")))))) + (defun org-sparse-tree (&optional arg) "Create a sparse tree, prompt for the details. 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 entries selected by a tags match. +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. -r Show entries matching a regular expression -d Show deadlines due within `org-deadline-warning-days'." +r Show entries matching a regular expression. +d Show deadlines due within `org-deadline-warning-days'. +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 [T]ag [p]roperty [d]eadlines [b]efore-date") + (message "Sparse tree: [/]regexp [t]odo-kwd [m]atch [p]roperty [d]eadlines [b]efore-date [a]fter-date") (setq ans (read-char-exclusive)) (cond ((equal ans ?d) (call-interactively 'org-check-deadlines)) ((equal ans ?b) (call-interactively 'org-check-before-date)) + ((equal ans ?a) + (call-interactively 'org-check-after-date)) ((equal ans ?t) (org-show-todo-tree '(4))) - ((equal ans ?T) - (call-interactively 'org-tags-sparse-tree)) + ((member ans '(?T ?m)) + (call-interactively 'org-match-sparse-tree)) ((member ans '(?p ?P)) (setq kwd (org-ido-completing-read "Property: " (mapcar 'list (org-buffer-property-keys)))) @@ -9247,7 +10240,7 @@ d Show deadlines due within `org-deadline-warning-days'." (mapcar 'list (org-property-values kwd)))) (unless (string-match "\\`{.*}\\'" value) (setq value (concat "\"" value "\""))) - (org-tags-sparse-tree arg (concat kwd "=" value))) + (org-match-sparse-tree arg (concat kwd "=" value))) ((member ans '(?r ?R ?/)) (call-interactively 'org-occur)) (t (error "No such sparse tree command \"%c\"" ans))))) @@ -9278,6 +10271,8 @@ command. If CALLBACK is non-nil, it is a function which is called to confirm that the match should indeed be shown." (interactive "sRegexp: \nP") + (when (equal regexp "") + (error "Regexp cannot be empty")) (unless keep-previous (org-remove-occur-highlights nil nil t)) (push (cons regexp callback) org-occur-parameters) @@ -9392,6 +10387,8 @@ from the `before-change-functions' in the current buffer." "Change the priority of an item by ARG. ACTION can be `set', `up', `down', or a character." (interactive) + (unless org-enable-priority-commands + (error "Priority commands are disabled")) (setq action (or action 'set)) (let (current new news have remove) (save-excursion @@ -9436,19 +10433,19 @@ ACTION can be `set', `up', `down', or a character." (replace-match news t t nil 2)) (if remove (error "No priority cookie found in line") - (looking-at org-todo-line-regexp) + (let ((case-fold-search nil)) + (looking-at org-todo-line-regexp)) (if (match-end 2) (progn (goto-char (match-end 2)) (insert " [#" news "]")) (goto-char (match-beginning 3)) - (insert "[#" news "] "))))) - (org-preserve-lc (org-set-tags nil 'align)) + (insert "[#" news "] ")))) + (org-preserve-lc (org-set-tags nil 'align))) (if remove (message "Priority removed") (message "Priority of current item set to %s" news)))) - (defun org-get-priority (s) "Find priority cookie and return priority." (save-match-data @@ -9460,6 +10457,23 @@ ACTION can be `set', `up', `down', or a character." ;;;; Tags (defvar org-agenda-archives-mode) +(defvar org-map-continue-from nil + "Position from where mapping should continue. +Can be set byt the action argument to `org-scan-tag's and `org-map-entries'.") + +(defvar org-scanner-tags nil + "The current tag list while the tags scanner is running.") +(defvar org-trust-scanner-tags nil + "Should `org-get-tags-at' use the tags fro the scanner. +This is for internal dynamical scoping only. +When this is non-nil, the function `org-get-tags-at' will return the value +of `org-scanner-tags' instead of building the list by itself. This +can lead to large speed-ups when the tags scanner is used in a file with +many entries, and when the list of tags is retrieved, for example to +obtain a list of properties. Building the tags list for each entry in such +a file becomes an N^2 operation - but with this variable set, it scales +as N.") + (defun org-scan-tags (action matcher &optional todo-only) "Scan headline tags with inheritance and produce output ACTION. @@ -9472,12 +10486,12 @@ MATCHER is a Lisp form to be evaluated, testing if a given set of tags qualifies a headline for inclusion. When TODO-ONLY is non-nil, only lines with a TODO keyword are included in the output." (require 'org-agenda) - (let* ((re (concat "[\n\r]" outline-regexp " *\\(\\<\\(" + (let* ((re (concat "^" outline-regexp " *\\(\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") (org-re "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*$"))) (props (list 'face 'default - 'done-face 'org-done + 'done-face 'org-agenda-done 'undone-face 'default 'mouse-face 'highlight 'org-not-done-regexp org-not-done-regexp @@ -9489,8 +10503,9 @@ only lines with a TODO keyword are included in the output." (or (buffer-file-name (buffer-base-buffer)) (buffer-name (buffer-base-buffer))))))) (case-fold-search nil) + (org-map-continue-from nil) lspos tags tags-list - (tags-alist (list (cons 0 (mapcar 'downcase org-file-tags)))) + (tags-alist (list (cons 0 org-file-tags))) (llast 0) rtn rtn1 level category i txt todo marker entry priority) (when (not (or (member action '(agenda sparse-tree)) (functionp action))) @@ -9502,9 +10517,9 @@ only lines with a TODO keyword are included in the output." (org-remove-occur-highlights)) (while (re-search-forward re nil t) (catch :skip - (setq todo (if (match-end 1) (match-string 2)) - tags (if (match-end 4) (match-string 4))) - (goto-char (setq lspos (1+ (match-beginning 0)))) + (setq todo (if (match-end 1) (org-match-string-no-properties 2)) + tags (if (match-end 4) (org-match-string-no-properties 4))) + (goto-char (setq lspos (match-beginning 0))) (setq level (org-reduced-level (funcall outline-level)) category (org-get-category)) (setq i llast llast level) @@ -9515,14 +10530,15 @@ only lines with a TODO keyword are included in the output." (setq i (1- i))) ;; add the next tags (when tags - (setq tags (mapcar 'downcase (org-split-string tags ":")) + (setq tags (org-split-string tags ":") tags-alist (cons (cons level tags) tags-alist))) ;; compile tags for current headline (setq tags-list (if org-use-tag-inheritance (apply 'append (mapcar 'cdr (reverse tags-alist))) - tags)) + tags) + org-scanner-tags tags-list) (when org-use-tag-inheritance (setcdr (car tags-alist) (mapcar (lambda (x) @@ -9530,7 +10546,8 @@ only lines with a TODO keyword are included in the output." (org-add-prop-inherited x)) (cdar tags-alist)))) (when (and tags org-use-tag-inheritance - (not (eq t org-use-tag-inheritance))) + (or (not (eq t org-use-tag-inheritance)) + org-tags-exclude-from-inheritance)) ;; selective inheritance, remove uninherited ones (setcdr (car tags-alist) (org-remove-uniherited-tags (cdar tags-alist)))) @@ -9559,26 +10576,35 @@ only lines with a TODO keyword are included in the output." (setq txt (org-format-agenda-item "" (concat - (if org-tags-match-list-sublevels + (if (eq org-tags-match-list-sublevels 'indented) (make-string (1- level) ?.) "") (org-get-heading)) - category (org-get-tags-at)) + category + tags-list + ) priority (org-get-priority txt)) (goto-char lspos) (setq marker (org-agenda-new-marker)) (org-add-props txt props 'org-marker marker 'org-hd-marker marker 'org-category category + 'todo-state todo 'priority priority 'type "tagsmatch") (push txt rtn)) ((functionp action) + (setq org-map-continue-from nil) (save-excursion (setq rtn1 (funcall action)) - (push rtn1 rtn)) - (goto-char (point-at-eol))) + (push rtn1 rtn))) (t (error "Invalid action"))) ;; if we are to skip sublevels, jump to end of subtree - (or org-tags-match-list-sublevels (org-end-of-subtree t)))))) + (unless org-tags-match-list-sublevels + (org-end-of-subtree t) + (backward-char 1)))) + ;; Get the correct position from where to continue + (if org-map-continue-from + (goto-char org-map-continue-from) + (and (= (point) lspos) (end-of-line 1))))) (when (and (eq action 'sparse-tree) (not org-sparse-tree-open-archived-trees)) (org-hide-archived-subtrees (point-min) (point-max))) @@ -9607,7 +10633,7 @@ only lines with a TODO keyword are included in the output." (defvar todo-only) ;; dynamically scoped -(defun org-tags-sparse-tree (&optional todo-only match) +(defun org-match-sparse-tree (&optional todo-only match) "Create a sparse tree according to tags string MATCH. MATCH can contain positive and negative selection of tags, like \"+WORK+URGENT-WITHBOSS\". @@ -9617,6 +10643,8 @@ also TODO lines." (org-prepare-agenda-buffers (list (current-buffer))) (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) +(defalias 'org-tags-sparse-tree 'org-match-sparse-tree) + (defvar org-cached-props nil) (defun org-cached-entry-get (pom property) (if (or (eq t org-use-property-inheritance) @@ -9727,7 +10755,7 @@ also TODO lines." `(,po (or ,gv "") ,pv) `(,po (string-to-number (or ,gv "")) ,(string-to-number pv) )))) - (t `(member ,(downcase tag) tags-list))) + (t `(member ,tag tags-list))) mm (if minus (list 'not mm) mm) term rest) (push mm tagsmatcher)) @@ -9852,34 +10880,39 @@ the tags of the current headline come last. When LOCAL is non-nil, only return tags from the current headline, ignore inherited ones." (interactive) - (let (tags ltags lastpos parent) - (save-excursion - (save-restriction - (widen) - (goto-char (or pos (point))) - (save-match-data - (catch 'done - (condition-case nil - (progn - (org-back-to-heading t) - (while (not (equal lastpos (point))) - (setq lastpos (point)) - (when (looking-at (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$")) - (setq ltags (org-split-string - (org-match-string-no-properties 1) ":")) - (when parent - (setq ltags (mapcar 'org-add-prop-inherited ltags))) - (setq tags (append - (if parent - (org-remove-uniherited-tags ltags) - ltags) - tags))) - (or org-use-tag-inheritance (throw 'done t)) - (if local (throw 'done t)) - (org-up-heading-all 1) - (setq parent t))) - (error nil))))) - (append (org-remove-uniherited-tags org-file-tags) tags)))) + (if (and org-trust-scanner-tags + (or (not pos) (equal pos (point))) + (not local)) + org-scanner-tags + (let (tags ltags lastpos parent) + (save-excursion + (save-restriction + (widen) + (goto-char (or pos (point))) + (save-match-data + (catch 'done + (condition-case nil + (progn + (org-back-to-heading t) + (while (not (equal lastpos (point))) + (setq lastpos (point)) + (when (looking-at + (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$")) + (setq ltags (org-split-string + (org-match-string-no-properties 1) ":")) + (when parent + (setq ltags (mapcar 'org-add-prop-inherited ltags))) + (setq tags (append + (if parent + (org-remove-uniherited-tags ltags) + ltags) + tags))) + (or org-use-tag-inheritance (throw 'done t)) + (if local (throw 'done t)) + (or (org-up-heading-safe) (error nil)) + (setq parent t))) + (error nil))))) + (append (org-remove-uniherited-tags org-file-tags) tags))))) (defun org-add-prop-inherited (s) (add-text-properties 0 (length s) '(inherited t) s) @@ -9971,7 +11004,8 @@ With prefix ARG, realign all tags in headings in the current buffer." (setq tags current) ;; Get a new set of tags from the user (save-excursion - (setq table (or org-tag-alist (org-get-buffer-tags)) + (setq table (append org-tag-persistent-alist + (or org-tag-alist (org-get-buffer-tags))) org-last-tags-completion-table table current-tags (org-split-string current ":") inherited-tags (nreverse @@ -9993,8 +11027,13 @@ With prefix ARG, realign all tags in headings in the current buffer." ;; No boolean logic, just a list (setq tags (replace-match ":" t t tags)))) + (if org-tags-sort-function + (setq tags (mapconcat 'identity + (sort (org-split-string tags (org-re "[^[:alnum:]_@]+")) + org-tags-sort-function) ":"))) + (if (string-match "\\`[\t ]*\\'" tags) - (setq tags "") + (setq tags "") (unless (string-match ":$" tags) (setq tags (concat tags ":"))) (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) @@ -10177,6 +11216,14 @@ Returns the new tags string, or nil to not change the current settings." ((equal e '(:endgroup)) (setq ingroup nil cnt 0) (insert "}\n")) + ((equal e '(:newline)) + (when (not (= cnt 0)) + (setq cnt 0) + (insert "\n") + (setq e (car tbl)) + (while (equal (car tbl) '(:newline)) + (insert "\n") + (setq tbl (cdr tbl))))) (t (setq tg (car e) c2 nil) (if (cdr e) @@ -10332,6 +11379,17 @@ arguments, with the cursor positioned at the beginning of the headline. The return values of all calls to the function will be collected and returned as a list. +The call to FUNC will be wrapped into a save-excursion form, so FUNC +does not need to preserve point. After evaluation, the cursor will be +moved to the end of the line (presumably of the headline of the +processed entry) and search continues from there. Under some +circumstances, this may not produce the wanted results. For example, +if you have removed (e.g. archived) the current (sub)tree it could +mean that the next entry will be skipped entirely. In such cases, you +can specify the position from where search should continue by making +FUNC set the variable `org-map-continue-from' to the desired buffer +position. + MATCH is a tags/property/todo match as it is used in the agenda tags view. Only headlines that are matched by this query will be considered during the iteration. When MATCH is nil or t, all headlines will be @@ -10359,7 +11417,16 @@ the scanner. The following items can be given here: will be used as value for `org-agenda-skip-function', so whenever the the function returns t, FUNC will not be called for that entry and search will continue from the point where the - function leaves it." + function leaves it. + +If your function needs to retrieve the tags including inherited tags +at the *current* entry, you can use the value of the variable +`org-scanner-tags' which will be much faster than getting the value +with `org-get-tags-at'. If your function gets properties with +`org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags' +to t around the call to `org-entry-properties' to get the same speedup. +Note that if your function moves around to retrieve tags and properties at +a *different* entry, you cannot use these techniques." (let* ((org-agenda-archives-mode nil) ; just to make sure (org-agenda-skip-archived-trees (memq 'archive skip)) (org-agenda-skip-comment-trees (memq 'comment skip)) @@ -10425,10 +11492,12 @@ These are properties that are not defined in the property drawer, but in some other way.") (defconst org-default-properties - '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" + '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID" "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" - "EXPORT_FILE_NAME" "EXPORT_TITLE" "ORDERED") + "EXPORT_FILE_NAME" "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" + "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" + "CLOCK_MODELINE_TOTAL") "Some properties that are used by Org-mode for various purposes. Being in this list makes sure that they are offered for completion.") @@ -10564,7 +11633,7 @@ If WHICH is nil or `all', get all properties. If WHICH is ) (when (memq which '(all standard)) - ;; Get the standard properties, like :PORP: ... + ;; Get the standard properties, like :PROP: ... (setq range (org-get-property-block beg end)) (when range (goto-char (car range)) @@ -10805,7 +11874,8 @@ formats in the current buffer." (setq rtn (append org-special-properties rtn))) (when include-defaults - (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties)) + (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties) + (add-to-list 'rtn org-effort-property)) (when include-columns (save-excursion @@ -10843,7 +11913,9 @@ formats in the current buffer." (interactive) (org-back-to-heading t) (looking-at outline-regexp) - (let ((indent (- (match-end 0)(match-beginning 0))) + (let ((indent (if org-adapt-indentation + (- (match-end 0)(match-beginning 0)) + 0)) (beg (point)) (re (concat "^[ \t]*" org-keyword-time-regexp)) end hiddenp) @@ -10854,8 +11926,13 @@ formats in the current buffer." (setq hiddenp (org-invisible-p)) (end-of-line 1) (and (equal (char-after) ?\n) (forward-char 1)) - (while (looking-at "^[ \t]*\\(:CLOCK:\\|CLOCK\\|:END:\\)") - (beginning-of-line 2)) + (while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)") + (if (member (match-string 1) '("CLOCK:" ":END:")) + ;; just skip this line + (beginning-of-line 2) + ;; Drawer start, find the end + (re-search-forward "^\\*+ \\|^[ \t]*:END:" nil t) + (beginning-of-line 1))) (org-skip-over-state-notes) (skip-chars-backward " \t\n\r") (if (eq (char-before) ?*) (forward-char 1)) @@ -10893,11 +11970,12 @@ in the current file." (existing (mapcar 'list (org-property-values prop))) (val (if allowed (org-completing-read "Value: " allowed nil 'req-match) - (org-completing-read-no-ido - (concat "Value" (if (and cur (string-match "\\S-" cur)) - (concat "[" cur "]") "") - ": ") - existing nil nil "" nil cur)))) + (let (org-completion-use-ido) + (org-completing-read + (concat "Value" (if (and cur (string-match "\\S-" cur)) + (concat "[" cur "]") "") + ": ") + existing nil nil "" nil cur))))) (list prop (if (equal val "") cur val)))) (unless (equal (org-entry-get nil property) value) (org-entry-put nil property value))) @@ -11026,7 +12104,7 @@ Return the position where this entry starts, or nil if there is no such entry." (when (re-search-forward (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$") nil t) - (org-back-to-heading) + (org-back-to-heading t) (point)))))) ;;;; Timestamps @@ -11125,6 +12203,8 @@ So these are more for recording a certain time/date." (defvar org-overriding-default-time nil) ; dynamically scoped (defvar org-read-date-overlay nil) (defvar org-dcst nil) ; dynamically scoped +(defvar org-read-date-history nil) +(defvar org-read-date-final-answer nil) (defun org-read-date (&optional with-time to-time from-string prompt default-time default-input) @@ -11188,6 +12268,7 @@ user." (setcar (nthcdr 1 defdecode) 59) (setq def (apply 'encode-time defdecode) defdecode (decode-time def))))) + (calendar-frame-setup nil) (calendar-move-hook nil) (calendar-view-diary-initially-flag nil) (view-diary-entries-initially nil) @@ -11214,44 +12295,58 @@ user." (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-calendar-select-mouse) (org-defkey map (if (featurep 'xemacs) [button2] [mouse-2]) - 'org-calendar-select-mouse) + 'org-calendar-select-mouse) (org-defkey minibuffer-local-map [(meta shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) (org-defkey minibuffer-local-map [(meta shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) (org-defkey minibuffer-local-map [(meta shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) (org-defkey minibuffer-local-map [(meta shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) + (org-defkey minibuffer-local-map [?\e (shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) + (org-defkey minibuffer-local-map [?\e (shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) + (org-defkey minibuffer-local-map [?\e (shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + (org-defkey minibuffer-local-map [?\e (shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) (org-defkey minibuffer-local-map [(shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-week 1)))) + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-week 1)))) (org-defkey minibuffer-local-map [(shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-week 1)))) + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-week 1)))) (org-defkey minibuffer-local-map [(shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-day 1)))) + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-day 1)))) (org-defkey minibuffer-local-map [(shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-day 1)))) + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-day 1)))) (org-defkey minibuffer-local-map ">" - (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-left 1)))) + (lambda () (interactive) + (org-eval-in-calendar '(scroll-calendar-left 1)))) (org-defkey minibuffer-local-map "<" - (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-right 1)))) + (lambda () (interactive) + (org-eval-in-calendar '(scroll-calendar-right 1)))) + (run-hooks 'org-read-date-minibuffer-setup-hook) (unwind-protect (progn (use-local-map map) (add-hook 'post-command-hook 'org-read-date-display) - (setq org-ans0 (read-string prompt default-input nil nil)) + (setq org-ans0 (read-string prompt default-input + 'org-read-date-history nil)) ;; org-ans0: from prompt ;; org-ans1: from mouse click ;; org-ans2: from calendar motion @@ -11264,12 +12359,14 @@ user." (t ; Naked prompt only (unwind-protect - (setq ans (read-string prompt default-input nil timestr)) + (setq ans (read-string prompt default-input + 'org-read-date-history timestr)) (when org-read-date-overlay (org-delete-overlay org-read-date-overlay) (setq org-read-date-overlay nil))))) (setq final (org-read-date-analyze ans def defdecode)) + (setq org-read-date-final-answer ans) (if to-time (apply 'encode-time final) @@ -11278,6 +12375,7 @@ user." (nth 5 final) (nth 4 final) (nth 3 final) (nth 2 final) (nth 1 final)) (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) + (defvar def) (defvar defdecode) (defvar with-time) @@ -11487,15 +12585,17 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to (defun org-eval-in-calendar (form &optional keepdate) "Eval FORM in the calendar window and return to current window. Also, store the cursor date in variable org-ans2." - (let ((sw (selected-window))) - (select-window (get-buffer-window "*Calendar*")) + (let ((sf (selected-frame)) + (sw (selected-window))) + (select-window (get-buffer-window "*Calendar*" t)) (eval form) (when (and (not keepdate) (calendar-cursor-to-date)) (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)) - (select-window sw))) + (select-window sw) + (select-frame-set-input-focus sf))) (defun org-calendar-select () "Return to `org-read-date' with the date currently selected. @@ -11633,7 +12733,7 @@ Don't touch the rest." ((<= org-deadline-warning-days 0) ;; 0 or negative, enforce this value no matter what (- org-deadline-warning-days)) - ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\)" ts) + ((string-match "-\\([0-9]+\\)\\([dwmy]\\)\\(\\'\\|>\\| \\)" ts) ;; lead time is specified. (floor (* (string-to-number (match-string 1 ts)) (cdr (assoc (match-string 2 ts) @@ -11688,6 +12788,21 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s (message "%d entries before %s" (org-occur regexp nil callback) date))) +(defun org-check-after-date (date) + "Check if there are deadlines or scheduled entries after DATE." + (interactive (list (org-read-date))) + (let ((case-fold-search nil) + (regexp (concat "\\<\\(" org-deadline-string + "\\|" org-scheduled-string + "\\) *<\\([^>]+\\)>")) + (callback + (lambda () (not + (time-less-p + (org-time-string-to-time (match-string 2)) + (org-time-string-to-time date)))))) + (message "%d entries after %s" + (org-occur regexp nil callback) date))) + (defun org-evaluate-time-range (&optional to-buffer) "Evaluate a time range by computing the difference between start and end. Normally the result is just printed in the echo area, but with prefix arg @@ -11767,12 +12882,15 @@ days in order to avoid rounding problems." (defun org-time-string-to-time (s) (apply 'encode-time (org-parse-time-string s))) +(defun org-time-string-to-seconds (s) + (time-to-seconds (org-time-string-to-time s))) (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 DAYNR. -PREFER and SHOW-ALL are passed through to `org-closest-date'." +PREFER and SHOW-ALL are passed through to `org-closest-date'. +the variable date is bound by the calendar when this is called." (cond ((and daynr (string-match "\\`%%\\((.*)\\)" s)) (if (org-diary-sexp-entry (match-string 1 s) "" date) @@ -12077,6 +13195,13 @@ in the timestamp determines what will be changed." (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) (nthcdr 6 time0))) + (when (and (member org-ts-what '(hour minute)) + extra + (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra)) + (setq extra (org-modify-ts-extra + extra + (if (eq org-ts-what 'hour) 2 5) + n dm))) (when (integerp org-ts-what) (setq extra (org-modify-ts-extra extra org-ts-what n dm))) (if (eq what 'calendar) @@ -12192,11 +13317,56 @@ If there is already a time stamp at the cursor position, update it." (format org-time-clocksum-format h m))) (defun org-hh:mm-string-to-minutes (s) - "Convert a string H:MM to a number of minutes." - (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s) - (+ (* (string-to-number (match-string 1 s)) 60) - (string-to-number (match-string 2 s))) - 0)) + "Convert a string H:MM to a number of minutes. +If the string is just a number, interprete it as minutes. +In fact, the first hh:mm or number in the string will be taken, +there can be extra stuff in the string. +If no number is found, the return value is 0." + (cond + ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s) + (+ (* (string-to-number (match-string 1 s)) 60) + (string-to-number (match-string 2 s)))) + ((string-match "\\([0-9]+\\)" s) + (string-to-number (match-string 1 s))) + (t 0))) + +;;;; Files + +(defun org-save-all-org-buffers () + "Save all Org-mode buffers without user confirmation." + (interactive) + (message "Saving all Org-mode buffers...") + (save-some-buffers t 'org-mode-p) + (when (featurep 'org-id) (org-id-locations-save)) + (message "Saving all Org-mode buffers... done")) + +(defun org-revert-all-org-buffers () + "Revert all Org-mode buffers. +Prompt for confirmation when there are unsaved changes. +Be sure you know what you are doing before letting this function +overwrite your changes. + +This function is useful in a setup where one tracks org files +with a version control system, to revert on one machine after pulling +changes from another. I believe the procedure must be like this: + +1. M-x org-save-all-org-buffers +2. Pull changes from the other machine, resolve conflicts +3. M-x org-revert-all-org-buffers" + (interactive) + (unless (yes-or-no-p "Revert all Org buffers from their files? ") + (error "Abort")) + (save-excursion + (save-window-excursion + (mapc + (lambda (b) + (when (and (with-current-buffer b (org-mode-p)) + (with-current-buffer b buffer-file-name)) + (switch-to-buffer b) + (revert-buffer t 'no-confirm))) + (buffer-list)) + (when (and (featurep 'org-id) org-id-track-globally) + (org-id-locations-load))))) ;;;; Agenda files @@ -12236,7 +13406,7 @@ With two prefix arguments, restrict available buffers to agenda files." (t (org-buffer-list))))) (switch-to-buffer (org-ido-completing-read "Org buffer: " - (mapcar 'buffer-name blist) + (mapcar 'list (mapcar 'buffer-name blist)) nil t)))) (defun org-buffer-list (&optional predicate exclude-tmp) @@ -12468,35 +13638,36 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (save-excursion (save-restriction (while (setq file (pop files)) - (if (bufferp file) - (set-buffer file) - (org-check-agenda-file file) - (set-buffer (org-get-agenda-file-buffer file))) - (widen) - (setq bmp (buffer-modified-p)) - (org-refresh-category-properties) - (setq org-todo-keywords-for-agenda - (append org-todo-keywords-for-agenda org-todo-keywords-1)) - (setq org-done-keywords-for-agenda - (append org-done-keywords-for-agenda org-done-keywords)) - (setq org-todo-keyword-alist-for-agenda - (append org-todo-keyword-alist-for-agenda org-todo-key-alist)) - (setq org-tag-alist-for-agenda - (append org-tag-alist-for-agenda org-tag-alist)) + (catch 'nextfile + (if (bufferp file) + (set-buffer file) + (org-check-agenda-file file) + (set-buffer (org-get-agenda-file-buffer file))) + (widen) + (setq bmp (buffer-modified-p)) + (org-refresh-category-properties) + (setq org-todo-keywords-for-agenda + (append org-todo-keywords-for-agenda org-todo-keywords-1)) + (setq org-done-keywords-for-agenda + (append org-done-keywords-for-agenda org-done-keywords)) + (setq org-todo-keyword-alist-for-agenda + (append org-todo-keyword-alist-for-agenda org-todo-key-alist)) + (setq org-tag-alist-for-agenda + (append org-tag-alist-for-agenda org-tag-alist)) - (save-excursion - (remove-text-properties (point-min) (point-max) pall) - (when org-agenda-skip-archived-trees + (save-excursion + (remove-text-properties (point-min) (point-max) pall) + (when org-agenda-skip-archived-trees + (goto-char (point-min)) + (while (re-search-forward rea nil t) + (if (org-on-heading-p t) + (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) (goto-char (point-min)) - (while (re-search-forward rea nil t) - (if (org-on-heading-p t) - (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) - (goto-char (point-min)) - (setq re (concat "^\\*+ +" org-comment-string "\\>")) - (while (re-search-forward re nil t) - (add-text-properties - (match-beginning 0) (org-end-of-subtree t) pc))) - (set-buffer-modified-p bmp)))) + (setq re (concat "^\\*+ +" org-comment-string "\\>")) + (while (re-search-forward re nil t) + (add-text-properties + (match-beginning 0) (org-end-of-subtree t) pc))) + (set-buffer-modified-p bmp))))) (setq org-todo-keyword-alist-for-agenda (org-uniquify org-todo-keyword-alist-for-agenda) org-tag-alist-for-agenda (org-uniquify org-tag-alist-for-agenda)))) @@ -12699,6 +13870,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (matchers (plist-get opt :matchers)) (re-list org-latex-regexps) (cnt 0) txt link beg end re e checkdir + executables-checked m n block linkfile movefile ov) ;; Check if there are old images files with this prefix, and remove them (when (file-directory-p todir) @@ -12727,6 +13899,14 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (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)) + (org-create-formula-image txt movefile opt forbuffer) (if overlays @@ -12781,7 +13961,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (progn (message "Failed to create dvi file from %s" texfile) nil) (condition-case nil (call-process "dvipng" nil nil nil - "-E" "-fg" fg "-bg" bg + "-fg" fg "-bg" bg "-D" dpi ;;"-x" scale "-y" scale "-T" "tight" @@ -12875,7 +14055,13 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft) (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) - (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft)) + (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft) + (org-defkey org-mode-map [?\e (tab)] 'org-complete) + (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading) + (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft) + (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright) + (org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup) + (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown)) ;; All the other keys @@ -12884,6 +14070,8 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (if (boundp 'narrow-map) (org-defkey narrow-map "s" 'org-narrow-to-subtree) (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree)) +(org-defkey org-mode-map "\C-c\C-f" 'org-forward-same-level) +(org-defkey org-mode-map "\C-c\C-b" 'org-backward-same-level) (org-defkey org-mode-map "\C-c$" 'org-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) (org-defkey org-mode-map "\C-c\C-x\C-a" 'org-toggle-archive-tag) @@ -12899,9 +14087,10 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (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-tags-sparse-tree) ; Minor-mode res. +(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res. (org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) (org-defkey org-mode-map "\M-\C-m" 'org-insert-heading) +(org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift) (org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content) (org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content) (org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) @@ -12946,7 +14135,9 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (org-defkey org-mode-map "\C-c\C-e" 'org-export) (org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) (org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) -(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action) +(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action) +(org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree) +;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree) (org-defkey org-mode-map "\C-c\C-x\C-k" 'org-mark-entry-for-agenda-action) (org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special) @@ -12966,6 +14157,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) (org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) +(org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) (org-defkey org-mode-map "\C-c\C-x." 'org-timer) (org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item) @@ -12974,29 +14166,41 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]." (define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) +(define-key org-mode-map "\C-c\C-x!" 'org-reload) + +(define-key org-mode-map "\C-c\C-xg" 'org-feed-update-all) +(define-key org-mode-map "\C-c\C-xG" 'org-feed-goto-inbox) + +(define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation) + + (when (featurep 'xemacs) (org-defkey org-mode-map 'button3 'popup-mode-menu)) + +(defvar org-self-insert-command-undo-counter 0) + (defvar org-table-auto-blank-field) ; defined in org-table.el (defun org-self-insert-command (N) "Like `self-insert-command', use overwrite-mode for whitespace in tables. If the cursor is in a table looking at whitespace, the whitespace is overwritten, and the table is not marked as requiring realignment." (interactive "p") - (if (and (org-table-p) - (progn - ;; check if we blank the field, and if that triggers align - (and (featurep 'org-table) org-table-auto-blank-field - (member last-command - '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c)) - (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) - ;; got extra space, this field does not determine column width - (let (org-table-may-need-update) (org-table-blank-field)) - ;; no extra space, this field may determine column width - (org-table-blank-field))) - t) - (eq N 1) - (looking-at "[^|\n]* |")) + (if (and + (org-table-p) + (progn + ;; check if we blank the field, and if that triggers align + (and (featurep 'org-table) org-table-auto-blank-field + (member last-command + '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c yas/expand)) + (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) + ;; got extra space, this field does not determine column width + (let (org-table-may-need-update) (org-table-blank-field)) + ;; no extra space, this field may determine column width + (org-table-blank-field))) + t) + (eq N 1) + (looking-at "[^|\n]* |")) (let (org-table-may-need-update) (goto-char (1- (match-end 0))) (delete-backward-char 1) @@ -13004,7 +14208,18 @@ overwritten, and the table is not marked as requiring realignment." (self-insert-command N)) (setq org-table-may-need-update t) (self-insert-command N) - (org-fix-tags-on-the-fly))) + (org-fix-tags-on-the-fly) + (if org-self-insert-cluster-for-undo + (if (not (eq last-command 'org-self-insert-command)) + (setq org-self-insert-command-undo-counter 1) + (if (>= org-self-insert-command-undo-counter 20) + (setq org-self-insert-command-undo-counter 1) + (and (> org-self-insert-command-undo-counter 0) + buffer-undo-list + (not (cadr buffer-undo-list)) ; remove nil entry + (setcdr buffer-undo-list (cddr buffer-undo-list))) + (setq org-self-insert-command-undo-counter + (1+ org-self-insert-command-undo-counter))))))) (defun org-fix-tags-on-the-fly () (when (and (equal (char-after (point-at-bol)) ?*) @@ -13100,6 +14315,68 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." 'delete-backward-char 'org-delete-backward-char) (org-defkey org-mode-map "|" 'org-force-self-insert)) +(defvar org-ctrl-c-ctrl-c-hook nil + "Hook for functions attaching themselves to `C-c C-c'. +This can be used to add additional functionality to the C-c C-c key which +executes context-dependent commands. +Each function will be called with no arguments. The function must check +if the context is appropriate for it to act. If yes, it should do its +thing and then return a non-nil value. If the context is wrong, +just do nothing and return nil.") + +(defvar org-tab-first-hook nil + "Hook for functions to attach themselves to TAB. +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.") + +(defvar org-tab-after-check-for-table-hook nil + "Hook for functions to attach themselves to TAB. +See `org-ctrl-c-ctrl-c-hook' for more information. +This hook runs after it has been established that the cursor is not in a +table, but before checking if the cursor is in a headline or if global cycling +should be done. +If any function in this hook returns t, not other actions like visibility +cycling will be done.") + +(defvar org-tab-after-check-for-cycling-hook nil + "Hook for functions to attach themselves to TAB. +See `org-ctrl-c-ctrl-c-hook' for more information. +This hook runs after it has been established that not table field motion and +not visibility should be done because of current context. This is probably +the place where a package like yasnippets can hook in.") + +(defvar org-metaleft-hook nil + "Hook for functions attaching themselves to `M-left'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-metaright-hook nil + "Hook for functions attaching themselves to `M-right'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-metaup-hook nil + "Hook for functions attaching themselves to `M-up'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-metadown-hook nil + "Hook for functions attaching themselves to `M-down'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftmetaleft-hook nil + "Hook for functions attaching themselves to `M-S-left'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftmetaright-hook nil + "Hook for functions attaching themselves to `M-S-right'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftmetaup-hook nil + "Hook for functions attaching themselves to `M-S-up'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftmetadown-hook nil + "Hook for functions attaching themselves to `M-S-down'. +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.") + (defun org-modifier-cursor-error () "Throw an error, a modified cursor command was applied in wrong context." (error "This command is active in special context like tables, headlines or items")) @@ -13135,6 +14412,7 @@ or `org-table-delete-column', depending on context. See the individual commands for more information." (interactive) (cond + ((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)) @@ -13147,6 +14425,7 @@ or `org-table-insert-column', depending on context. See the individual commands for more information." (interactive) (cond + ((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)) @@ -13159,10 +14438,12 @@ Calls `org-move-subtree-up' or `org-table-kill-row' or for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftmetaup-hook)) ((org-at-table-p) (call-interactively 'org-table-kill-row)) ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) ((org-at-item-p) (call-interactively 'org-move-item-up)) (t (org-modifier-cursor-error)))) + (defun org-shiftmetadown (&optional arg) "Move subtree down or insert table row. Calls `org-move-subtree-down' or `org-table-insert-row' or @@ -13170,6 +14451,7 @@ Calls `org-move-subtree-down' or `org-table-insert-row' or commands for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-shiftmetadown-hook)) ((org-at-table-p) (call-interactively 'org-table-insert-row)) ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) ((org-at-item-p) (call-interactively 'org-move-item-down)) @@ -13182,10 +14464,20 @@ With no specific context, calls the Emacs default `backward-word'. See the individual commands for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-metaleft-hook)) ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) - ((or (org-on-heading-p) (org-region-active-p)) + ((or (org-on-heading-p) + (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (org-on-heading-p)))) (call-interactively 'org-do-promote)) - ((org-at-item-p) (call-interactively 'org-outdent-item)) + ((or (org-at-item-p) + (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (org-at-item-p)))) + (call-interactively 'org-outdent-item)) (t (call-interactively 'backward-word)))) (defun org-metaright (&optional arg) @@ -13195,10 +14487,20 @@ With no specific context, calls the Emacs default `forward-word'. See the individual commands for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-metaright-hook)) ((org-at-table-p) (call-interactively 'org-table-move-column)) - ((or (org-on-heading-p) (org-region-active-p)) + ((or (org-on-heading-p) + (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (org-on-heading-p)))) (call-interactively 'org-do-demote)) - ((org-at-item-p) (call-interactively 'org-indent-item)) + ((or (org-at-item-p) + (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (org-at-item-p)))) + (call-interactively 'org-indent-item)) (t (call-interactively 'forward-word)))) (defun org-metaup (&optional arg) @@ -13208,6 +14510,7 @@ Calls `org-move-subtree-up' or `org-table-move-row' or for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-metaup-hook)) ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) ((org-on-heading-p) (call-interactively 'org-move-subtree-up)) ((org-at-item-p) (call-interactively 'org-move-item-up)) @@ -13220,6 +14523,7 @@ Calls `org-move-subtree-down' or `org-table-move-row' or commands for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-metadown-hook)) ((org-at-table-p) (call-interactively 'org-table-move-row)) ((org-on-heading-p) (call-interactively 'org-move-subtree-down)) ((org-at-item-p) (call-interactively 'org-move-item-down)) @@ -13237,6 +14541,7 @@ depending on context. See the individual commands for more information." (call-interactively (if org-edit-timestamp-down-means-later 'org-timestamp-down 'org-timestamp-up))) ((and (not (eq org-support-shift-select 'always)) + org-enable-priority-commands (org-on-heading-p)) (call-interactively 'org-priority-up)) ((and (not org-support-shift-select) (org-at-item-p)) @@ -13258,12 +14563,13 @@ depending on context. See the individual commands for more information." (call-interactively (if org-edit-timestamp-down-means-later 'org-timestamp-up 'org-timestamp-down))) ((and (not (eq org-support-shift-select 'always)) + org-enable-priority-commands (org-on-heading-p)) (call-interactively 'org-priority-down)) ((and (not org-support-shift-select) (org-at-item-p)) (call-interactively 'org-next-item)) ((org-clocktable-try-shift 'down arg)) - (org-support-shift-select + (org-support-shift-select (org-call-for-shift-select 'next-line)) (t (org-shiftselect-error)))) @@ -13283,7 +14589,11 @@ Depending on context, this does one of the following: ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) ((and (not (eq org-support-shift-select 'always)) (org-on-heading-p)) - (org-call-with-arg 'org-todo 'right)) + (let ((org-inhibit-logging + (not org-treat-S-cursor-todo-selection-as-state-change)) + (org-inhibit-blocking + (not org-treat-S-cursor-todo-selection-as-state-change))) + (org-call-with-arg 'org-todo 'right))) ((or (and org-support-shift-select (not (eq org-support-shift-select 'always)) (org-at-item-bullet-p)) @@ -13293,7 +14603,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)) - (org-support-shift-select + (org-support-shift-select (org-call-for-shift-select 'forward-char)) (t (org-shiftselect-error)))) @@ -13313,7 +14623,11 @@ Depending on context, this does one of the following: ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) ((and (not (eq org-support-shift-select 'always)) (org-on-heading-p)) - (org-call-with-arg 'org-todo 'left)) + (let ((org-inhibit-logging + (not org-treat-S-cursor-todo-selection-as-state-change)) + (org-inhibit-blocking + (not org-treat-S-cursor-todo-selection-as-state-change))) + (org-call-with-arg 'org-todo 'left))) ((or (and org-support-shift-select (not (eq org-support-shift-select 'always)) (org-at-item-bullet-p)) @@ -13323,7 +14637,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)) - (org-support-shift-select + (org-support-shift-select (org-call-for-shift-select 'backward-char)) (t (org-shiftselect-error)))) @@ -13403,11 +14717,15 @@ When in an #+include line, visit the include file. Otherwise call ((org-edit-fixed-width-region)) (t (call-interactively 'ffap)))) + (defun org-ctrl-c-ctrl-c (&optional arg) "Set tags in headline, or update according to changed information at point. This command does many different things, depending on context: +- If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location, + this is what we do. + - If the cursor is in a headline, prompt for tags and insert them into the current line, aligned to `org-tags-column'. When called with prefix arg, realign all tags in the current buffer. @@ -13455,6 +14773,7 @@ This command does many different things, depending on context: ((and (local-variable-p 'org-finish-function (current-buffer)) (fboundp org-finish-function)) (funcall org-finish-function)) + ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) ((org-at-property-p) (call-interactively 'org-property-action)) ((org-on-target-p) (call-interactively 'org-update-radio-target-regexp)) @@ -13476,12 +14795,16 @@ This command does many different things, depending on context: ((org-at-item-checkbox-p) (call-interactively 'org-toggle-checkbox)) ((org-at-item-p) - (call-interactively 'org-maybe-renumber-ordered-list)) + (if arg + (call-interactively 'org-toggle-checkbox) + (call-interactively 'org-maybe-renumber-ordered-list))) ((save-excursion (beginning-of-line 1) (looking-at "#\\+BEGIN:")) ;; Dynamic block (beginning-of-line 1) (save-excursion (org-update-dblock))) - ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) + ((save-excursion + (beginning-of-line 1) + (looking-at "[ \t]*#\\+\\([A-Z]+\\)")) (cond ((equal (match-string 1) "TBLFM") ;; Recalculate the table before this line @@ -13495,6 +14818,7 @@ This command does many different things, depending on context: ; (org-restart-font-lock) (let ((org-inhibit-startup t)) (org-mode-restart)) (message "Local setup has been refreshed")))) + ((org-clock-update-time-maybe)) (t (error "C-c C-c can do nothing useful at this location."))))) (defun org-mode-restart () @@ -13519,15 +14843,18 @@ See the individual commands for more information." (interactive) (cond ((bobp) (if indent (newline-and-indent) (newline))) + ((org-at-table-p) + (org-table-justify-field-maybe) + (call-interactively 'org-table-next-row)) + ((and org-return-follows-link + (eq (get-text-property (point) 'face) 'org-link)) + (call-interactively 'org-open-at-point)) ((and (org-at-heading-p) (looking-at (org-re "\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$"))) (org-show-entry) (end-of-line 1) (newline)) - ((org-at-table-p) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-row)) (t (if indent (newline-and-indent) (newline))))) (defun org-return-indent () @@ -13614,15 +14941,16 @@ If there is no active region, only the current line is considered. If the first line is a heading, remove the stars from all headlines in the region. -If the first line is a plain list item, turn all plain list items into -headings. +If the first line is a plain list item, turn all plain list items +into headings. -If the first line is a normal line, turn each and every line in the region -into a heading. +If the first line is a normal line, turn each and every line in the +region into a heading. When converting a line into a heading, the number of stars is chosen -such that the lines become children of the current entry. However, when -a prefix argument is given, its value determines the number of stars to add." +such that the lines become children of the current entry. However, +when a prefix argument is given, its value determines the number of +stars to add." (interactive "P") (let (l2 l itemp beg end) (if (org-region-active-p) @@ -13647,9 +14975,12 @@ a prefix argument is given, its value determines the number of stars to add." (make-string (prefix-numeric-value current-prefix-arg) ?*) (save-excursion - (re-search-backward org-complex-heading-regexp nil t) - (or (match-string 1) "*")))) - (add-stars (if nstars "" (if org-odd-levels-only "**" "*"))) + (if (re-search-backward org-complex-heading-regexp nil t) + (match-string 1) "")))) + (add-stars (cond (nstars "") + ((equal stars "") "*") + (org-odd-levels-only "**") + (t "*"))) (rpl (concat stars add-stars " "))) (while (< (setq l (1+ l)) l2) (if itemp @@ -13665,6 +14996,7 @@ Calls `org-insert-heading' or `org-table-wrap-region', depending on context. See the individual commands for more information." (interactive "P") (cond + ((run-hook-with-args-until-success 'org-metareturn-hook)) ((org-at-table-p) (call-interactively 'org-table-wrap-region)) (t (call-interactively 'org-insert-heading)))) @@ -13760,6 +15092,8 @@ See the individual commands for more information." ["Cut Subtree" org-cut-special (not (org-at-table-p))] ["Paste Subtree" org-paste-special (not (org-at-table-p))] "--" + ["Clone subtree, shift time" org-clone-subtree-with-time-shift t] + "--" ["Promote Heading" org-metaleft (not (org-at-table-p))] ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] ["Demote Heading" org-metaright (not (org-at-table-p))] @@ -13793,6 +15127,25 @@ See the individual commands for more information." ; :active t :keys "C-u C-c C-x C-s"] ) "--" + ("Hyperlinks" + ["Store Link (Global)" org-store-link t] + ["Find existing link to here" org-occur-link-in-agenda-files t] + ["Insert Link" org-insert-link t] + ["Follow Link" org-open-at-point t] + "--" + ["Next link" org-next-link t] + ["Previous link" org-previous-link t] + "--" + ["Descriptive Links" + (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) + :style radio + :selected (member '(org-link) buffer-invisibility-spec)] + ["Literal Links" + (progn + (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock)) + :style radio + :selected (not (member '(org-link) buffer-invisibility-spec))]) + "--" ("TODO Lists" ["TODO/DONE/-" org-todo t] ("Select keyword" @@ -13816,7 +15169,11 @@ See the individual commands for more information." "--" ["Set Priority" org-priority t] ["Priority Up" org-shiftup t] - ["Priority Down" org-shiftdown t]) + ["Priority Down" org-shiftdown t] + "--" + ["Get news from all feeds" org-feed-update-all t] + ["Go to the inbox of a feed..." org-feed-goto-inbox t] + ["Customize feeds" (customize-variable 'org-feed-alist) t]) ("TAGS and Properties" ["Set Tags" org-set-tags-command t] ["Change tag in region" org-change-tag-in-region (org-region-active-p)] @@ -13848,10 +15205,15 @@ See the individual commands for more information." ["Insert Timer String" org-timer t] ["Insert Timer Item" org-timer-item t]) ("Logging work" - ["Clock in" org-clock-in t] + ["Clock in" org-clock-in :active t :keys "C-c C-x C-i"] + ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"] ["Clock out" org-clock-out t] ["Clock cancel" org-clock-cancel t] + "--" + ["Mark as default task" org-clock-mark-default-task t] + ["Clock in, mark as default" (lambda () (interactive) (org-clock-in '(16))) :active t :keys "C-u C-u C-c C-x C-i"] ["Goto running clock" org-clock-goto t] + "--" ["Display times" org-clock-display t] ["Create clock table" org-clock-report t] "--" @@ -13869,25 +15231,7 @@ See the individual commands for more information." ["TODO Tree" org-show-todo-tree t] ["Check Deadlines" org-check-deadlines t] ["Timeline" org-timeline t] - ["Tags Tree" org-tags-sparse-tree t]) - "--" - ("Hyperlinks" - ["Store Link (Global)" org-store-link t] - ["Insert Link" org-insert-link t] - ["Follow Link" org-open-at-point t] - "--" - ["Next link" org-next-link t] - ["Previous link" org-previous-link t] - "--" - ["Descriptive Links" - (progn (org-add-to-invisibility-spec '(org-link)) (org-restart-font-lock)) - :style radio - :selected (member '(org-link) buffer-invisibility-spec)] - ["Literal Links" - (progn - (org-remove-from-invisibility-spec '(org-link)) (org-restart-font-lock)) - :style radio - :selected (not (member '(org-link) buffer-invisibility-spec))]) + ["Tags/Property tree" org-match-sparse-tree t]) "--" ["Export/Publish..." org-export t] ("LaTeX" @@ -13897,6 +15241,8 @@ See the individual commands for more information." ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] ["Modify math symbol" org-cdlatex-math-modify (org-inside-LaTeX-fragment-p)] + ["Insert citation" org-reftex-citation t] + "--" ["Export LaTeX fragments as images" (if (featurep 'org-exp) (setq org-export-with-LaTeX-fragments @@ -13914,7 +15260,10 @@ See the individual commands for more information." ["Expand This Menu" org-create-customize-menu (fboundp 'customize-menu-create)]) "--" - ["Refresh setup" org-mode-restart t] + ("Refresh/Reload" + ["Refresh setup current buffer" org-mode-restart t] + ["Reload Org (after update)" org-reload t] + ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x r"]) )) (defun org-info (&optional node) @@ -13948,9 +15297,44 @@ With optional NODE, go directly to that node." (defun org-require-autoloaded-modules () (interactive) (mapc 'require - '(org-agenda org-archive org-attach org-clock org-colview - org-exp org-id org-export-latex org-publish - org-remember org-table org-timer))) + '(org-agenda org-archive org-ascii org-attach org-clock org-colview + org-docbook org-exp org-html org-icalendar + org-id org-latex + org-publish org-remember org-table + org-timer org-xoxo))) + +;;;###autoload +(defun org-reload (&optional uncompiled) + "Reload all org lisp files. +With prefix arg UNCOMPILED, load the uncompiled versions." + (interactive "P") + (require 'find-func) + (let* ((file-re "^\\(org\\|orgtbl\\)\\(\\.el\\|-.*\\.el\\)") + (dir-org (file-name-directory (org-find-library-name "org"))) + (dir-org-contrib (ignore-errors + (file-name-directory + (org-find-library-name "org-contribdir")))) + (files + (append (directory-files dir-org t file-re) + (and dir-org-contrib + (directory-files dir-org-contrib t file-re)))) + (remove-re (concat (if (featurep 'xemacs) + "org-colview" "org-colview-xemacs") + "\\'"))) + (setq files (mapcar 'file-name-sans-extension files)) + (setq files (mapcar + (lambda (x) (if (string-match remove-re x) nil x)) + files)) + (setq files (delq nil files)) + (mapc + (lambda (f) + (when (featurep (intern (file-name-nondirectory f))) + (if (and (not uncompiled) + (file-exists-p (concat f ".elc"))) + (load (concat f ".elc") nil nil t) + (load (concat f ".el") nil nil t)))) + files)) + (org-version)) ;;;###autoload (defun org-customize () @@ -14099,6 +15483,31 @@ leave it alone. If it is larger than ind, set it to the target." (concat (make-string i1 ?\ ) l) l))) +(defun org-remove-indentation (code &optional n) + "Remove the maximum common indentation from the lines in CODE. +N may optionally be the number of spaces to remove." + (with-temp-buffer + (insert code) + (org-do-remove-indentation n) + (buffer-string))) + +(defun org-do-remove-indentation (&optional n) + "Remove the maximum common indentation from the buffer." + (untabify (point-min) (point-max)) + (let ((min 10000) re) + (if n + (setq min n) + (goto-char (point-min)) + (while (re-search-forward "^ *[^ \n]" nil t) + (setq min (min min (1- (- (match-end 0) (match-beginning 0))))))) + (unless (or (= min 0) (= min 10000)) + (setq re (format "^ \\{%d\\}" min)) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (replace-match "") + (end-of-line 1)) + min))) + (defun org-base-buffer (buffer) "Return the base buffer of BUFFER, if it has one. Else return the buffer." (if (not buffer) @@ -14175,6 +15584,16 @@ and end of string." list))) (nreverse list))) +(defun org-quote-vert (s) + "Replace \"|\" with \"\\vert\"." + (while (string-match "|" s) + (setq s (replace-match "\\vert" t t s))) + s) + +(defun org-uuidgen-p (s) + "Is S an ID created by UUIDGEN?" + (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s))) + (defun org-context () "Return a list of contexts of the current cursor position. If several contexts apply, all are returned. @@ -14343,6 +15762,16 @@ really on, so that the block visually is on the match." (goto-char pos) (org-reveal))))))) +(defun org-occur-link-in-agenda-files () + "Create a link and search for it in the agendas. +The link is not stored in `org-stored-links', it is just created +for the search purpose." + (interactive) + (let ((link (condition-case nil + (org-store-link nil) + (error "Unable to create a link to here")))) + (org-occur-in-agenda-files (regexp-quote link)))) + (defun org-uniquify (list) "Remove duplicate elements from LIST." (let (res) @@ -14454,9 +15883,10 @@ Counting starts at 1." (nreverse rtn))) (defun org-find-base-buffer-visiting (file) - "Like `find-buffer-visiting' but alway return the base buffer and + "Like `find-buffer-visiting' but always return the base buffer and not an indirect buffer." - (let ((buf (find-buffer-visiting file))) + (let ((buf (or (get-file-buffer file) + (find-buffer-visiting file)))) (if buf (or (buffer-base-buffer buf) buf) nil))) @@ -14521,15 +15951,29 @@ which make use of the date at the cursor." (interactive) (let* ((pos (point)) (itemp (org-at-item-p)) + (case-fold-search t) + (org-drawer-regexp (or org-drawer-regexp "\000")) column bpos bcol tpos tcol bullet btype bullet-type) ;; Find the previous relevant line (beginning-of-line 1) (cond ((looking-at "#") (setq column 0)) ((looking-at "\\*+ ") (setq column 0)) + ((and (looking-at "[ \t]*:END:") + (save-excursion (re-search-backward org-drawer-regexp nil t))) + (save-excursion + (goto-char (1- (match-beginning 1))) + (setq column (current-column)))) + ((and (looking-at "[ \t]+#\\+end_\\([a-z]+\\)") + (save-excursion + (re-search-backward + (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) + (setq column (org-get-indentation (match-string 0)))) (t (beginning-of-line 0) - (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]")) + (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]") + (not (looking-at "[ \t]*:END:")) + (not (looking-at org-drawer-regexp))) (beginning-of-line 0)) (cond ((looking-at "\\*+[ \t]+") @@ -14537,6 +15981,12 @@ which make use of the date at the cursor." (setq column 0) (goto-char (match-end 0)) (setq column (current-column)))) + ((looking-at org-drawer-regexp) + (goto-char (1- (match-beginning 1))) + (setq column (current-column))) + ((looking-at "\\([ \t]*\\):END:") + (goto-char (match-end 1)) + (setq column (current-column))) ((org-in-item-p) (org-beginning-of-item) (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?") @@ -14580,8 +16030,16 @@ which make use of the date at the cursor." (org-set-local 'comment-start-skip "^#+[ \t]*") (org-set-local 'paragraph-separate "\f\\|\\*+ \\|[ ]*$\\|[ \t]*[:|]") ;; The paragraph starter includes hand-formatted lists. - (org-set-local 'paragraph-start - "\f\\|[ ]*$\\|\\*+ \\|\f\\|[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") + (org-set-local + 'paragraph-start + (concat + "\f" "\\|" + "[ ]*$" "\\|" + "\\*+ " "\\|" + "[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)" "\\|" + "[ \t]*[:|]" "\\|" + "\\$\\$" "\\|" + "\\\\\\(begin\\|end\\|[][]\\)")) ;; Inhibit auto-fill for headers, tables and fixed-width lines. ;; But only if the user has not turned off tables or fixed-width regions (org-set-local @@ -14660,7 +16118,7 @@ this line is also exported in fixed-width font." (end (if regionp (region-end))) (nlines (or arg (if (and beg end) (count-lines beg end) 1))) (case-fold-search nil) - (re "[ \t]*\\(:\\)") + (re "[ \t]*\\(: \\)") off) (if regionp (save-excursion @@ -14674,11 +16132,11 @@ this line is also exported in fixed-width font." (cond (arg (org-move-to-column cc t) - (insert ":\n") + (insert ": \n") (forward-line -1)) ((and off (looking-at re)) (replace-match "" t t nil 1)) - ((not off) (org-move-to-column cc t) (insert ":"))) + ((not off) (org-move-to-column cc t) (insert ": "))) (forward-line 1))) (save-excursion (org-back-to-heading) @@ -14690,6 +16148,36 @@ this line is also exported in fixed-width font." (goto-char (match-end 0)) (insert org-quote-string " ")))))))) +(defun org-reftex-citation () + "Use reftex-citation to insert a citation into the buffer. +This looks for a line like + +#+BIBLIOGRAPHY: foo plain option:-d + +and derives from it that foo.bib is the bbliography file relevant +for this document. It then installs the necessary environment for RefTeX +to work in this buffer and calls `reftex-citation' to insert a citation +into the buffer. + +Export of such citations to both LaTeX and HTML is handled by the contributed +package org-exp-bibtex by Taru Karttunen." + (interactive) + (let ((reftex-docstruct-symbol 'rds) + (reftex-cite-format "\\cite{%l}") + rds bib) + (save-excursion + (save-restriction + (widen) + (let ((case-fold-search t) + (re "^#\\+bibliography:[ \t]+\\([^ \t\n]+\\)")) + (if (not (save-excursion + (or (re-search-forward re nil t) + (re-search-backward re nil t)))) + (error "No bibliography defined in file") + (setq bib (concat (match-string 1) ".bib") + rds (list (list 'bib bib))))))) + (call-interactively 'reftex-citation))) + ;;;; Functions extending outline functionality (defun org-beginning-of-line (&optional arg) @@ -14699,8 +16187,14 @@ If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the first attempt, and only move to after the tags when the cursor is already beyond the end of the headline." (interactive "P") - (let ((pos (point)) refpos) - (beginning-of-line 1) + (let ((pos (point)) + (special (if (consp org-special-ctrl-a/e) + (car org-special-ctrl-a/e) + org-special-ctrl-a/e)) + refpos) + (if (org-bound-and-true-p line-move-visual) + (beginning-of-visual-line 1) + (beginning-of-line 1)) (if (and arg (fboundp 'move-beginning-of-line)) (call-interactively 'move-beginning-of-line) (if (bobp) @@ -14711,14 +16205,14 @@ beyond the end of the headline." (backward-char 1) (beginning-of-line 1)) (forward-char 1)))) - (when org-special-ctrl-a/e + (when special (cond ((and (looking-at org-complex-heading-regexp) (= (char-after (match-end 1)) ?\ )) (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1))) (point-at-eol))) (goto-char - (if (eq org-special-ctrl-a/e t) + (if (eq special t) (cond ((> pos refpos) refpos) ((= pos (point)) refpos) (t (point))) @@ -14727,7 +16221,7 @@ beyond the end of the headline." (t refpos))))) ((org-at-item-p) (goto-char - (if (eq org-special-ctrl-a/e t) + (if (eq special t) (cond ((> pos (match-end 4)) (match-end 4)) ((= pos (point)) (match-end 4)) (t (point))) @@ -14743,32 +16237,57 @@ If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the first attempt, and only move to after the tags when the cursor is already beyond the end of the headline." (interactive "P") - (if (or (not org-special-ctrl-a/e) - (not (org-on-heading-p)) - arg) - (call-interactively (if (fboundp 'move-end-of-line) - 'move-end-of-line - 'end-of-line)) - (let ((pos (point))) - (beginning-of-line 1) - (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) - (if (eq org-special-ctrl-a/e t) - (if (or (< pos (match-beginning 1)) - (= pos (match-end 0))) - (goto-char (match-beginning 1)) - (goto-char (match-end 0))) - (if (or (< pos (match-end 0)) (not (eq this-command last-command))) - (goto-char (match-end 0)) - (goto-char (match-beginning 1)))) - (call-interactively (if (fboundp 'move-end-of-line) - 'move-end-of-line - 'end-of-line))))) - (org-no-warnings - (and (featurep 'xemacs) (setq zmacs-region-stays t)))) + (let ((special (if (consp org-special-ctrl-a/e) + (cdr org-special-ctrl-a/e) + org-special-ctrl-a/e))) + (if (or (not special) + (not (org-on-heading-p)) + arg) + (call-interactively + (cond ((org-bound-and-true-p line-move-visual) 'end-of-visual-line) + ((fboundp 'move-end-of-line) 'move-end-of-line) + (t 'end-of-line))) + (let ((pos (point))) + (beginning-of-line 1) + (if (looking-at (org-re ".*?\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) + (if (eq special t) + (if (or (< pos (match-beginning 1)) + (= pos (match-end 0))) + (goto-char (match-beginning 1)) + (goto-char (match-end 0))) + (if (or (< pos (match-end 0)) (not (eq this-command last-command))) + (goto-char (match-end 0)) + (goto-char (match-beginning 1)))) + (call-interactively (if (fboundp 'move-end-of-line) + 'move-end-of-line + 'end-of-line))))) + (org-no-warnings + (and (featurep 'xemacs) (setq zmacs-region-stays t))))) (define-key org-mode-map "\C-a" 'org-beginning-of-line) (define-key org-mode-map "\C-e" 'org-end-of-line) +(defun org-backward-sentence (&optional arg) + "Go to beginning of sentence, or beginning of table field. +This will call `backward-sentence' or `org-table-beginning-of-field', +depending on context." + (interactive "P") + (cond + ((org-at-table-p) (call-interactively 'org-table-beginning-of-field)) + (t (call-interactively 'backward-sentence)))) + +(defun org-forward-sentence (&optional arg) + "Go to end of sentence, or end of table field. +This will call `forward-sentence' or `org-table-end-of-field', +depending on context." + (interactive "P") + (cond + ((org-at-table-p) (call-interactively 'org-table-end-of-field)) + (t (call-interactively 'forward-sentence)))) + +(define-key org-mode-map "\M-a" 'org-backward-sentence) +(define-key org-mode-map "\M-e" 'org-forward-sentence) + (defun org-kill-line (&optional arg) "Kill line, to tags or end of line." (interactive "P") @@ -14806,12 +16325,24 @@ 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 plainly yank the text as it is. -\[1] Basically, the test checks if the first non-white line is a heading +\[1] The test checks if the first non-white line is a heading and if there are no other headings with fewer stars." (interactive "P") - (setq this-command 'yank) + (org-yank-generic 'yank arg)) + +(defun org-yank-generic (command arg) + "Perform some yank-like command. + +This function implements the behavior described in the `org-yank' +documentation. However, it has been generalized to work for any +interactive command with similar behavior." + + ;; pretend to be command COMMAND + (setq this-command command) + (if arg - (call-interactively 'yank) + (call-interactively command) + (let ((subtreep ; is kill a subtree, and the yank position appropriate? (and (org-kill-is-subtree-p) (or (bolp) @@ -14826,7 +16357,8 @@ plainly yank the text as it is. end) (if (and subtreep org-yank-adjusted-subtrees) (org-paste-subtree nil nil 'for-yank) - (call-interactively 'yank)) + (call-interactively command)) + (setq end (point)) (goto-char beg) (when (and (bolp) subtreep @@ -14842,7 +16374,8 @@ plainly yank the text as it is. (error (goto-char end))))) (when swallowp (message - "Yanked text not folded because that would swallow text")) + "Inserted text not folded because that would swallow text")) + (goto-char end) (skip-chars-forward " \t\n\r") (beginning-of-line 1) @@ -14852,7 +16385,7 @@ plainly yank the text as it is. (org-paste-subtree nil nil 'for-yank) (push-mark beg 'nomsg))) (t - (call-interactively 'yank)))))) + (call-interactively command)))))) (defun org-yank-folding-would-swallow-text (beg end) "Would hide-subtree at BEG swallow any text after END?" @@ -14920,7 +16453,11 @@ With argument, move up ARG levels." (defun org-up-heading-safe () "Move to the heading line of which the present line is a subheading. This version will not throw an error. It will return the level of the -headline found, or nil if no higher level is found." +headline found, or nil if no higher level is found. + +Also, this function will be a lot faster than `outline-up-heading', +because it relies on stars being the outline starters. This can really +make a significant difference in outlines with very many siblings." (let (start-level re) (org-back-to-heading t) (setq start-level (funcall outline-level)) @@ -14993,23 +16530,6 @@ When ENTRY is non-nil, show the entire entry." (save-excursion (outline-end-of-heading) (point)) flag)))) -(defun org-forward-same-level (arg) - "Move forward to the ARG'th subheading at same level as this one. -Stop at the first and last subheadings of a superior heading. -This is like outline-forward-same-level, but invisible headings are ok." - (interactive "p") - (org-back-to-heading t) - (while (> arg 0) - (let ((point-to-move-to (save-excursion - (org-get-next-sibling)))) - (if point-to-move-to - (progn - (goto-char point-to-move-to) - (setq arg (1- arg))) - (progn - (setq arg 0) - (error "No following same-level heading")))))) - (defun org-get-next-sibling () "Move to next heading of the same level, and return point. If there is no such heading, return nil. @@ -15023,27 +16543,85 @@ This is like outline-next-sibling, but invisible headings are ok." (point)))) (defun org-end-of-subtree (&optional invisible-OK to-heading) - ;; This is an exact copy of the original function, but it uses + ;; This contains an exact copy of the original function, but it uses ;; `org-back-to-heading', to make it work also in invisible ;; trees. And is uses an invisible-OK argument. ;; Under Emacs this is not needed, but the old outline.el needs this fix. + ;; Furthermore, when used inside Org, finding the end of a large subtree + ;; with many children and grandchildren etc, this can be much faster + ;; than the outline version. (org-back-to-heading invisible-OK) (let ((first t) (level (funcall outline-level))) - (while (and (not (eobp)) - (or first (> (funcall outline-level) level))) - (setq first nil) - (outline-next-heading)) + (if (and (org-mode-p) (< level 1000)) + ;; A true heading (not a plain list item), in Org-mode + ;; This means we can easily find the end by looking + ;; only for the right number of stars. Using a regexp to do + ;; this is so much faster than using a Lisp loop. + (let ((re (concat "^\\*\\{1," (int-to-string level) "\\} "))) + (forward-char 1) + (and (re-search-forward re nil 'move) (beginning-of-line 1))) + ;; something else, do it the slow way + (while (and (not (eobp)) + (or first (> (funcall outline-level) level))) + (setq first nil) + (outline-next-heading))) (unless to-heading (if (memq (preceding-char) '(?\n ?\^M)) - (progn - ;; Go to end of line before heading - (forward-char -1) - (if (memq (preceding-char) '(?\n ?\^M)) - ;; leave blank line before heading - (forward-char -1)))))) + (progn + ;; Go to end of line before heading + (forward-char -1) + (if (memq (preceding-char) '(?\n ?\^M)) + ;; leave blank line before heading + (forward-char -1)))))) (point)) +(defadvice outline-end-of-subtree (around prefer-org-version activate compile) + "Use Org version in org-mode, for dramatic speed-up." + (if (eq major-mode 'org-mode) + (progn + (org-end-of-subtree nil t) + (backward-char 1)) + ad-do-it)) + +(defun org-forward-same-level (arg &optional invisible-ok) + "Move forward to the arg'th subheading at same level as this one. +Stop at the first and last subheadings of a superior heading." + (interactive "p") + (org-back-to-heading invisible-ok) + (org-on-heading-p) + (let* ((level (- (match-end 0) (match-beginning 0) 1)) + (re (format "^\\*\\{1,%d\\} " level)) + l) + (forward-char 1) + (while (> arg 0) + (while (and (re-search-forward re nil 'move) + (setq l (- (match-end 0) (match-beginning 0) 1)) + (= l level) + (not invisible-ok) + (org-invisible-p)) + (if (< l level) (setq arg 1))) + (setq arg (1- arg))) + (beginning-of-line 1))) + +(defun org-backward-same-level (arg &optional invisible-ok) + "Move backward to the arg'th subheading at same level as this one. +Stop at the first and last subheadings of a superior heading." + (interactive "p") + (org-back-to-heading) + (org-on-heading-p) + (let* ((level (- (match-end 0) (match-beginning 0) 1)) + (re (format "^\\*\\{1,%d\\} " level)) + l) + (while (> arg 0) + (while (and (re-search-backward re nil 'move) + (setq l (- (match-end 0) (match-beginning 0) 1)) + (= l level) + (not invisible-ok) + (org-invisible-p)) + (if (< l level) (setq arg 1))) + (setq arg (1- arg))))) + (defun org-show-subtree () "Show everything after this heading at deeper levels." (outline-flag-region @@ -15063,20 +16641,23 @@ Show the heading too, if it is currently invisible." (outline-flag-region (max (point-min) (1- (point))) (save-excursion - (re-search-forward - (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) - (or (match-beginning 1) (point-max))) - nil)) + (if (re-search-forward + (concat "[\r\n]\\(" outline-regexp "\\)") nil t) + (match-beginning 1) + (point-max))) + nil) + (org-cycle-hide-drawers 'children)) (error nil)))) -(defun org-make-options-regexp (kwds) +(defun org-make-options-regexp (kwds &optional extra) "Make a regular expression for keyword lines." (concat "^" "#?[ \t]*\\+\\(" (mapconcat 'regexp-quote kwds "\\|") + (if extra (concat "\\|" extra)) "\\):[ \t]*" - "\\(.+\\)")) + "\\(.*\\)")) ;; Make isearch reveal the necessary context (defun org-isearch-end () @@ -15226,7 +16807,15 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." ;; Make flyspell not check words in links, to not mess up our keymap (defun org-mode-flyspell-verify () "Don't let flyspell put overlays at active buttons." - (not (get-text-property (point) 'keymap))) + (and (not (get-text-property (point) 'keymap)) + (not (get-text-property (point) 'org-no-flyspell)))) + +(defun org-remove-flyspell-overlays-in (beg end) + "Remove flyspell overlays in region." + (and (org-bound-and-true-p flyspell-mode) + (fboundp 'flyspell-delete-region-overlays) + (flyspell-delete-region-overlays beg end)) + (add-text-properties beg end '(org-no-flyspell t))) ;; Make `bookmark-jump' show the jump location if it was hidden. (eval-after-load "bookmark" @@ -15279,7 +16868,6 @@ Still experimental, may disappear in the future." ;; make tree, check each match with the callback (org-occur "CLOSED: +\\[\\(.*?\\)\\]" nil callback))) - ;;;; Finish up (provide 'org) |